diff --git a/.build_rtd_docs/Doxyfile b/.build_rtd_docs/Doxyfile index 13bdf99d1e7..1dc8033b435 100644 --- a/.build_rtd_docs/Doxyfile +++ b/.build_rtd_docs/Doxyfile @@ -37,7 +37,7 @@ PROJECT_NAME = "MODFLOW 6" # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = "version 6.2.2" +PROJECT_NUMBER = "version 6.5.0.dev0" # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a diff --git a/.build_rtd_docs/conf.py b/.build_rtd_docs/conf.py index bfd38623e25..40b117a9f22 100644 --- a/.build_rtd_docs/conf.py +++ b/.build_rtd_docs/conf.py @@ -56,6 +56,15 @@ # copy the file shutil.copy(src, dst) +# -- copy deprecations markdown --------------------------------------------- +print("Copy the deprecations table") +dstdir = "_mf6run" +fpth = "deprecations.md" +src = os.path.join("..", "doc", "mf6io", "mf6ivar", "md", fpth) +dst = os.path.join(dstdir, fpth) +# copy the file +shutil.copy(src, dst) + # -- build the mf6io markdown files ----------------------------------------- print("Build the mf6io markdown files") pth = os.path.join("..", "doc", "mf6io", "mf6ivar") @@ -140,11 +149,9 @@ # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ["_static"] -html_context = { - "css_files": [ - "_static/theme_overrides.css", # override wide tables in RTD theme - ], -} +html_css_files = [ + "_static/theme_overrides.css", # override wide tables in RTD theme +] # html_theme_options = { # "github_url": "https://github.com/MODFLOW-USGS/modflow6", diff --git a/.build_rtd_docs/index.rst b/.build_rtd_docs/index.rst index e5b8ee8cae1..813d5a4daff 100644 --- a/.build_rtd_docs/index.rst +++ b/.build_rtd_docs/index.rst @@ -14,4 +14,5 @@ Contents: MODFLOW 6 Source Code Documentation mf6io _mf6run/run-time-comparison.md + _mf6run/deprecations.md diff --git a/.build_rtd_docs/requirements.rtd.txt b/.build_rtd_docs/requirements.rtd.txt index e531a07c623..979de2f6768 100644 --- a/.build_rtd_docs/requirements.rtd.txt +++ b/.build_rtd_docs/requirements.rtd.txt @@ -1,5 +1,6 @@ numpy bmipy +sphinx>=4 sphinx_markdown_tables nbsphinx nbsphinx_link @@ -7,7 +8,7 @@ ipython ipykernel rtds_action myst-parser -sphinx_rtd_theme +sphinx_rtd_theme>=1 pytest filelock modflow-devtools \ No newline at end of file diff --git a/.doc/conf.py b/.doc/conf.py index 599c330ac4d..8ed07df6dda 100644 --- a/.doc/conf.py +++ b/.doc/conf.py @@ -112,14 +112,13 @@ # 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"] - html_context = { "github_repo": "modflow6", "doc_path": ".doc", - "css_files": [ - "_static/theme_overrides.css", # override wide tables in RTD theme - ], } +html_css_files = [ + "_static/theme_overrides.css", # override wide tables in RTD theme +] html_theme_options = {} diff --git a/.doc/requirements.txt b/.doc/requirements.txt index 2174ec428a1..7c642ad9cda 100644 --- a/.doc/requirements.txt +++ b/.doc/requirements.txt @@ -2,5 +2,6 @@ sphinx_markdown_tables ipython ipykernel rtds_action -sphinx_rtd_theme +sphinx>=4 +sphinx_rtd_theme>=1 myst-parser diff --git a/.fprettify.yaml b/.fprettify.yaml index c19702b116f..553ef061397 100644 --- a/.fprettify.yaml +++ b/.fprettify.yaml @@ -1,6 +1,6 @@ # MODFLOW 6 configuration for fprettify # run from root directory using -# fprettify -c distribution/.fprettify.yaml SRC +# fprettify -c .fprettify.yaml SRC whitespace-plusminus: 1 whitespace-multdiv: 1 line-length: 82 diff --git a/.gitattributes b/.gitattributes index e5e837d1e7f..9134554730d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -13,3 +13,8 @@ *.png binary *.jpg binary *.pdf binary + +# Configure github-linguist +*.inc linguist-language=Fortran +.build_rtd_docs/** linguist-documentation +.doc/** linguist-documentation diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md index bbfd8d081ab..6d7a3d18f05 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.md +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -10,7 +10,7 @@ assignees: '' **Describe the bug** A clear and concise description of what the bug is. -**To Reproduce** +**To reproduce** Steps to reproduce the behavior: 1. Go to '...' 2. Click on '....' @@ -23,6 +23,7 @@ A clear and concise description of what you expected to happen. **Screenshots** If applicable, add screenshots to help explain your problem. -**Desktop (please complete the following information):** - - OS: [e.g. macOS, Linux, Windows] - - Version [e.g. 22] +**Environment** + - Operating system (e.g. macOS, Linux, Windows) and version + - MODFLOW 6 version (if installed via distribution) + - Compiler toolchain/version (if built from source) diff --git a/.github/PULL_REQUEST_TEMPLATE/pull_request_template.md b/.github/PULL_REQUEST_TEMPLATE/pull_request_template.md new file mode 100644 index 00000000000..1affcbe0ed5 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE/pull_request_template.md @@ -0,0 +1,8 @@ +Feel free to remove check-list items that aren't relevant to your change. + +- [ ] Closes #xxxx +- [ ] Passed autotests +- [ ] Formatted source files with `fprettify` +- [ ] Updated definition (*.dfn) files with new or modified options +- [ ] Described new options, features or behavior changes in release notes +- [ ] Updated meson files, makefiles, and Visual Studio project files if new source files added \ No newline at end of file diff --git a/.github/common/fortran_format_check.py b/.github/common/fortran_format_check.py index 8452e5a69c6..a2c6eb1411e 100644 --- a/.github/common/fortran_format_check.py +++ b/.github/common/fortran_format_check.py @@ -18,7 +18,8 @@ ] # Exclude these files from checks -excludefiles = ["src/Utilities/InputOutput.f90"] # excluded until refactored +excludefiles = [] # add excluded files here + class FortranFormatCheck: """ @@ -99,6 +100,7 @@ def _excluded(self, path: Path) -> bool: return False + if __name__ == "__main__": parser = argparse.ArgumentParser( "MODFLOW 6 fortran format source code verification" @@ -106,9 +108,7 @@ def _excluded(self, path: Path) -> bool: parser.add_argument( "-r", "--root", help="path to MODFLOW 6 repository root directory" ) - parser.add_argument( - "-v", "--verbose", action="store_true", help="verbose" - ) + parser.add_argument("-v", "--verbose", action="store_true", help="verbose") args = parser.parse_args() # set MODFLOW 6 repository root diff --git a/.github/common/msvs_vfproj_check.py b/.github/common/msvs_vfproj_check.py new file mode 100644 index 00000000000..80c1f3d719d --- /dev/null +++ b/.github/common/msvs_vfproj_check.py @@ -0,0 +1,68 @@ +import xml.etree.ElementTree as ET +from pathlib import Path + + +def get_source_files(src_folder): + p = Path(".") + src_files = [] + print(f"Processing {src_folder} folder") + ftypes = ("*.[fF]9[05]", "*.inc") + src_files = [] + for ft in ftypes: + src_files.extend(p.glob(f"{src_folder}/**/{ft}")) + return src_files + + +def get_msvs_files(vfproj_file): + print(f"Processing {vfproj_file}") + tree = ET.parse(vfproj_file) + root = tree.getroot() + msvs_files = [] + for f in root.iter("File"): + s = f.attrib["RelativePath"] + s = s.replace("\\", "/") + s = s.replace("../", "") + fpath = Path(s) + msvs_files.append(fpath) + return msvs_files + + +def check_files(name, src_files, msvs_files): + print( + f"Verifying {name} files referenced in msvs project files are in src folder..." + ) + s, m = set(src_files), set(msvs_files) + diff = s ^ m + from pprint import pformat + + assert not any(diff), ( + f"{name} src files don't match msvs project file\n" + f"=> symmetric difference:\n{pformat(diff)}\n" + f"=> src - msvs:\n{pformat(s - m)}\n" + f"=> msvs - src:\n{pformat(m - s)}\n" + "Check to make sure msvs project file is consistent with source files." + ) + + +def check_mf6(): + # get list of source files and files referenced in msvs project files + src_files = get_source_files("src") + msvs_files = [] + for vfproj in ["./msvs/mf6core.vfproj", "./msvs/mf6.vfproj"]: + msvs_files.extend(get_msvs_files(vfproj)) + check_files("MF6", src_files, msvs_files) + + +def check_bmi(): + # get list of source files and files referenced in msvs project files + src_files = get_source_files("srcbmi") + msvs_files = [] + for vfproj in ["./msvs/mf6bmi.vfproj"]: + msvs_files.extend(get_msvs_files(vfproj)) + check_files("BMI", src_files, msvs_files) + + +if __name__ == "__main__": + check_mf6() + check_bmi() + print("msvs project (vfproj) files appear up-to-date...") diff --git a/.github/common/update_compat_tables.py b/.github/common/update_compat_tables.py new file mode 100644 index 00000000000..59255741806 --- /dev/null +++ b/.github/common/update_compat_tables.py @@ -0,0 +1,35 @@ +""" +Inserts Markdown compatibility tables +between tags in target Markdown file. +""" + +import re +import sys +from pathlib import Path + +name = sys.argv[1] # name of the table, e.g. "compile", "test" +compat_path = Path(sys.argv[2]) # compatibility table path +update_path = Path(sys.argv[3]) # path to file to update + +assert compat_path.is_file() +assert update_path.is_file() + +with open(compat_path, "r") as compat: + table = "".join(compat.readlines()) + r = re.compile( + r".*", + re.DOTALL, + ) + ct = ( + "{}" + ) + readme = update_path.open().read() + update_path.open("w").write(r.sub(ct, readme)) diff --git a/.github/common/wide_compat_reports.py b/.github/common/wide_compat_reports.py new file mode 100644 index 00000000000..f2ffb531ba1 --- /dev/null +++ b/.github/common/wide_compat_reports.py @@ -0,0 +1,39 @@ +""" +Converts compatibility reports from long to wide format +and makes a markdown table from the wide format report. +""" + +from pathlib import Path +import pandas as pd +import sys + +ip = Path(sys.argv[1]) # input file path +op = Path(sys.argv[2]) # output file path +assert ip.is_file() +assert ip.suffix == ".csv" +assert op.suffix == ".csv" + +# read long CSV +df = pd.read_csv(ip) + +# pivot and sort +df = pd.pivot( + df, + index="runner", + columns=["compiler", "version"], + values="support", +).sort_values(by=["runner"]) + +# write wide CSV +df.to_csv(op) + +# write wide markdown table +with open(op.with_suffix(".md"), "w") as file: + file.write( + df.to_markdown() + .replace("nan", "") + .replace("(", "") + .replace(")", "") + .replace(",", "") + .replace("'", "") + ) diff --git a/.github/compat/comp.csv b/.github/compat/comp.csv new file mode 100644 index 00000000000..32e0a1b4c31 --- /dev/null +++ b/.github/compat/comp.csv @@ -0,0 +1,9 @@ +compiler,gcc,gcc,gcc,gcc,gcc,gcc,gcc,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel,intel,intel,intel,intel,intel,intel,intel,intel,intel +version,10,11,12,13,7,8,9,2021.1,2021.10,2021.2,2021.3,2021.4,2021.5,2021.6,2021.7,2021.8,2021.9,2021.1,2021.2,2021.4,2022.0,2022.1,2022.2.1,2022.2,2023.0,2023.1,2023.2 +runner,,,,,,,,,,,,,,,,,,,,,,,,,,, +macos-11,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,,,,,,,,,, +macos-12,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,✓,,,,,,,,,, +ubuntu-20.04,✓,✓,,,✓,✓,✓,✓,✓,✓,,✓,✓,✓,✓,✓,✓,,,,,,✓,✓,,,✓ +ubuntu-22.04,✓,✓,✓,✓,,,✓,✓,✓,✓,,✓,✓,✓,✓,✓,✓,,,,,,✓,✓,,,✓ +windows-2019,✓,✓,✓,✓,,,✓,,✓,,,,,✓,✓,✓,✓,,,,,,,✓,,,✓ +windows-2022,✓,✓,✓,✓,,,✓,,✓,,,,,✓,✓,✓,✓,,,,,,,✓,,,✓ diff --git a/.github/compat/test.csv b/.github/compat/test.csv new file mode 100644 index 00000000000..a029341ceef --- /dev/null +++ b/.github/compat/test.csv @@ -0,0 +1,9 @@ +compiler,gcc,gcc,gcc,gcc,gcc,gcc,gcc,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel-classic,intel,intel,intel,intel,intel,intel,intel,intel,intel,intel +version,10,11,12,13,7,8,9,2021.1,2021.10,2021.2,2021.3,2021.4,2021.5,2021.6,2021.7,2021.8,2021.9,2021.1,2021.2,2021.4,2022.0,2022.1,2022.2.1,2022.2,2023.0,2023.1,2023.2 +runner,,,,,,,,,,,,,,,,,,,,,,,,,,, +macos-11,✓,✓,✓,✓,✓,✓,✓,✓,,✓,✓,✓,✓,✓,✓,,,,,,,,,,,, +macos-12,✓,✓,✓,✓,,,,✓,,✓,✓,✓,✓,✓,✓,,,,,,,,,,,, +ubuntu-20.04,✓,✓,,,✓,✓,✓,✓,,✓,,✓,✓,✓,✓,,,,,,,,,,,, +ubuntu-22.04,✓,✓,✓,✓,,,✓,✓,,✓,,✓,✓,✓,✓,,,,,,,,,,,, +windows-2019,,,,✓,,,,,,,,,,✓,✓,,,,,,,,,,,, +windows-2022,✓,✓,✓,✓,,,✓,,,,,,,✓,✓,,,,,,,,,,,, diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 75c7b43d4b6..b0333674e46 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,23 +1,43 @@ name: MODFLOW 6 continuous integration on: push: - branches: - - master - - develop - - ci-diagnose* paths-ignore: - '**.md' - - 'doc/**' + - '**.pdf' + - '**.tex' + - '**.jpg' + - '**.jpeg' + - '**.png' + - '**.bbl' + - '**.bib' + - 'doc/**.dat' + - 'doc/**.ipynb' + - 'doc/**.py' + - 'doc/**.sh' + - 'doc/**.xlsx' + - '.hpc/**' pull_request: branches: - master - develop paths-ignore: - '**.md' - - 'doc/**' + - '**.pdf' + - '**.tex' + - '**.jpg' + - '**.jpeg' + - '**.png' + - '**.bbl' + - '**.bib' + - 'doc/**.dat' + - 'doc/**.ipynb' + - 'doc/**.py' + - 'doc/**.sh' + - 'doc/**.xlsx' + - '.hpc/**' jobs: lint: - name: Lint (fprettify) + name: Check format runs-on: ubuntu-latest defaults: run: @@ -25,7 +45,7 @@ jobs: steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Setup Micromamba uses: mamba-org/setup-micromamba@v1 @@ -37,22 +57,25 @@ jobs: - name: Check Fortran source formatting run: python .github/common/fortran_format_check.py + - name: Check msvs project files + run: python .github/common/msvs_vfproj_check.py + build: - name: Build (gfortran 12) + name: Build runs-on: ubuntu-22.04 defaults: run: shell: bash -l {0} env: FC: gfortran - GCC_V: 12 + GCC_V: 13 steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Setup gfortran ${{ env.GCC_V }} - uses: awvwgk/setup-fortran@main + uses: fortran-lang/setup-fortran@v1 with: compiler: gcc version: ${{ env.GCC_V }} @@ -70,29 +93,39 @@ jobs: - name: Meson compile run: meson compile -C builddir + - name: Show build log + if: failure() + run: cat builddir/meson-logs/meson-log.txt + - name: Meson test run: meson test --verbose --no-rebuild -C builddir smoke_test: - name: Smoke test (gfortran 12) + name: Smoke test runs-on: ubuntu-22.04 defaults: run: shell: bash -l {0} env: FC: gfortran - GCC_V: 12 + GCC: 13 steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 + + - name: Checkout test-drive + uses: actions/checkout@v4 + with: + repository: fortran-lang/test-drive + path: test-drive - - name: Setup GNU Fortran ${{ env.GCC_V }} - uses: awvwgk/setup-fortran@main + - name: Setup GNU Fortran ${{ env.GCC }} + uses: fortran-lang/setup-fortran@v1 with: compiler: gcc - version: ${{ env.GCC_V }} + version: ${{ env.GCC }} - name: Setup Micromamba uses: mamba-org/setup-micromamba@v1 @@ -101,12 +134,27 @@ jobs: cache-environment: true cache-downloads: true + - name: Build test-drive + working-directory: test-drive + run: | + meson setup builddir --prefix=$(pwd) --libdir=lib + meson install -C builddir + echo "PKG_CONFIG_PATH=$(pwd)/lib/pkgconfig:$PKG_CONFIG_PATH" >> $GITHUB_ENV + - name: Build modflow6 working-directory: modflow6 run: | meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin meson install -C builddir - meson test --verbose --no-rebuild -C builddir + + - name: Show build log + if: failure() + working-directory: modflow6 + run: cat builddir/meson-logs/meson-log.txt + + - name: Unit test programs + working-directory: modflow6 + run: meson test --verbose --no-rebuild -C builddir - name: Update flopy working-directory: modflow6/autotest @@ -127,8 +175,8 @@ jobs: pytest -v -n auto --durations 0 -S fi - test_gfortran_latest: - name: Test (gfortran 12) + test_gfortran: + name: Test gnu fortran needs: - lint - build @@ -143,30 +191,30 @@ jobs: shell: bash -l {0} env: FC: gfortran - GCC_V: 12 + GCC: 13 steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 - name: Checkout modflow6-testmodels - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-testmodels path: modflow6-testmodels - name: Checkout modflow6-examples - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-examples path: modflow6-examples - - name: Setup GNU Fortran ${{ env.GCC_V }} - uses: awvwgk/setup-fortran@main + - name: Setup GNU Fortran ${{ env.GCC }} + uses: fortran-lang/setup-fortran@v1 with: compiler: gcc - version: ${{ env.GCC_V }} + version: ${{ env.GCC }} - name: Setup Micromamba uses: mamba-org/setup-micromamba@v1 @@ -183,7 +231,15 @@ jobs: run: | meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin meson install -C builddir - meson test --verbose --no-rebuild -C builddir + + - name: Show build log + if: failure() + working-directory: modflow6 + run: cat builddir/meson-logs/meson-log.txt + + - name: Unit test programs + working-directory: modflow6 + run: meson test --verbose --no-rebuild -C builddir - name: Update flopy working-directory: modflow6/autotest @@ -207,11 +263,9 @@ jobs: pytest -v -n auto --durations 0 -m "not large" fi - # steps below run only on Linux to test distribution procedures, e.g. - # compiling binaries, building documentation - name: Checkout usgslatex if: runner.os == 'Linux' - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/usgslatex path: usgslatex @@ -230,31 +284,15 @@ jobs: if: runner.os == 'Linux' working-directory: usgslatex/usgsLaTeX run: sudo ./install.sh --all-users - - - name: Install dependencies for ex-gwf-twri example model - if: runner.os == 'Linux' - working-directory: modflow6-examples/etc - run: | - # install extra Python packages - pip install -r requirements.pip.txt - - # the example model needs executables to be on the path - echo "${{ github.workspace }}/modflow6/bin" >> $GITHUB_PATH - echo "${{ github.workspace }}/modflow6/bin/downloaded" >> $GITHUB_PATH - - - name: Build ex-gwf-twri example model - if: runner.os == 'Linux' - working-directory: modflow6-examples/scripts - run: python ex-gwf-twri.py - + - name: Test distribution scripts working-directory: modflow6/distribution env: GITHUB_TOKEN: ${{ github.token }} run: pytest -v --durations 0 - test_gfortran_previous: - name: Test gfortran (${{ matrix.GCC_V }}, ${{ matrix.os }}) + test_intel_fortran: + name: Test intel fortran needs: - lint - build @@ -263,90 +301,23 @@ jobs: strategy: fail-fast: false matrix: - os: [ ubuntu-20.04 ] - GCC_V: [ 7, 8, 9, 10, 11 ] - defaults: - run: - shell: bash -l {0} - env: - FC: gfortran - steps: - - - name: Checkout modflow6 - uses: actions/checkout@v3 - with: - path: modflow6 - - - name: Checkout modflow6-testmodels - uses: actions/checkout@v3 - with: - repository: MODFLOW-USGS/modflow6-testmodels - path: modflow6-testmodels - - - name: Setup GNU Fortran ${{ matrix.GCC_V }} - uses: awvwgk/setup-fortran@main - with: - compiler: gcc - version: ${{ matrix.GCC_V }} - - - name: Setup Micromamba - uses: mamba-org/setup-micromamba@v1 - with: - environment-file: modflow6/environment.yml - cache-downloads: true - cache-environment: true - - - name: Update flopy - working-directory: modflow6/autotest - run: python update_flopy.py - - - name: Build modflow6 - working-directory: modflow6 - run: | - meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin - meson install -C builddir - meson test --verbose --no-rebuild -C builddir - - - name: Get executables - working-directory: modflow6/autotest - env: - GITHUB_TOKEN: ${{ github.token }} - run: pytest -v --durations 0 get_exes.py - - - name: Test modflow6 - working-directory: modflow6/autotest - env: - REPOS_PATH: ${{ github.workspace }} - run: | - if [ "${{ github.ref_name }}" == "master" ]; then - pytest -v -n auto --durations 0 -m "not large and not developmode" - else - pytest -v -n auto --durations 0 -m "not large" - fi + include: + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.7} + - {os: macos-12, compiler: intel-classic, version: 2021.7} + - {os: windows-2022, compiler: intel-classic, version: 2021.7} - test_ifort: - name: Test (ifort) - needs: - - lint - - build - - smoke_test - runs-on: ${{ matrix.os }} - strategy: - fail-fast: false - matrix: - os: [ ubuntu-latest, macos-latest, windows-latest ] defaults: run: shell: bash -l {0} steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 - name: Checkout modflow6-testmodels - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-testmodels path: modflow6-testmodels @@ -362,50 +333,41 @@ jobs: cache-downloads: true - name: Setup Intel Fortran - uses: modflowpy/install-intelfortran-action@v1 + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ matrix.compiler }} + version: ${{ matrix.version }} - name: Update version files working-directory: modflow6/distribution run: python update_version.py - name: Build modflow6 - if: runner.os != 'Windows' working-directory: modflow6 run: | meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin meson install -C builddir - meson test --verbose --no-rebuild -C builddir - - name: Build modflow6 (Windows) - if: runner.os == 'Windows' + - name: Show build log + if: failure() working-directory: modflow6 - shell: pwsh - run: | - meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin - meson install -C builddir - meson test --verbose --no-rebuild -C builddir + run: cat builddir/meson-logs/meson-log.txt + + - name: Unit test programs + working-directory: modflow6 + run: meson test --verbose --no-rebuild -C builddir - name: Update flopy working-directory: modflow6/autotest run: python update_flopy.py - name: Get executables - if: runner.os != 'Windows' working-directory: modflow6/autotest env: GITHUB_TOKEN: ${{ github.token }} run: pytest -v --durations 0 get_exes.py - - - name: Get executables (Windows) - if: runner.os == 'Windows' - working-directory: modflow6/autotest - shell: pwsh - env: - GITHUB_TOKEN: ${{ github.token }} - run: pytest -v --durations 0 get_exes.py - name: Test programs - if: runner.os != 'Windows' working-directory: modflow6/autotest env: REPOS_PATH: ${{ github.workspace }} @@ -416,30 +378,8 @@ jobs: pytest -v -n auto --durations 0 -m "not large" fi - - name: Test programs (Windows) - if: runner.os == 'Windows' - working-directory: modflow6/autotest - shell: pwsh - env: - REPOS_PATH: ${{ github.workspace }} - run: | - if ( "${{ github.ref_name }}" -eq "master" ) { - pytest -v -n auto --durations 0 -m "not large and not developmode" - } else { - pytest -v -n auto --durations 0 -m "not large" - } - - name: Test scripts - if: runner.os != 'Windows' - working-directory: modflow6/distribution - env: - GITHUB_TOKEN: ${{ github.token }} - run: pytest -v --durations 0 - - - name: Test scripts (Windows) - if: runner.os == 'Windows' working-directory: modflow6/distribution - shell: pwsh env: GITHUB_TOKEN: ${{ github.token }} run: pytest -v --durations 0 @@ -464,7 +404,7 @@ jobs: steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 @@ -488,14 +428,14 @@ jobs: mpi: msmpi - name: Setup GNU Fortran ${{ env.GCC_V }} - uses: awvwgk/setup-fortran@main + uses: fortran-lang/setup-fortran@v1 with: compiler: gcc version: ${{ env.GCC_V }} - name: Cache PETSc id: cache-petsc - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: petsc key: ${{ runner.os }}-petsc diff --git a/.github/workflows/compilers.yml b/.github/workflows/compilers.yml new file mode 100644 index 00000000000..e3fcd7dd85b --- /dev/null +++ b/.github/workflows/compilers.yml @@ -0,0 +1,366 @@ +name: MODFLOW 6 compiler checks +on: + push: + branches: + - v[0-9]+.[0-9]+.[0-9]+* + - master + pull_request: + branches: + - master + schedule: + - cron: 0 0 * * 0 # 12am utc every sunday + # workflow_dispatch trigger to start release via GitHub UI or CLI, see + # https://docs.github.com/en/actions/managing-workflow-runs/manually-running-a-workflow + workflow_dispatch: +jobs: + test: + name: Test + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + # combinations from https://github.com/fortran-lang/setup-fortran#runner-compatibility + include: + # gfortran + - {os: ubuntu-20.04, compiler: gcc, version: 7} + - {os: ubuntu-20.04, compiler: gcc, version: 8} + - {os: ubuntu-20.04, compiler: gcc, version: 9} + - {os: ubuntu-20.04, compiler: gcc, version: 10} + - {os: ubuntu-20.04, compiler: gcc, version: 11} + - {os: ubuntu-22.04, compiler: gcc, version: 9} + - {os: ubuntu-22.04, compiler: gcc, version: 10} + - {os: ubuntu-22.04, compiler: gcc, version: 11} + - {os: ubuntu-22.04, compiler: gcc, version: 12} + - {os: ubuntu-22.04, compiler: gcc, version: 13} + - {os: macos-11, compiler: gcc, version: 7} + - {os: macos-11, compiler: gcc, version: 8} + - {os: macos-11, compiler: gcc, version: 9} + - {os: macos-11, compiler: gcc, version: 10} + - {os: macos-11, compiler: gcc, version: 11} + - {os: macos-11, compiler: gcc, version: 12} + - {os: macos-11, compiler: gcc, version: 13} + - {os: macos-12, compiler: gcc, version: 7} + - {os: macos-12, compiler: gcc, version: 8} + - {os: macos-12, compiler: gcc, version: 9} + - {os: macos-12, compiler: gcc, version: 10} + - {os: macos-12, compiler: gcc, version: 11} + - {os: macos-12, compiler: gcc, version: 12} + - {os: macos-12, compiler: gcc, version: 13} + - {os: windows-2019, compiler: gcc, version: 9} + - {os: windows-2019, compiler: gcc, version: 10} + - {os: windows-2019, compiler: gcc, version: 11} + - {os: windows-2019, compiler: gcc, version: 12} + - {os: windows-2019, compiler: gcc, version: 13} + - {os: windows-2022, compiler: gcc, version: 9} + - {os: windows-2022, compiler: gcc, version: 10} + - {os: windows-2022, compiler: gcc, version: 11} + - {os: windows-2022, compiler: gcc, version: 12} + - {os: windows-2022, compiler: gcc, version: 13} + # ifx + - {os: ubuntu-20.04, compiler: intel, version: 2023.2} + - {os: ubuntu-20.04, compiler: intel, version: 2023.1} + - {os: ubuntu-20.04, compiler: intel, version: "2023.0"} + - {os: ubuntu-20.04, compiler: intel, version: 2022.2.1} + - {os: ubuntu-20.04, compiler: intel, version: 2022.2} + - {os: ubuntu-20.04, compiler: intel, version: 2022.1} + - {os: ubuntu-20.04, compiler: intel, version: "2022.0"} + - {os: ubuntu-20.04, compiler: intel, version: 2021.4} + - {os: ubuntu-20.04, compiler: intel, version: 2021.2} + - {os: ubuntu-20.04, compiler: intel, version: 2021.1} + - {os: ubuntu-22.04, compiler: intel, version: 2023.2} + - {os: ubuntu-22.04, compiler: intel, version: 2023.1} + - {os: ubuntu-22.04, compiler: intel, version: "2023.0"} + - {os: ubuntu-22.04, compiler: intel, version: 2022.2.1} + - {os: ubuntu-22.04, compiler: intel, version: 2022.2} + - {os: ubuntu-22.04, compiler: intel, version: 2022.1} + - {os: ubuntu-22.04, compiler: intel, version: "2022.0"} + - {os: ubuntu-22.04, compiler: intel, version: 2021.4} + - {os: ubuntu-22.04, compiler: intel, version: 2021.2} + - {os: ubuntu-22.04, compiler: intel, version: 2021.1} + # no ifx on mac + - {os: windows-2019, compiler: intel, version: 2023.2} + - {os: windows-2019, compiler: intel, version: 2023.1} + - {os: windows-2019, compiler: intel, version: "2023.0"} + - {os: windows-2019, compiler: intel, version: 2022.2} + - {os: windows-2019, compiler: intel, version: 2022.1} + - {os: windows-2022, compiler: intel, version: 2023.2} + - {os: windows-2022, compiler: intel, version: 2023.1} + - {os: windows-2022, compiler: intel, version: "2023.0"} + - {os: windows-2022, compiler: intel, version: 2022.2} + - {os: windows-2022, compiler: intel, version: 2022.1} + # ifort + - {os: ubuntu-20.04, compiler: intel-classic, version: "2021.10"} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.9} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.8} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.7} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.6} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.5} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.4} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.3} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.2} + - {os: ubuntu-20.04, compiler: intel-classic, version: 2021.1} + - {os: ubuntu-22.04, compiler: intel-classic, version: "2021.10"} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.9} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.8} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.7} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.6} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.5} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.4} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.3} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.2} + - {os: ubuntu-22.04, compiler: intel-classic, version: 2021.1} + - {os: macos-11, compiler: intel-classic, version: "2021.10"} + - {os: macos-11, compiler: intel-classic, version: 2021.9} + - {os: macos-11, compiler: intel-classic, version: 2021.8} + - {os: macos-11, compiler: intel-classic, version: 2021.7} + - {os: macos-11, compiler: intel-classic, version: 2021.6} + - {os: macos-11, compiler: intel-classic, version: 2021.5} + - {os: macos-11, compiler: intel-classic, version: 2021.4} + - {os: macos-11, compiler: intel-classic, version: 2021.3} + - {os: macos-11, compiler: intel-classic, version: 2021.2} + - {os: macos-11, compiler: intel-classic, version: 2021.1} + - {os: macos-12, compiler: intel-classic, version: "2021.10"} + - {os: macos-12, compiler: intel-classic, version: 2021.9} + - {os: macos-12, compiler: intel-classic, version: 2021.8} + - {os: macos-12, compiler: intel-classic, version: 2021.7} + - {os: macos-12, compiler: intel-classic, version: 2021.6} + - {os: macos-12, compiler: intel-classic, version: 2021.5} + - {os: macos-12, compiler: intel-classic, version: 2021.4} + - {os: macos-12, compiler: intel-classic, version: 2021.3} + - {os: macos-12, compiler: intel-classic, version: 2021.2} + - {os: macos-12, compiler: intel-classic, version: 2021.1} + - {os: windows-2019, compiler: intel-classic, version: "2021.10"} + - {os: windows-2019, compiler: intel-classic, version: 2021.9} + - {os: windows-2019, compiler: intel-classic, version: 2021.8} + - {os: windows-2019, compiler: intel-classic, version: 2021.7} + - {os: windows-2019, compiler: intel-classic, version: 2021.6} + - {os: windows-2022, compiler: intel-classic, version: "2021.10"} + - {os: windows-2022, compiler: intel-classic, version: 2021.9} + - {os: windows-2022, compiler: intel-classic, version: 2021.8} + - {os: windows-2022, compiler: intel-classic, version: 2021.7} + - {os: windows-2022, compiler: intel-classic, version: 2021.6} + defaults: + run: + shell: bash -l {0} + steps: + - name: Checkout modflow6 + uses: actions/checkout@v4 + with: + path: modflow6 + + - name: Checkout modflow6-testmodels + uses: actions/checkout@v4 + with: + repository: MODFLOW-USGS/modflow6-testmodels + path: modflow6-testmodels + + - name: Checkout modflow6-examples + uses: actions/checkout@v4 + with: + repository: MODFLOW-USGS/modflow6-examples + path: modflow6-examples + + - name: Setup ${{ matrix.compiler }} ${{ matrix.version }} + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ matrix.compiler}} + version: ${{ matrix.version }} + + - name: Setup Micromamba + uses: mamba-org/setup-micromamba@v1 + with: + environment-file: modflow6/environment.yml + init-shell: >- + bash + powershell + cache-environment: true + cache-downloads: true + + - name: Build modflow6 + working-directory: modflow6 + run: | + meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin + meson install -C builddir + + - name: Show build log + if: failure() + working-directory: modflow6 + run: cat builddir/meson-logs/meson-log.txt + + - name: Upload build log + if: failure() + uses: actions/upload-artifact@v3 + with: + name: meson-log.txt + path: modflow6/builddir/meson-logs/meson-log.txt + + - name: Unit test programs + if: success() + working-directory: modflow6 + run: meson test --verbose --no-rebuild -C builddir + + - name: Create compile report + if: success() || failure() + shell: bash + run: | + if [[ "${{ job.status }}" == "success" ]]; then + support="✓" + else + support="" + fi + + mkdir -p compat + prefix="${{ matrix.os }},${{ matrix.compiler }},${{ matrix.version }}" + echo "$prefix,$support" >> "compat/comp_${prefix//,/_}.csv" + + - name: Update flopy + if: success() + working-directory: modflow6/autotest + run: python update_flopy.py + + - name: Get executables + if: success() + working-directory: modflow6/autotest + env: + GITHUB_TOKEN: ${{ github.token }} + run: pytest -v --durations 0 get_exes.py + + - name: Test modflow6 + if: success() + working-directory: modflow6/autotest + env: + REPOS_PATH: ${{ github.workspace }} + run: pytest -v -n auto --durations 0 + + - name: Create test report + if: success() || failure() + shell: bash + run: | + if [[ "${{ job.status }}" == "success" ]]; then + support="✓" + else + support="" + fi + + mkdir -p compat + prefix="${{ matrix.os }},${{ matrix.compiler }},${{ matrix.version }}" + echo "$prefix,$support" >> "compat/test_${prefix//,/_}.csv" + + - name: Upload reports + if: success() || failure() + uses: actions/upload-artifact@v3 + with: + name: compat + path: compat/*.csv + + report: + name: Make compatibility report + if: success() || failure() + needs: test + runs-on: ubuntu-latest + permissions: + contents: write + pull-requests: write + steps: + + - name: Checkout repository + uses: actions/checkout@v4 + + - name: Setup Python + uses: actions/setup-python@v5 + with: + python-version: 3.9 + + - name: Install packages + run: pip install tabulate pandas + + - name: Download reports + uses: actions/download-artifact@v3 + with: + name: compat + path: .github/compat/new + + - name: Concatenate reports + working-directory: .github/compat + run: | + cols="runner,compiler,version,support" + echo "$cols" > long_comp.csv + echo "$cols" > long_test.csv + cat new/comp*.csv >> long_comp.csv + cat new/test*.csv >> long_test.csv + + - name: Make wide CSV and MD tables + working-directory: .github/compat + id: merge-reports + run: | + python ../common/wide_compat_reports.py "long_comp.csv" "comp.csv" + python ../common/wide_compat_reports.py "long_test.csv" "test.csv" + + # only upload wide CSVs and Markdown tables + - name: Upload artifacts + uses: actions/upload-artifact@v3 + with: + name: compat + path: | + .github/compat/comp.* + .github/compat/test.* + + # update DEVELOPER.md if this is not a push event and there are any changes + - name: Check for changes + working-directory: .github/compat + if: github.event_name != 'pull_request' + id: diff + run: | + if ! [ -f comp.csv ]; then + echo "diff=false" >> $GITHUB_OUTPUT + exit 0 + fi + + diff_comp=$(git diff comp.csv) + diff_test=$(git diff test.csv) + if [[ ( $diff_comp == "" ) && ( $diff_test == "" ) ]]; then + echo "No changes found" + echo "diff=false" >> $GITHUB_OUTPUT + else + echo "comp.csv diff:" + echo "$diff_comp" + echo "test.csv diff:" + echo "$diff_test" + echo "diff=true" >> $GITHUB_OUTPUT + fi + + - name: Update DEVELOPER.md + if: ${{ steps.diff.outputs.diff == 'true' && github.event_name != 'pull_request' }} + run: | + python .github/common/update_compat_tables.py "compile" ".github/compat/comp.md" "DEVELOPER.md" + python .github/common/update_compat_tables.py "test" ".github/compat/test.md" "DEVELOPER.md" + + - name: Print DEVELOPER.md diff + if: ${{ steps.diff.outputs.diff == 'true' && github.event_name != 'pull_request' }} + run: git diff DEVELOPER.md + + - name: Create pull request + if: ${{ steps.diff.outputs.diff == 'true' && github.event_name != 'pull_request' }} + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: | + # one at a time + head="compat" + id=$(gh pr list -H $head -s open --json id -q ".[0].id") + [[ -n "${id// /}" ]] && (echo "PR already open"; exit 0) || (echo "opening PR") + + # setup bot user + git config user.name "github-actions[bot]" + git config user.email "41898282+github-actions[bot]@users.noreply.github.com" + + # create new branch + git switch -c "$head" + + # commit and push + git add DEVELOPER.md .github/compat/comp.csv .github/compat/test.csv + git commit -m "Update compatibility tables" + git push -u origin "$head" + + # open PR + cat <(echo '### Compile') <(echo) .github/compat/comp.md <(echo) <(echo '### Test') <(echo) .github/compat/test.md > compat.md + gh pr create -B "${{ github.event.repository.default_branch }}" -H "$head" --title "Update compile/test compatibility tables" --body-file compat.md \ No newline at end of file diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 1da492fc9c5..35f630e6bc5 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -1,18 +1,16 @@ name: MODFLOW 6 documentation on: push: - branches: - - master - - develop - - ci-diagnose* paths-ignore: - '.github/workflows/release.yml' + - '.hpc/**' pull_request: branches: - master - develop paths-ignore: - '.github/workflows/release.yml' + - '.hpc/**' jobs: rtd_build: name: Build ReadTheDocs @@ -25,18 +23,18 @@ jobs: steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 - name: Checkout modflow6-examples - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-examples path: modflow6-examples - name: Checkout usgslatex - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/usgslatex path: usgslatex @@ -69,14 +67,14 @@ jobs: run: pytest -v build_mfio_tex.py - name: Setup GNU Fortran ${{ env.GCC_V }} - uses: awvwgk/setup-fortran@main + uses: fortran-lang/setup-fortran@v1 with: compiler: gcc version: ${{ env.GCC_V }} - name: Cache modflow6 examples id: cache-examples - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: modflow6-examples/examples key: modflow6-examples-${{ hashFiles('modflow6-examples/scripts/**') }} @@ -95,9 +93,9 @@ jobs: - name: Build example models if: steps.cache-examples.outputs.cache-hit != 'true' - working-directory: modflow6-examples/etc + working-directory: modflow6-examples/autotest run: | - python ci_build_files.py + pytest -v -n auto test_scripts.py --init ls -lh ../examples/ - name: Run benchmarks @@ -105,21 +103,35 @@ jobs: run: python benchmark.py env: GITHUB_TOKEN: ${{ github.token }} - - - name: Run sphinx - working-directory: modflow6/.build_rtd_docs - run: make html - + - name: Show benchmarks working-directory: modflow6/distribution run: cat run-time-comparison.md - + - name: Upload benchmarks uses: actions/upload-artifact@v3 with: name: run-time-comparison path: modflow6/distribution/run-time-comparison.md + - name: Collect deprecations + working-directory: modflow6/doc/mf6io/mf6ivar + run: python deprecations.py + + - name: Show deprecations + working-directory: modflow6/doc/mf6io/mf6ivar/md + run: cat deprecations.md + + - name: Upload deprecations + uses: actions/upload-artifact@v3 + with: + name: deprecations + path: modflow6/doc/mf6io/mf6ivar/md/deprecations.md + + - name: Run sphinx + working-directory: modflow6/.build_rtd_docs + run: make html + - name: Upload results uses: actions/upload-artifact@v3 with: @@ -139,7 +151,7 @@ jobs: if: github.repository_owner == 'MODFLOW-USGS' && github.event_name == 'push' steps: - name: Checkout repo - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Trigger RTDs build on push to repo branches uses: dfm/rtds-action@v1 @@ -160,7 +172,7 @@ jobs: shell: bash -l {0} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - name: Print branch name run: echo ${{env.branch-name}} @@ -208,7 +220,7 @@ jobs: working-directory: ${{env.working-directory}} - name: upload pages artifact - uses: actions/upload-pages-artifact@v1 + uses: actions/upload-pages-artifact@v2 with: path: ${{env.working-directory}}/html @@ -225,4 +237,4 @@ jobs: steps: - name: Deploy to GitHub Pages id: deployment - uses: actions/deploy-pages@v2 + uses: actions/deploy-pages@v3 diff --git a/.github/workflows/large.yml b/.github/workflows/large.yml index 291dcc16673..e9cf36c98c5 100644 --- a/.github/workflows/large.yml +++ b/.github/workflows/large.yml @@ -3,38 +3,53 @@ on: schedule: - cron: '0 6 * * *' # run at 6 AM UTC every day jobs: + # caching only necessary on Windows cache_ifort: name: Cache Intel OneAPI compilers runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: - os: [ ubuntu-22.04, macos-12, windows-2022 ] + include: + # ifx + - {os: windows-2022, compiler: intel, version: 2022.2} + # ifort + - {os: windows-2022, compiler: intel-classic, version: "2021.10"} + - {os: windows-2022, compiler: intel-classic, version: 2021.9} + - {os: windows-2022, compiler: intel-classic, version: 2021.8} + - {os: windows-2022, compiler: intel-classic, version: 2021.7} + - {os: windows-2022, compiler: intel-classic, version: 2021.6} steps: - - name: Setup Intel Fortran - uses: modflowpy/install-intelfortran-action@v1 + - name: Setup ${{ matrix.compiler }} ${{ matrix.version }} + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ matrix.compiler }} + version: ${{ matrix.version }} test: name: Test runs-on: ubuntu-22.04 strategy: fail-fast: false matrix: - fc: [ ifort, gfortran ] - repo: [ examples, largetestmodels ] + include: + - {compiler: gcc, version: 13, repo: examples} + - {compiler: gcc, version: 13, repo: largetestmodels} + - {compiler: intel, version: 2022.2.1, repo: examples} + - {compiler: intel, version: 2022.2.1, repo: largetestmodels} + - {compiler: intel-classic, version: 2021.6, repo: examples} + - {compiler: intel-classic, version: 2021.6, repo: largetestmodels} defaults: run: shell: bash -l {0} - env: - GCC_V: 12 steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: modflow6 - name: Checkout modflow6-${{ matrix.repo }} - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-${{ matrix.repo }} path: modflow6-${{ matrix.repo }} @@ -46,20 +61,15 @@ jobs: cache-downloads: true cache-environment: true - - name: Setup gfortran ${{ env.GCC_V }} - if: matrix.FC == 'gfortran' - uses: awvwgk/setup-fortran@main + - name: Setup compilers (${{ matrix.compiler }} ${{ matrix.version }}) + uses: fortran-lang/setup-fortran@v1 with: - compiler: gcc - version: ${{ env.GCC_V }} - - - name: Setup ifort - if: matrix.fc == 'ifort' - uses: modflowpy/install-intelfortran-action@v1 + compiler: ${{ matrix.compiler }} + version: ${{ matrix.version }} - name: Cache modflow6 examples id: cache-examples - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: modflow6-examples/examples key: modflow6-examples-${{ hashFiles('modflow6-examples/scripts/**') }} @@ -72,9 +82,9 @@ jobs: - name: Build example models if: matrix.repo == 'examples' && steps.cache-examples.outputs.cache-hit != 'true' - working-directory: modflow6-examples/etc + working-directory: modflow6-examples/autotest run: | - python ci_build_files.py + pytest -v -n auto test_scripts.py --init ls -lh ../examples/ - name: Add Micromamba Scripts dir to path (Windows) @@ -103,4 +113,4 @@ jobs: - name: Run tests working-directory: modflow6/autotest - run: pytest -v -n auto --durations 0 test_z03_${{ matrix.repo }}.py \ No newline at end of file + run: pytest -v -n auto --durations 0 test_${{ matrix.repo }}.py \ No newline at end of file diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index 1973766a474..527952f547c 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -13,6 +13,16 @@ on: description: 'Branch to release from.' required: true type: string + compiler_toolchain: + description: 'Compiler toolchain to use. For supported options see https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md#compiler-compatibility.' + required: false + type: string + default: 'intel-classic' + compiler_version: + description: 'Compiler version to use. For supported options see https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md#compiler-compatibility.' + required: false + type: string + default: '2021.7' developmode: description: 'Build binaries in develop mode. If false, IDEVELOPMODE is set to 0.' required: false @@ -68,7 +78,7 @@ jobs: distname: ${{ steps.set_version.outputs.distname }} steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 path: modflow6 @@ -84,8 +94,11 @@ jobs: bash powershell - - name: Setup Intel Fortran - uses: modflowpy/install-intelfortran-action@v1 + - name: Setup ${{ inputs.compiler_toolchain }} ${{ inputs.compiler_version }} + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ inputs.compiler_toolchain }} + version: ${{ inputs.compiler_version }} - name: Set version number id: set_version @@ -139,14 +152,14 @@ jobs: # only run steps below if inputs.run_tests is true - name: Checkout modflow6-testmodels if: inputs.run_tests == true - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-testmodels path: modflow6-testmodels - name: Checkout modflow6-examples if: inputs.run_tests == true - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-examples path: modflow6-examples @@ -192,7 +205,7 @@ jobs: # compiling binaries, building documentation - name: Checkout usgslatex if: ${{ runner.os == 'Linux' && inputs.run_tests == true }} - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/usgslatex path: usgslatex @@ -212,22 +225,6 @@ jobs: working-directory: usgslatex/usgsLaTeX run: sudo ./install.sh --all-users - - name: Install dependencies for ex-gwf-twri example model - if: ${{ runner.os == 'Linux' && inputs.run_tests == true }} - working-directory: modflow6-examples/etc - run: | - # install extra Python packages - pip install -r requirements.pip.txt - - # the example model needs executables to be on the path - echo "${{ github.workspace }}/modflow6/bin" >> $GITHUB_PATH - echo "${{ github.workspace }}/modflow6/bin/downloaded" >> $GITHUB_PATH - - - name: Build ex-gwf-twri example model - if: ${{ runner.os == 'Linux' && inputs.run_tests == true }} - working-directory: modflow6-examples/scripts - run: python ex-gwf-twri.py - - name: Test distribution scripts if: ${{ inputs.run_tests == true }} working-directory: modflow6/distribution @@ -245,20 +242,20 @@ jobs: steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 path: modflow6 ref: ${{ inputs.branch }} - name: Checkout modflow6-examples - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-examples path: modflow6-examples - name: Checkout usgslatex - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/usgslatex path: usgslatex @@ -283,8 +280,11 @@ jobs: cache-downloads: true cache-environment: true - - name: Setup Intel Fortran - uses: modflowpy/install-intelfortran-action@v1 + - name: Setup ${{ inputs.compiler_toolchain }} ${{ inputs.compiler_version }} + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ inputs.compiler_toolchain }} + version: ${{ inputs.compiler_version }} - name: Update version id: update_version @@ -300,51 +300,44 @@ jobs: fi eval "$cmd" + - name: Update FloPy classes + working-directory: modflow6/autotest + run: python update_flopy.py + - name: Download pre-built binaries uses: actions/download-artifact@v3 with: name: bin-${{ runner.os }} path: bin + + # execute permissions may not have survived artifact upload/download + - name: Set executable permissions + working-directory: modflow6-examples/etc + run: | + chmod +x "${{ github.workspace }}/bin/mf6" + chmod +x "${{ github.workspace }}/bin/mf5to6" + chmod +x "${{ github.workspace }}/bin/zbud6" - name: Install dependencies for building models + if: inputs.full == true working-directory: modflow6-examples/etc env: GITHUB_TOKEN: ${{ github.token }} run: | - # install extra Python packages pip install -r requirements.pip.txt - - # the example model needs executables to be on the path echo "${{ github.workspace }}/bin" >> $GITHUB_PATH - - # execute permissions may not have survived artifact upload/download - chmod +x "${{ github.workspace }}/bin/mf6" - chmod +x "${{ github.workspace }}/bin/mf5to6" - chmod +x "${{ github.workspace }}/bin/zbud6" - - # the example model also needs mf2005 get-modflow "${{ github.workspace }}/bin" --subset mf2005,triangle,gridgen - - - name: Update FloPy - working-directory: modflow6/autotest - run: python update_flopy.py - - - name: Build ex-gwf-twri example model - if: inputs.full != true - working-directory: modflow6-examples/scripts - run: python ex-gwf-twri.py - name: Build example models if: inputs.full == true - working-directory: modflow6-examples/etc - run: python ci_build_files.py + working-directory: modflow6-examples/autotest + run: pytest -v -n auto test_scripts.py --init - - name: Create full docs folder structure + - name: Create folder structure if: inputs.full == true run: | + # Create empty folder structure for the /docs subdirectory distname=${{ needs.build.outputs.distname }} - - # Create a skeleton of the distribution's folder structure to include in the docs mkdir -p "$distname/doc" mkdir "$distname/make" mkdir "$distname/msvs" @@ -353,19 +346,34 @@ jobs: cp modflow6/meson.build "$distname/meson.build" cp -r modflow6-examples/examples "$distname" cp -r modflow6/src "$distname" - cp -r modflow6/utils "$distname" + cp -r modflow6/utils/mf5to6 "$distname/utils/mf5to6" + cp -r modflow6/utils/zonebudget "$distname/utils/zonebudget" # create LaTeX file describing the folder structure cd modflow6/doc/ReleaseNotes python mk_folder_struct.py -dp "${{ github.workspace }}/$distname" + - name: Collect deprecations + working-directory: modflow6/doc/mf6io/mf6ivar + run: | + python deprecations.py + cat md/deprecations.md + + - name: Upload deprecations + uses: actions/upload-artifact@v3 + with: + name: deprecations + path: modflow6/doc/mf6io/mf6ivar/md/deprecations.md + - name: Build documentation env: - # need a GITHUB_TOKEN to download example doc PDF asset from modflow6-examples repo + # this step is lazy about building the mf6 examples PDF document, first + # trying to download a prebuilt PDF from MODFLOW-USGS/modflow6-examples, + # so it needs a GITHUB_TOKEN. GITHUB_TOKEN: ${{ github.token }} run: | mkdir -p "${{ needs.build.outputs.distname }}/doc" - cmd="python modflow6/distribution/build_docs.py -b bin -o doc -e modflow6-examples" + cmd="python modflow6/distribution/build_docs.py -b bin -o doc" if [[ "${{ inputs.full }}" == "true" ]]; then cmd="$cmd --full" fi @@ -399,14 +407,14 @@ jobs: shell: bash -l {0} steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 path: modflow6 ref: ${{ inputs.branch }} - name: Checkout modflow6-examples - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MODFLOW-USGS/modflow6-examples path: modflow6-examples @@ -421,8 +429,11 @@ jobs: bash powershell - - name: Setup Intel Fortran - uses: modflowpy/install-intelfortran-action@v1 + - name: Setup ${{ inputs.compiler_toolchain }} ${{ inputs.compiler_version }} + uses: fortran-lang/setup-fortran@v1 + with: + compiler: ${{ inputs.compiler_toolchain }} + version: ${{ inputs.compiler_version }} - name: Update version id: update_version @@ -463,13 +474,9 @@ jobs: env: GITHUB_TOKEN: ${{ github.token }} run: | - # install extra Python packages pip install -r modflow6-examples/etc/requirements.pip.txt - - # example models need executables to be on the path distname="${{ needs.build.outputs.distname }}_${{ matrix.ostag }}" echo "$distname/bin" >> $GITHUB_PATH - # execute permissions may not have survived artifact upload/download chmod +x "$distname/bin/mf6" chmod +x "$distname/bin/mf5to6" @@ -487,8 +494,8 @@ jobs: - name: Build example models if: inputs.full == true - working-directory: modflow6-examples/etc - run: python ci_build_files.py + working-directory: modflow6-examples/autotest + run: pytest -v -n auto test_scripts.py --init - name: Build distribution env: @@ -523,10 +530,10 @@ jobs: $distname/utils \ $distname/code.json \ $distname/meson.build \ + $distname/meson.options \ -x '*.DS_Store' \ -x '*libmf6.lib' \ -x '*idmloader*' \ - -x '*pymake*' \ -x '*obj_temp*' \ -x '*mod_temp*' else @@ -538,7 +545,6 @@ jobs: -x '*.DS_Store' \ -x '*libmf6.lib' \ -x '*idmloader*' \ - -x '*pymake*' \ -x '*obj_temp*' \ -x '*mod_temp*' fi @@ -559,9 +565,9 @@ jobs: $distname/utils \ $distname/code.json \ $distname/meson.build \ + $distname/meson.options \ -xr!libmf6.lib \ -xr!idmloader \ - -xr!pymake \ -xr!obj_temp \ -xr!mod_temp else @@ -572,26 +578,10 @@ jobs: $distname/code.json \ -xr!libmf6.lib \ -xr!idmloader \ - -xr!pymake \ -xr!obj_temp \ -xr!mod_temp fi - # validate only after zipping distribution to avoid accidentally changing any files - - name: Validate distribution - run: | - cmd="pytest -v -s modflow6/distribution/check_dist.py --path ${{ needs.build.outputs.distname }}_${{ matrix.ostag }}" - if [[ "${{ inputs.approve }}" == "true" ]]; then - cmd="$cmd --approved" - fi - if [[ "${{ inputs.developmode }}" == "false" ]]; then - cmd="$cmd --releasemode" - fi - if [[ "${{ inputs.full }}" == "true" ]]; then - cmd="$cmd --full" - fi - eval "$cmd" - - name: Upload distribution uses: actions/upload-artifact@v3 with: @@ -604,3 +594,28 @@ jobs: with: name: release_notes path: "${{ needs.build.outputs.distname }}_${{ matrix.ostag }}/doc/release.pdf" + + - name: Check distribution + run: | + # unzip and validate the archive + distname="${{ needs.build.outputs.distname }}_${{ matrix.ostag }}" + distfile="$distname.zip" + checkdir="check" + mkdir $checkdir + if [[ "$RUNNER_OS" == "Windows" ]]; then + 7z x $distfile -o$checkdir + else + unzip $distfile -d $checkdir + fi + + cmd="pytest -v -s modflow6/distribution/check_dist.py --path $checkdir/$distname" + if [[ "${{ inputs.approve }}" == "true" ]]; then + cmd="$cmd --approved" + fi + if [[ "${{ inputs.developmode }}" == "false" ]]; then + cmd="$cmd --releasemode" + fi + if [[ "${{ inputs.full }}" == "true" ]]; then + cmd="$cmd --full" + fi + eval "$cmd" \ No newline at end of file diff --git a/.github/workflows/release_dispatch.yml b/.github/workflows/release_dispatch.yml index 567bab3eae3..3037c98698e 100644 --- a/.github/workflows/release_dispatch.yml +++ b/.github/workflows/release_dispatch.yml @@ -24,6 +24,16 @@ on: description: 'Branch to release from.' required: true type: string + compiler_toolchain: + description: 'Compiler toolchain to use. For supported options see https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md#compiler-compatibility.' + required: false + type: string + default: 'intel-classic' + compiler_version: + description: 'Compiler version to use. For supported options see https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md#compiler-compatibility.' + required: false + type: string + default: '2021.7' commit_version: description: 'Commit version numbers back to the develop branch. Not considered if reset is false.' required: false @@ -36,7 +46,7 @@ on: default: false run_tests: description: 'Run tests after building binaries.' - required: true + required: false type: boolean default: true version: @@ -53,6 +63,8 @@ jobs: shell: bash -l {0} outputs: branch: ${{ steps.set_branch.outputs.branch }} + compiler_toolchain: ${{ steps.set_compiler.outputs.compiler_toolchain }} + compiler_version: ${{ steps.set_compiler.outputs.compiler_version }} version: ${{ steps.set_version.outputs.version }} steps: - name: Set branch @@ -61,8 +73,8 @@ jobs: # if branch was provided explicitly via workflow_dispatch, use it if [[ ("${{ github.event_name }}" == "workflow_dispatch") && (-n "${{ inputs.branch }}") ]]; then branch="${{ inputs.branch }}" - # prevent releases from develop or master - if [[ ("$branch" == "develop") || ("$branch" == "master") ]]; then + # prevent releases from master + if [[ "$branch" == "master" ]]; then echo "error: releases may not be triggered from branch $branch" exit 1 fi @@ -77,6 +89,26 @@ jobs: exit 1 fi echo "branch=$branch" >> $GITHUB_OUTPUT + - name: Set compiler + id: set_compiler + run: | + # if compiler toolchain was provided explicitly via workflow_dispatch, use it + if [[ ("${{ github.event_name }}" == "workflow_dispatch") && (-n "${{ inputs.compiler_toolchain }}") ]]; then + compiler_toolchain="${{ inputs.compiler_toolchain }}" + compiler_version="${{ inputs.compiler_version }}" + echo "using compiler toolchain $compiler_toolchain version $compiler_version from workflow_dispatch" + elif [[ ("${{ github.event_name }}" == "push") && ("${{ github.ref_name }}" != "master") ]]; then + # if release was triggered by pushing a release branch, use the default toolchain and version + compiler_toolchain="intel-classic" + compiler_version="2021.7" + echo "using default compiler toolchain $compiler_toolchain version $compiler_version" + else + # otherwise exit with an error + echo "error: this workflow should not have triggered for event ${{ github.event_name }} on branch ${{ github.ref_name }}" + exit 1 + fi + echo "compiler_toolchain=$compiler_toolchain" >> $GITHUB_OUTPUT + echo "compiler_version=$compiler_version" >> $GITHUB_OUTPUT - name: Set version id: set_version run: | @@ -103,6 +135,8 @@ jobs: # If the workflow is manually triggered, the maintainer must manually set approve=true to approve a release. # If triggered by pushing a release branch, the release is approved if the branch name doesn't contain "rc". approve: ${{ (github.event_name == 'workflow_dispatch' && inputs.approve == 'true') || (github.event_name != 'workflow_dispatch' && !contains(github.ref_name, 'rc')) }} + compiler_toolchain: ${{ needs.set_options.outputs.compiler_toolchain }} + compiler_version: ${{ needs.set_options.outputs.compiler_version }} branch: ${{ needs.set_options.outputs.branch }} developmode: false full: true @@ -110,7 +144,7 @@ jobs: version: ${{ needs.set_options.outputs.version }} pr: name: Draft release PR - if: ${{ github.event_name == 'push' && github.ref_name != 'master' && (github.event_name == 'workflow_dispatch' && inputs.approve == 'true') || (github.event_name != 'workflow_dispatch' && !contains(github.ref_name, 'rc')) }} + if: ${{ github.ref_name != 'master' && ((github.event_name == 'workflow_dispatch' && inputs.approve == 'true') || (github.event_name != 'workflow_dispatch' && !contains(github.ref_name, 'rc'))) }} needs: - set_options - make_dist @@ -123,7 +157,7 @@ jobs: shell: bash -l {0} steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 ref: ${{ github.ref }} @@ -185,7 +219,7 @@ jobs: shell: bash -l {0} steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 path: modflow6 @@ -198,7 +232,7 @@ jobs: cache-environment: true - name: Download artifacts - uses: dawidd6/action-download-artifact@v2 + uses: dawidd6/action-download-artifact@v3 - name: Draft release working-directory: modflow6 @@ -229,7 +263,7 @@ jobs: steps: - name: Checkout modflow6 - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: ${{ github.repository_owner }}/modflow6 path: modflow6 diff --git a/.gitignore b/.gitignore index 56b28c72ec8..959f560e70f 100644 --- a/.gitignore +++ b/.gitignore @@ -133,3 +133,8 @@ unittests/ **/__pycache__ **/.benchmarks + +# compiler compatibility markdown tables +.github/compat/*.md + +**.DS_Store diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 00000000000..c518b77c314 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,66 @@ +# Deploy MODFLOW 6 to HPC systems. +# +# Expects shared environment variables... +# +# - GIT_REMOTE, name of the mf6 remote to pull from +# - GIT_BRANCH, name of the mf6 branch to pull from +# - MODULE_SCRIPT, module update script path (relative to mf6 proj root) +# - SSH_KNOWN_HOSTS, content of ~/.ssh/known_hosts +# - SSH_USERNAME, SSH username to login with +# - SSH_PRIVATE_KEY, SSH private key for user +# +# ...and environment-specific variables: +# +# - DENALI_HOSTNAME, SSH hostname of cluster +# - DENALI_SLURM_ACCOUNT, slurm account for jobs +# - DENALI_SLURM_RESERVATION, slurm reservation for jobs +# - DENALI_MODULES_PATH, path to root of module system +# - DENALI_MF6_PREV_VERSION, version of modulefile to use as template +# - DENALI_MF6_PROJ_ROOT, path to modflow6 project root +# - DENALI_BUILD_SCRIPT, relpath of script to build mf6 +# +# ...and likewise for HOVENWEEP_* or other systems + +image: ubuntu:20.04 +workflow: + rules: + - if: $CI_COMMIT_REF_NAME == $CI_DEFAULT_BRANCH && $CI_PIPELINE_SOURCE == 'push' +before_script: + # install ssh agent + - 'which ssh-agent || ( apt-get update -y && apt-get install openssh-client git -y )' + # configure ssh agent + - eval $(ssh-agent -s) + # set private key permissions + - chmod 400 "$SSH_PRIVATE_KEY" + # add keys to the agent store + - ssh-add "$SSH_PRIVATE_KEY" + # configure known hosts + - mkdir -p ~/.ssh + - cp "$SSH_KNOWN_HOSTS" ~/.ssh/known_hosts + - chmod 644 ~/.ssh/known_hosts +deploy_denali: + environment: denali + script: "$CI_PROJECT_DIR/.hpc/deploy.sh" + stage: deploy + variables: + SSH_USERNAME: $SSH_USERNAME + SSH_HOSTNAME: $DENALI_HOSTNAME + SLURM_ACCOUNT: $DENALI_SLURM_ACCOUNT + SLURM_RESERVATION: $DENALI_SLURM_RESERVATION + MODULES_PATH: $DENALI_MODULES_PATH + MF6_PROJ_ROOT: $DENALI_MF6_PROJ_ROOT + MF6_PREV_VERSION: $DENALI_MF6_PREV_VERSION + BUILD_SCRIPT: $DENALI_BUILD_SCRIPT +deploy_hovenweep: + environment: hovenweep + script: "$CI_PROJECT_DIR/.hpc/deploy.sh" + stage: deploy + variables: + SSH_USERNAME: $SSH_USERNAME + SSH_HOSTNAME: $HOVENWEEP_HOSTNAME + SLURM_ACCOUNT: $HOVENWEEP_SLURM_ACCOUNT + SLURM_RESERVATION: $HOVENWEEP_SLURM_RESERVATION + MODULES_PATH: $HOVENWEEP_MODULES_PATH + MF6_PROJ_ROOT: $HOVENWEEP_MF6_PROJ_ROOT + MF6_PREV_VERSION: $HOVENWEEP_MF6_PREV_VERSION + BUILD_SCRIPT: $HOVENWEEP_BUILD_SCRIPT \ No newline at end of file diff --git a/.hpc/BUILD.md b/.hpc/BUILD.md index dd8257e2b6d..9f9b0ac8374 100644 --- a/.hpc/BUILD.md +++ b/.hpc/BUILD.md @@ -1,20 +1,30 @@ + # Building MODFLOW 6 on HPC systems -## SLURM job +_On Denali_ ``` sbatch --reservation=dev cray-meson-build.slurm.batch ``` -## Interactive job +_Hovenweep_ + +``` +sbatch cray-hovenweep-meson-build.slurm.batch +``` + +## Create a module file for a new version of MODFLOW 6 + +On _Denali_ make a copy of an existing module file using +``` +rsync /home/software/denali/contrib/impd/modulefiles/modflow/6.5.0.dev0 /home/software/denali/contrib/impd/modulefiles/modflow/6.x.x +``` +On _Hovenweep_ make a copy of an existing module file using ``` -module switch PrgEnv-${PE_ENV,,} PrgEnv-intel -module load cray-petsc meson ninja -export PKG_CONFIG_PATH=/opt/cray/pe/mpt/7.7.19/gni/mpich-intel/16.0/lib/pkgconfig:/opt/cray/pe/petsc/3.14.5.0/real/INTEL/19.1/x86_skylake/lib/pkgconfig:$PKG_CONFIG_PATH +rsync /home/software/hovenweep/contrib/impd/modulefiles/modflow/6.5.0.dev0 /home/software/denali/contrib/impd/modulefiles/modflow/6.x.x +``` + +Edit `product_version` in the new module file from `6.5.0.dev0` to `6.x.x` on both systems. -srun --reservation=dev --account=impd --pty bash -meson setup builddir -Ddebug=false --prefix=$(pwd) --libdir=bin -Dcray=true -Ddebug=false --wipe -meson install -C builddir -``` \ No newline at end of file diff --git a/.hpc/cray-hovenweep-meson-build.slurm.batch b/.hpc/cray-hovenweep-meson-build.slurm.batch new file mode 100644 index 00000000000..a1020f54cf0 --- /dev/null +++ b/.hpc/cray-hovenweep-meson-build.slurm.batch @@ -0,0 +1,50 @@ +#!/bin/bash + +#SBATCH --job-name=hovenweep-build +#SBATCH --nodes=1 +#SBATCH --ntasks=2 +#SBATCH --account=impd +#SBATCH --time=00:10:00 +#SBATCH --output=slurm-%j.out +#SBATCH --chdir=../ + +set -euxo pipefail + +# load appropriate modules +module switch PrgEnv-${PE_ENV,,} PrgEnv-intel +module load petsc/3.15.5 +export PKG_CONFIG_PATH=$CRAY_MPICH_DIR/lib/pkgconfig:$PKG_CONFIG_PATH + +# list loaded modules +module list + +# define the project root (expected to be cwd) +MODFLOW6ROOT=$(pwd) + +# define the version +VERSION=$(cat "$MODFLOW6ROOT/version.txt") +echo "MODFLOW 6 version: $VERSION" + +# define paths relative to the root directory +BUILDDIR=$MODFLOW6ROOT/$PE_ENV-$VERSION +BINDIR=$BUILDDIR/src +TESTDIR=$MODFLOW6ROOT/.mf6minsim + +# define the installation location +PREFIX=/home/software/hovenweep/contrib/impd/apps/modflow/$VERSION/$PE_ENV/2023.2.0 + +# build MODFLOW 6 +CC=cc CXX=CC F77=ftn F90=ftn FC=ftn meson setup $BUILDDIR --prefix=$PREFIX --bindir=bin --libdir=lib -Dcray=true -Ddebug=false --wipe +meson compile -C $BUILDDIR + +# install MODFLOW 6 +meson install -C $BUILDDIR + +# test MODFLOW 6 build +cd $TESTDIR + +# serial run +$BINDIR/mf6 + +# parallel run +srun $BINDIR/mf6 -p \ No newline at end of file diff --git a/.hpc/cray-meson-build.slurm.batch b/.hpc/cray-meson-build.slurm.batch index c49de516198..1f62d43f6f3 100644 --- a/.hpc/cray-meson-build.slurm.batch +++ b/.hpc/cray-meson-build.slurm.batch @@ -1,11 +1,14 @@ #!/bin/bash -#SBATCH --job-name=meson-MODFLOW-build +#SBATCH --job-name=denali-build #SBATCH --nodes=1 #SBATCH --ntasks=2 #SBATCH --account=impd #SBATCH --time=00:10:00 #SBATCH --output=slurm-%j.out +#SBATCH --chdir=../ + +set -euxo pipefail # load appropriate modules module switch PrgEnv-${PE_ENV,,} PrgEnv-intel @@ -15,17 +18,27 @@ export PKG_CONFIG_PATH=/opt/cray/pe/mpt/7.7.19/gni/mpich-intel/16.0/lib/pkgconfi # list loaded modules module list -# move to root directory -cd .. +# define the project root (expected to be cwd) +MODFLOW6ROOT=$(pwd) + +# define the version +VERSION=$(cat "$MODFLOW6ROOT/version.txt") +echo "MODFLOW 6 version: $VERSION" # define paths relative to the root directory -MODFLOW6ROOT=$(pwd) -BINDIR=$MODFLOW6ROOT/bin +BUILDDIR=$MODFLOW6ROOT/$PE_ENV-$VERSION +BINDIR=$BUILDDIR/src TESTDIR=$MODFLOW6ROOT/.mf6minsim +# define the installation location +PREFIX=/home/software/denali/contrib/impd/apps/modflow/$VERSION/$PE_ENV/19.1.0.166 + # build MODFLOW 6 -CC=cc CXX=CC F77=ftn F90=ftn FC=ftn meson setup builddir --prefix=$(pwd) --libdir=bin -Dcray=true -Ddebug=false --wipe -meson install -C builddir +CC=cc CXX=CC F77=ftn F90=ftn FC=ftn meson setup $BUILDDIR --prefix=$PREFIX --bindir=bin --libdir=lib -Dcray=true -Ddebug=false +meson compile -C $BUILDDIR + +# install MODFLOW 6 +meson install -C $BUILDDIR # test MODFLOW 6 build cd $TESTDIR @@ -34,4 +47,4 @@ cd $TESTDIR $BINDIR/mf6 # parallel run -srun $BINDIR/mf6 -p +srun $BINDIR/mf6 -p \ No newline at end of file diff --git a/.hpc/deploy.sh b/.hpc/deploy.sh new file mode 100755 index 00000000000..b95b6c7f381 --- /dev/null +++ b/.hpc/deploy.sh @@ -0,0 +1,13 @@ +#!/bin/bash + +set -euxo pipefail + +# fetch and checkout latest +ssh -l "$SSH_USERNAME" "$SSH_HOSTNAME" "cd $MF6_PROJ_ROOT && git fetch $GIT_REMOTE && git checkout $GIT_REMOTE/$GIT_BRANCH" +echo "Updated repository $MF6_PROJ_ROOT" +# submit a job to build mf6 +jobid=$(ssh -l "$SSH_USERNAME" "$SSH_HOSTNAME" "sbatch --account=$SLURM_ACCOUNT --reservation=$SLURM_RESERVATION --parsable -D $MF6_PROJ_ROOT $MF6_PROJ_ROOT/$BUILD_SCRIPT" | tail -n 1) +echo "Submitted build job $jobid" +# submit a job to update the mf6 module +jobid=$(ssh -l "$SSH_USERNAME" "$SSH_HOSTNAME" "sbatch --export=ALL,MF6_PREV_VERSION=$MF6_PREV_VERSION,MF6_PROJ_ROOT=$MF6_PROJ_ROOT,MODULES_PATH=$MODULES_PATH --account=$SLURM_ACCOUNT --reservation=$SLURM_RESERVATION --parsable -D $MF6_PROJ_ROOT -d afterok:$jobid $MF6_PROJ_ROOT/$MODULE_SCRIPT" | tail -n 1) +echo "Submitted module update job $jobid" \ No newline at end of file diff --git a/.hpc/update-module.slurm.batch b/.hpc/update-module.slurm.batch new file mode 100644 index 00000000000..00135103525 --- /dev/null +++ b/.hpc/update-module.slurm.batch @@ -0,0 +1,31 @@ +#!/bin/bash + +#SBATCH --job-name=update-mf6-module +#SBATCH --nodes=1 +#SBATCH --ntasks=1 +#SBATCH --account=impd +#SBATCH --time=00:05:00 +#SBATCH --output=slurm-%j.out +#SBATCH --chdir=../ + +set -euxo pipefail + +# this script expects cwd to be mf6 project root, with env vars... +# - MF6_PREV_VERSION, mf6 modulefile version to use as a template +# - MODULES_PATH, the base path of the module system +MF6_PROJ_ROOT=$(pwd) +MF6_BINDIR="$MF6_PROJ_ROOT/bin" +MF6_LOCAL_VERSION=$(cat "$MF6_PROJ_ROOT/version.txt") + +# ...and assumes the module system is laid out as follows +MF6_MODULEFILE_PATH="$MODULES_PATH/modulefiles/modflow/$MF6_LOCAL_VERSION" +MF6_MODULES_PATH="$MODULES_PATH/apps/modflow" +MF6_MODULE_PATH="$MF6_MODULES_PATH/$MF6_LOCAL_VERSION" + +# create mf6 modulefile if needed (the build script +# will have already created the module directory) +if [ ! -f "$MF6_MODULEFILE_PATH" ]; then + rsync "$MODULES_PATH/modulefiles/modflow/$MF6_PREV_VERSION" "$MF6_MODULEFILE_PATH" + sed -i -e "s/$MF6_PREV_VERSION/$MF6_LOCAL_VERSION/g" "$MF6_MODULEFILE_PATH" + echo "Created module file: $MF6_MODULEFILE_PATH" +fi \ No newline at end of file diff --git a/.readthedocs.yml b/.readthedocs.yml index 086932137d8..808702f8077 100644 --- a/.readthedocs.yml +++ b/.readthedocs.yml @@ -5,6 +5,11 @@ # Required version: 2 +build: + os: "ubuntu-22.04" + tools: + python: "3.11" + # Build documentation in the docs/ directory with Sphinx sphinx: configuration: .doc/conf.py @@ -18,6 +23,5 @@ formats: all # Optionally set the version of Python and requirements required to build your docs python: - version: 3.8 install: - requirements: .build_rtd_docs/requirements.rtd.txt diff --git a/.vscode/build_vscode.py b/.vscode/build_vscode.py index 88d3e8b4c97..d222cc7c772 100644 --- a/.vscode/build_vscode.py +++ b/.vscode/build_vscode.py @@ -24,7 +24,7 @@ if args.buildtype == "release": setup_flag = ["-Doptimization=2"] elif args.buildtype == "debug": - setup_flag = ["-Doptimization=0"] + setup_flag = ["-Ddebug=true", "-Doptimization=0"] if not os.path.isdir(builddir): command = [ diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 490baff6416..76f6cb2fe2d 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -26,7 +26,10 @@ "release", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -53,7 +56,10 @@ "release", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -81,7 +87,10 @@ "release", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -108,7 +117,10 @@ "release", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -136,7 +148,10 @@ "debug", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -163,7 +178,10 @@ "debug", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -191,7 +209,10 @@ "debug", "build", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } @@ -218,7 +239,10 @@ "debug", "rebuild", ], - "group": "build", + "group": { + "kind": "build", + "isDefault": true + }, "presentation": { "clear": true } diff --git a/CITATION.cff b/CITATION.cff index b378cfa4c99..1595372ce9e 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite the software itself. type: software title: MODFLOW 6 Modular Hydrologic Model -version: 6.4.2 -date-released: '2023-06-28' +version: 6.4.3 +date-released: '2024-02-07' doi: 10.5066/F76Q1VQV abstract: MODFLOW 6 is an object-oriented program and framework developed to provide a platform for supporting multiple models and multiple types of models within the @@ -58,6 +58,11 @@ authors: alias: w-bonelli affiliation: U.S. Geological Survey orcid: https://orcid.org/0000-0002-2665-5078 +- family-names: Boyce + given-names: Scott E. + alias: ScottBoyce + affiliation: U.S. Geological Survey + orcid: https://orcid.org/0000-0003-0626-9492 - family-names: Banta given-names: Edward R. affiliation: U.S. Geological Survey diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md index 62f6ede8b94..d89a4670001 100644 --- a/CODE_OF_CONDUCT.md +++ b/CODE_OF_CONDUCT.md @@ -1,7 +1,7 @@ Code of Conduct =============== -All contributions to- and interactions surrounding- this project will abide by +All contributions to — and interactions surrounding — this project will abide by the [USGS Code of Scientific Conduct][1]. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 96e163a9268..e751d48539d 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -141,7 +141,7 @@ To ensure consistency throughout the source code, keep these rules in mind as yo ## Format Rules Fortran souce code format rules are met by running the -[fprettify formatter](https://github.com/pseewald/fprettify) while specifying the [MODFLOW 6 fprettify configuration](https://github.com/MODFLOW-USGS/modflow6/blob/develop/distribution/.fprettify.yaml). `fprettify` is included in the Conda `environment.yml` and can be run on the command line or integrated into a [VSCode](https://github.com/MODFLOW-USGS/modflow6/blob/develop/.vscode/README.md) or Visual Studio environment. +[fprettify formatter](https://github.com/pseewald/fprettify) while specifying the [MODFLOW 6 fprettify configuration](.fprettify.yaml). `fprettify` is included in the Conda `environment.yml` and can be run on the command line or integrated into a [VSCode](.vscode/README.md) or Visual Studio environment. The configuration file reflects the current minimum standard for Fortran source formatting. The main goal, however, is consistent and readable Fortran source code and as such pay particular attention to consistency within and across files. As the formatting tool may at times shift code in unexpected ways, check for formatting consistency after running. @@ -234,9 +234,3 @@ The body should include the motivation for the change and contrast this with pre The footer should contain any information about **Breaking Changes** and is also the place to reference GitHub issues that this commit **Closes**. **Breaking Changes** should start with the word `BREAKING CHANGE:` with a space or two newlines. The rest of the commit message is then used for this. - - -[coc]: https://github.com/MODFLOW-USGS/modflow6/blob/develop/CODE_OF_CONDUCT.md -[dev-doc]: https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md -[github]: https://github.com/MODFLOW-USGS/modflow6 -[stackoverflow]: http://stackoverflow.com/questions/tagged/modflow6 diff --git a/DEVELOPER.md b/DEVELOPER.md index cc53837d8f0..ce6d7a47783 100644 --- a/DEVELOPER.md +++ b/DEVELOPER.md @@ -17,6 +17,9 @@ To build and test a parallel version of the program, first read the instructions - [Windows](#windows) - [Intel Fortran](#intel-fortran) - [Windows](#windows-1) + - [Compiler compatibility](#compiler-compatibility) + - [Compile](#compile) + - [Test](#test) - [Python](#python) - [Dependencies](#dependencies) - [`meson`](#meson) @@ -32,17 +35,32 @@ To build and test a parallel version of the program, first read the instructions - [Building](#building) - [Testing](#testing) - [Configuring a test environment](#configuring-a-test-environment) - - [Building development binaries](#building-development-binaries) - - [Rebuilding and installing release binaries](#rebuilding-and-installing-release-binaries) - - [Updating `flopy` plugins](#updating-flopy-plugins) - - [External model repositories](#external-model-repositories) - - [Installing external repos](#installing-external-repos) - - [Test models](#test-models) - - [Example models](#example-models) - - [Running Tests](#running-tests) - - [Selecting tests with markers](#selecting-tests-with-markers) - - [External model tests](#external-model-tests) - - [Writing tests](#writing-tests) + - [Configuring unit tests](#configuring-unit-tests) + - [Configuring integration tests](#configuring-integration-tests) + - [Rebuilding release binaries](#rebuilding-release-binaries) + - [Updating FloPy packages](#updating-flopy-packages) + - [Installing external models](#installing-external-models) + - [Running tests](#running-tests) + - [Running unit tests](#running-unit-tests) + - [Running integration tests](#running-integration-tests) + - [Selecting tests with markers](#selecting-tests-with-markers) + - [Writing tests](#writing-tests) + - [Writing unit tests](#writing-unit-tests) + - [Writing integration tests](#writing-integration-tests) +- [Generating makefiles](#generating-makefiles) + - [Updating extra and excluded files](#updating-extra-and-excluded-files) + - [Testing makefiles](#testing-makefiles) + - [Installing `make` on Windows](#installing-make-on-windows) + - [Using Conda from Git Bash](#using-conda-from-git-bash) +- [Branching model](#branching-model) + - [Overview](#overview) + - [Managing long-lived branches](#managing-long-lived-branches) + - [Backup](#backup) + - [Squash](#squash) + - [Rebase](#rebase) + - [Cleanup](#cleanup) +- [Deprecation policy](#deprecation-policy) + - [Finding deprecations](#finding-deprecations) @@ -79,8 +97,16 @@ GNU Fortran can be installed on all three major platforms. ##### macOS -- [Homebrew](https://brew.sh/): `brew install gcc` -- [MacPorts](https://www.macports.org/): `sudo port install gcc10` +- [Homebrew](https://brew.sh/): `brew install gcc@13` +- [MacPorts](https://www.macports.org/): `sudo port install gcc13` + +**Note:** Xcode 15 includes a new linker implementation which breaks GNU Fortran compatibility. A workaround is to set `LDFLAGS` to use the classic linker, for instance: + +```shell +export LDFLAGS="$LDFLAGS -Wl,-ld_classic" +``` + +See [this ticket](https://github.com/mesonbuild/meson/issues/12282) on the Meson repository for more information. ##### Windows @@ -96,10 +122,12 @@ GNU Fortran can be installed on all three major platforms. #### Intel Fortran -Intel Fortran can also be used to compile MODFLOW 6 and associated utilities. The `ifort` compiler is available in the [Intel oneAPI HPC Toolkit](https://software.intel.com/content/www/us/en/develop/tools/oneapi/hpc-toolkit/download.html). An installer is bundled with the download. +Intel Fortran can also be used to compile MODFLOW 6 and associated utilities. The `ifort` and `ifx` compilers are available in the [Intel oneAPI HPC Toolkit](https://software.intel.com/content/www/us/en/develop/tools/oneapi/hpc-toolkit/download.html). A number of environment variables must be set before using Intel Fortran. General information can be found [here](https://www.intel.com/content/www/us/en/develop/documentation/oneapi-programming-guide/top/oneapi-development-environment-setup.html), with specific instructions to configure a shell session for `ifort` [here](https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/compiler-setup/use-the-command-line/specifying-the-location-of-compiler-components.html). +While the current development version of MODFLOW 6 is broadly compatible with `ifort`, `ifx` compatibility is still limited on Ubuntu and Windows, and `ifx` is not supported on macOS. + ##### Windows On Windows, [Visual Studio](https://visualstudio.microsoft.com) and a number of libraries must be installed for `ifort` to work. The required libraries can be installed by ticking the "Desktop Development with C++" checkbox in the Visual Studio Installer's Workloads tab. @@ -110,6 +138,36 @@ On Windows, [Visual Studio](https://visualstudio.microsoft.com) and a number of cmd.exe "/K" '"C:\Program Files (x86)\Intel\oneAPI\setvars-vcvarsall.bat" && "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" && powershell' ``` +#### Compiler compatibility + +The following tables are automatically generated by [a CI workflow](.github/workflows/compilers.yml). + +##### Compile + + +| runner | gcc 10 | gcc 11 | gcc 12 | gcc 13 | gcc 7 | gcc 8 | gcc 9 | intel-classic 2021.1 | intel-classic 2021.10 | intel-classic 2021.2 | intel-classic 2021.3 | intel-classic 2021.4 | intel-classic 2021.5 | intel-classic 2021.6 | intel-classic 2021.7 | intel-classic 2021.8 | intel-classic 2021.9 | intel 2021.1 | intel 2021.2 | intel 2021.4 | intel 2022.0 | intel 2022.1 | intel 2022.2.1 | intel 2022.2 | intel 2023.0 | intel 2023.1 | intel 2023.2 | +|:-------------|:----------------|:----------------|:----------------|:----------------|:---------------|:---------------|:---------------|:------------------------------|:-------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|----------------------:|----------------------:|----------------------:|----------------------:|----------------------:|:------------------------|:----------------------|----------------------:|----------------------:|:----------------------| +| macos-11 | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | +| macos-12 | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | +| ubuntu-20.04 | ✓ | ✓ | | | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | ✓ | ✓ | | | ✓ | +| ubuntu-22.04 | ✓ | ✓ | ✓ | ✓ | | | ✓ | ✓ | ✓ | ✓ | | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | ✓ | ✓ | | | ✓ | +| windows-2019 | ✓ | ✓ | ✓ | ✓ | | | ✓ | | ✓ | | | | | ✓ | ✓ | ✓ | ✓ | | | | | | | ✓ | | | ✓ | +| windows-2022 | ✓ | ✓ | ✓ | ✓ | | | ✓ | | ✓ | | | | | ✓ | ✓ | ✓ | ✓ | | | | | | | ✓ | | | ✓ | + + +##### Test + + +| runner | gcc 10 | gcc 11 | gcc 12 | gcc 13 | gcc 7 | gcc 8 | gcc 9 | intel-classic 2021.1 | intel-classic 2021.10 | intel-classic 2021.2 | intel-classic 2021.3 | intel-classic 2021.4 | intel-classic 2021.5 | intel-classic 2021.6 | intel-classic 2021.7 | intel-classic 2021.8 | intel-classic 2021.9 | intel 2021.1 | intel 2021.2 | intel 2021.4 | intel 2022.0 | intel 2022.1 | intel 2022.2.1 | intel 2022.2 | intel 2023.0 | intel 2023.1 | intel 2023.2 | +|:-------------|:----------------|:----------------|:----------------|:----------------|:---------------|:---------------|:---------------|:------------------------------|-------------------------------:|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|:------------------------------|------------------------------:|------------------------------:|----------------------:|----------------------:|----------------------:|----------------------:|----------------------:|------------------------:|----------------------:|----------------------:|----------------------:|----------------------:| +| macos-11 | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | | | +| macos-12 | ✓ | ✓ | ✓ | ✓ | | | | ✓ | | ✓ | ✓ | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | | | +| ubuntu-20.04 | ✓ | ✓ | | | ✓ | ✓ | ✓ | ✓ | | ✓ | | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | | | +| ubuntu-22.04 | ✓ | ✓ | ✓ | ✓ | | | ✓ | ✓ | | ✓ | | ✓ | ✓ | ✓ | ✓ | | | | | | | | | | | | | +| windows-2019 | | | | ✓ | | | | | | | | | | ✓ | ✓ | | | | | | | | | | | | | +| windows-2022 | ✓ | ✓ | ✓ | ✓ | | | ✓ | | | | | | | ✓ | ✓ | | | | | | | | | | | | | + + ### Python Python 3.8+ is required to run MODFLOW 6 tests. A Conda distribution (e.g. [miniconda](https://docs.conda.io/en/latest/miniconda.html) or [Anaconda](https://www.anaconda.com/products/individual) is recommended. Python dependencies are specified in `environment.yml`. To create an environment, run from the project root: @@ -141,7 +199,7 @@ These are each described briefly below. The Conda `environment.yml` contains a n ##### `fprettify` -[`fprettify`](https://github.com/pseewald/fprettify) can be used to format Fortran source code and in combination with the [MODFLOW 6 fprettify configuration](https://github.com/MODFLOW-USGS/modflow6/blob/develop/distribution/.fprettify.yaml) establishes a contribution standard for properly formatted MODFLOW 6 Fortran source. This tool can be installed with `pip` or `conda` and used from the command line or integrated with a [VSCode](https://github.com/MODFLOW-USGS/modflow6/blob/develop/.vscode/README.md) or Visual Studio development environment. The `fprettify` package is included in the Conda environment in `environment.yml`. See [contribution guidelines](https://github.com/MODFLOW-USGS/modflow6/blob/develop/CONTRIBUTING.md) for additional information. +[`fprettify`](https://github.com/pseewald/fprettify) can be used to format Fortran source code and in combination with the [MODFLOW 6 fprettify configuration](.fprettify.yaml) establishes a contribution standard for properly formatted MODFLOW 6 Fortran source. This tool can be installed with `pip` or `conda` and used from the command line or integrated with a [VSCode](.vscode/README.md) or Visual Studio development environment. The `fprettify` package is included in the Conda environment in `environment.yml`. See [contribution guidelines](CONTRIBUTING.md) for additional information. ##### `mfpymake` @@ -151,7 +209,7 @@ The `mfpymake` package can build MODFLOW 6 and related programs and artifacts (e [`flopy`](https://github.com/modflowpy/flopy) is used throughout MODFLOW 6 tests to create, run and post-process models. -Like MODFLOW 6, `flopy` is modular — for each MODFLOW 6 package there is generally a corresponding `flopy` plugin. Plugins are generated dynamically from DFN files stored in this repository under `doc/mf6io/mf6ivar/dfn`. +Like MODFLOW 6, `flopy` is modular — for each MODFLOW 6 package there is generally a corresponding `flopy` package. Packages are generated dynamically from DFN files stored in this repository under `doc/mf6io/mf6ivar/dfn`. ##### `modflow-devtools` @@ -198,11 +256,12 @@ git remote add upstream https://github.com/MODFLOW-USGS/modflow6.git Meson is the recommended build tool for MODFLOW 6. [Meson](https://mesonbuild.com/Getting-meson.html) must be installed and on your [PATH](https://en.wikipedia.org/wiki/PATH_(variable)). Creating and activating the Conda environment `environment.yml` should be sufficient for this. -Meson build configuration files are provided for MODFLOW 6 as well as `zbud6` and `mf5to6` utility programs: +Meson build configuration files are provided for MODFLOW 6, for the ZONEBUDGET and MODFLOW 2005 to 6 converter utility programs, and for Fortran unit tests (see [Testing](#testing) section below). - `meson.build` - `utils/zonebudget/meson.build` - `utils/mf5to6/meson.build` +- `autotest/meson.build` To build MODFLOW 6, first configure the build directory. By default Meson uses compiler flags for a release build. To create a debug build, add `-Doptimization=0` to the following `setup` command. @@ -232,45 +291,58 @@ The binaries can then be found in the `bin` folder. `meson install` also trigger ## Testing -MODFLOW 6 tests are driven with [`pytest`](https://docs.pytest.org/en/7.1.x/), with the help of plugins like `pytest-xdist` and `pytest-cases`. Testing dependencies are included in the Conda environment `environment.yml`. +MODFLOW 6 unit tests are written in Fortran with [`test-drive`](https://github.com/fortran-lang/test-drive). + +MODFLOW 6 integration tests are written in Python with [`pytest`](https://docs.pytest.org/en/7.1.x/). Integration testing dependencies are included in the Conda environment `environment.yml`. **Note:** the entire test suite should pass before a pull request is submitted. Tests run in GitHub Actions CI and a PR can only be merged with passing tests. See [`CONTRIBUTING.md`](CONTRIBUTING.md) for more information. ### Configuring a test environment -A few tasks must be completed before running tests: +Before running tests, there are a few steps to complete. Most importantly, the local development version of MODFLOW 6 must be built, e.g. with Meson as described above. -- build local MODFLOW 6 development version -- rebuild the last MODFLOW 6 release -- install additional executables -- update FloPy packages and plugins -- clone MODFLOW 6 test model and example repositories +The `autotest/build_exes.py` script is provided as a shortcut to rebuild local binaries. It can be invoked as a standard Python script or with Pytest. By default, binaries are placed in the `bin` directory relative to the project root, as in the Meson commands described above. To change the location of the binaries, use the `--path` option. -Tests expect binaries to live in the `bin` directory relative to the project root, as configured above in the `meson` commands. Binaries are organized as follows: +#### Configuring unit tests -- local development binaries in the top-level `bin` folder -- binaries rebuilt in development mode from the latest release in `bin/rebuilt` -- related programs installed from the [executables distribution](https://github.com/MODFLOW-USGS/executables/releases) live in `bin/downloaded` +Unit tests are [driven with Meson](https://mesonbuild.com/Unit-tests.html). A small number of Meson-native tests are defined in the top-level `meson.build` file to check that MODFLOW 6 has installed successfully. These require no additional configuration. -Tests must be run from the `autotest` folder. +Additional Fortran unit tests are defined with [`test-drive`](https://github.com/fortran-lang/test-drive) in the `autotest/` folder, with test files named `Test*.f90`. If Meson fails to find the `test-drive` library via `pkg-config`, these will be skipped. -#### Building development binaries +To install `test-drive`: -Before running tests, the local development version of MODFLOW 6 must be built with `meson` as described above. The `autotest/build_exes.py` script is provided as a shortcut to easily rebuild local binaries. The script can be run from the project root with: +1. Clone the `test-drive` repository +2. Setup/build with Meson, e.g. in a Unix shell from the `test-drive` project root: ```shell -python autotest/build_exes.py +meson setup builddir --prefix=$PWD --libdir=lib +meson install -C builddir ``` -Alternatively, it can be run from the `autotest` directory with `pytest`: +3. Add `/lib/pkgconfig` to the `PKG_CONFIG_PATH` environment variable. +4. To confirm that `test-drive` is detected by `pkg-config`, run `pkg-config --libs test-drive`. -```shell -pytest build_exes.py -``` +Meson should now detect the `test-drive` library when building MODFLOW 6. + +**Note:** the `test-drive` source code is not yet compatible with recent versions of Intel Fortran, building with `gfortran` is recommended. -By default, binaries will be placed in the `bin` directory relative to the project root, as in the `meson` commands described above. To change the location of the binaries, use the `--path` option. +See the [Running unit tests](#running-unit-tests) section for instructions on running unit tests. -#### Rebuilding and installing release binaries +#### Configuring integration tests + +A few more tasks must be completed before integration testing: + +- install MODFLOW-related executables +- ensure FloPy packages are up to date +- install MODFLOW 6 example/test models + +As mentioned above, binaries live in the `bin` subdirectory of the project root. This directory is organized as follows: + +- local development binaries in the top-level `bin` +- binaries rebuilt in development mode from the latest MODFLOW 6 release in `bin/rebuilt/` +- related programs installed from the [executables distribution](https://github.com/MODFLOW-USGS/executables/releases) in `bin/downloaded/` + +##### Rebuilding release binaries Tests require the latest official MODFLOW 6 release to be compiled in develop mode with the same Fortran compiler as the development version. A number of binaries distributed from the [executables repo](https://github.com/MODFLOW-USGS/executables) must also be installed. The script `autotest/get_exes.py` does both of these things. It can be run from the project root with: @@ -284,70 +356,56 @@ Alternatively, with `pytest` from the `autotest` directory: pytest get_exes.py ``` -By default, binaries will be placed in the `bin` directory relative to the project root, as in the `meson` commands described above. Nested `bin/downloaded` and `bin/rebuilt` directories are created to contain the rebuilt last release and the downloaded executables, respectively. To change the location of the binaries, use the `--path` option. +As above, binaries are placed in the `bin` subdirectory of the project root, with nested `bin/downloaded` and `bin/rebuilt` subdirectories containing the rebuilt latest release and downloaded binaries, respectively. -#### Updating `flopy` plugins +##### Updating FloPy packages -Plugins should be regenerated from DFN files before running tests for the first time or after definition files change. This can be done with the `autotest/update_flopy.py` script, which wipes and regenerates plugin classes for the `flopy` installed in the Python environment. +FloPy packages should be regenerated from DFN files before running tests for the first time or after definition files change. This can be done with the `autotest/update_flopy.py` script, which wipes and regenerates package classes for the FloPy installed in the Python environment. -**Note:** if you've installed a local version of `flopy` from source, running this script can overwrite files in your repository. +**Note:** if you've installed an editable local version of FloPy from source, running this script can overwrite files in your repository. -There is a single optional argument, the path to the folder containing definition files. By default DFN files are assumed to live in `doc/mf6io/mf6ivar/dfn`, making the following identical: +There is a single optional argument, the path to the folder containing definition files. By default DFN files are assumed to live in `doc/mf6io/mf6ivar/dfn`, making the following functionally identical: ```shell python autotest/update_flopy.py python autotest/update_flopy.py doc/mf6io/mf6ivar/dfn ``` -#### External model repositories +##### Installing external models -Some autotests load example models from external repositories: +Some autotests load models from external repositories: - [`MODFLOW-USGS/modflow6-testmodels`](https://github.com/MODFLOW-USGS/modflow6-testmodels) - [`MODFLOW-USGS/modflow6-largetestmodels`](https://github.com/MODFLOW-USGS/modflow6-largetestmodels) - [`MODFLOW-USGS/modflow6-examples`](https://github.com/MODFLOW-USGS/modflow6-examples) -#### Installing external repos - -By default, the tests expect these repositories side-by-side with (i.e. in the same parent directory as) the `modflow6` repository. If the repos are somewhere else, you can set the `REPOS_PATH` environment variable to point to their parent directory. If external model repositories are not found, tests requiring them will be skipped. - -**Note:** a convenient way to persist environment variables needed for tests is to store them in a `.env` file in the `autotest` folder. Each variable should be defined on a separate line, with format `KEY=VALUE`. The `pytest-dotenv` plugin will then automatically load any variables found in this file into the test process' environment. - -##### Test models +See the [MODFLOW devtools documentation](https://modflow-devtools.readthedocs.io/en/latest/md/install.html#installing-external-model-repositories) for instructions to install external model repositories. -The test model repos can simply be cloned — ideally, into the parent directory of the `modflow6` repository, so that repositories live side-by-side: +### Running tests -```shell -git clone MODFLOW-USGS/modflow6-testmodels -git clone MODFLOW-USGS/modflow6-largetestmodels -``` +MODFLOW 6 has two kinds of tests: Fortran unit tests, driven with Meson, and Python integration tests, driven with Pytest. -##### Example models +#### Running unit tests -First clone the example models repo: +Unit tests must be run from the project root. To run unit tests in verbose mode: ```shell -git clone MODFLOW-USGS/modflow6-examples +meson test -C builddir --no-rebuild --verbose ``` -The example models require some setup after cloning. Some extra Python dependencies are required to build the examples: - -```shell -cd modflow6-examples/etc -pip install -r requirements.pip.txt -``` +Without the `--no-rebuild` options, Meson will rebuild the project before running tests. -Then, still from the `etc` folder, run: +Unit tests can be selected by module name (as listed in `autotest/tester.f90`). For instance, to test the `ArrayHandlersModule`: ```shell -python ci_build_files.py +meson test -C builddir --no-rebuild --verbose ArrayHandlers ``` -This will build the examples for subsequent use by the tests. +To run a test module in the `gdb` debugger, just add the `--gdb` flag to the test command. -### Running Tests +#### Running integration tests -Tests are driven by `pytest` and must be run from the `autotest` folder. To run tests in a particular file, showing verbose output, use: +Integration tests must be run from the `autotest/` folder. To run tests in a particular file, showing verbose output, use: ```shell pytest -v @@ -359,7 +417,7 @@ Tests can be run in parallel with the `-n` option, which accepts an integer argu pytest -v -n auto ``` -#### Selecting tests with markers +##### Selecting tests with markers Markers can be used to select subsets of tests. Markers provided in `pytest.ini` include: @@ -382,8 +440,6 @@ pytest -v -n auto -S [Smoke testing](https://modflow-devtools.readthedocs.io/en/latest/md/markers.html#smoke-testing) is a form of integration testing which aims to test a decent fraction of the codebase quickly enough to run often during development. -#### External model tests - Tests using models from external repositories can be selected with the `repo` marker: ```shell @@ -396,27 +452,64 @@ The `large` marker is a subset of the `repo` marker. To test models excluded fro pytest -v -n auto -m "large" ``` -Test scripts for external model repositories can also be run independently: +Tests load external models from fixtures provided by `modflow-devtools`. External model tests can be selected by model or simulation name, or by packages used. See the [`modflow-devtools` documentation](https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#filtering) for usage examples. Note that filtering options only apply to tests using external models, and will not filter tests defining models in code — for that, the `pytest` built-in `-k` option may be used. -```shell -# MODFLOW 6 test models -pytest -v -n auto test_z01_testmodels_mf6.py +### Writing tests + +#### Writing unit tests + +To add a new unit test: + +- Add a file containing a test module, e.g. `TestArithmetic.f90`, to the `autotest/` folder. + +```fortran +module TestArithmetic + use testdrive, only : error_type, unittest_type, new_unittest, check, test_failed + implicit none + private + public :: collect_arithmetic +contains + + subroutine collect_arithmetic(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("add", test_add)] + end subroutine collect_arithmetic + + subroutine test_add(error) + type(error_type), allocatable, intent(out) :: error + call check(error, 1 + 1 == 2, "Math works") + if (allocated(error)) then + call test_failed(error, "Math is broken") + return + end if + end subroutine test_add +end module TestArithmetic +``` + +- Add the module name to the list of `tests` in `autotest/meson.build`, omitting the leading "Test". -# MODFLOW 5 to 6 conversion test models -pytest -v -n auto test_z02_testmodels_mf5to6.py +```fortran +tests = [ + 'Arithmetic', +] +``` -# models from modflow6-examples repo -pytest -v -n auto test_z03_examples.py +- Add a `use` statement for the test module in `autotest/tester.f90`, and add it to the array of `testsuites`. -# models from modflow6-largetestmodels repo -pytest -v -n auto test_z03_largetestmodels.py +```fortran +use TestArithmetic, only: collect_arithmetic +... +testsuites = [ & + new_testsuite("Arithmetic", collect_arithmetic), & + new_testsuite("something_else", collect_something_else) & +] ``` -Tests load external models from fixtures provided by `modflow-devtools`. External model tests can be selected by model or simulation name, or by packages used. See the [`modflow-devtools` documentation](https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#filtering) for usage examples. Note that filtering options only apply to tests using external models, and will not filter tests defining models in code — for that, the `pytest` built-in `-k` option may be used. +- Rebuild with Meson from the project root, e.g. `meson install -C builddir`. The test should now be picked up when `meson test...` is next invoked. -#### Writing tests +#### Writing integration tests -Tests should ideally follow a few conventions for easier maintenance: +Integration tests should ideally follow a few conventions for easier maintenance: - Use temporary directory fixtures. Tests which write to disk should use `pytest`'s built-in `tmp_path` fixtures or one of the [keepable temporary directory fixtures from `modflow-devtools`](https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#keepable-temporary-directories). This prevents tests from polluting one another's state. @@ -426,3 +519,199 @@ Tests should ideally follow a few conventions for easier maintenance: - `@pytest.mark.regression` if the test compares results from different versions **Note:** If all three external model repositories are not installed as described above, some tests will be skipped. The full test suite includes >750 cases. All must pass before changes can be merged into this repository. + +##### Test framework + +A framework has been developed to streamline common testing patterns. The [`TestFramework`](autotest/framework.py) class, defined in `autotest/framework.py`, is used by most test scripts to configure, run and evaluate one or more MF6 simulations, optionally in comparison with another simulation or model. + +Generally, the recommended pattern for a test script is: + +```python +import ... + +cases = ["a", "b", ...] +variable = [1., 0., ...] +expected = [-1., -1.1, ...] + +def build_models(idx, test): + v = variable[idx] + ... + +def check_output(idx, test): + e = expected[idx] + ... + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + ) + test.run() +``` + +The framework has two hooks: + +- `build`: construct one or more MF6 simulations and/or non-MF6 models with FloPy +- `check`: evaluate simulation/model output + +A test script conventionally contains one or more test cases, fed to the test function as `idx, name` pairs. `idx` can be used to index parameter values or expected results for a specific test case. The test case `name` is useful for model/subdirectory naming, etc. + +The framework will not run an unknown program. The path to any program under test (or used for a comparison) must be registered in the `targets` dictionary. Keys are strings. See `autotest/conftest.py` for the contents of `targets` — naming follows the [executables distribution](https://github.com/MODFLOW-USGS/executables). + +The `.run()` function + +1. builds simulations/models +2. runs simulations/models +3. compares simulation/model outputs +4. checks outputs against expectations + +A `compare` parameter may be provided on initialization, which enables comparison of outputs against another program or the latest official release of MF6. The following values are supported: + +- `None`: disables comparison — the test simply runs/evaluates any registered simulations/models without comparing results +- `auto`: attempt to detect the comparison type from contents of test workspace, otherwise skipping comparison +- `mf6_regression`: compare results against the latest official release rebuilt in develop mode +- `mf6`, `mf2005`, `mfnwt`, or `mflgr`: compare with results from the selected program — a corresponding model must be provided in `build_models()` + +After running the reference and comparison models, the framework will try to find correspondingly named output files to compare — comparison logic may need adjustment when writing tests for new packages or models. + +## Generating makefiles + +Run `build_makefiles.py` in the `distribution/` directory after adding, removing, or renaming source files. This script uses [Pymake](https://github.com/modflowpy/pymake) to regenerate makefiles. For instance: + +```shell +python build_makefiles.py +``` + +### Updating extra and excluded files + +If the utilities located in the `utils` directory (e.g., `mf5to6` and `zbud6`) are affected by changes to the modflow6 `src/` directory (such as new or refactored source files), then the new module source file should also be added to the utility's `utils//pymake/extrafiles.txt` file. This file informs Pymake of source files living outside the main source directory, so they can be included in generated makefiles. + +Module dependencies for features still under development should be added to `excludefiles.txt`. Source files listed in this file will be excluded from makefiles generated by Pymake. Makefiles should only include the source files needed to the build officially released/supported features. + +### Testing makefiles + +Makefile generation and usage can be tested from the `distribution` directory by running the `build_makefiles.py` script with Pytest: + +```shell +pytest -v build_makefiles.py +``` + +**Note**: `make` is required to test compiling MODFLOW 6 with makefiles. If `make` is not discovered on the system path, compile tests will be skipped. + +Makefiles may also be tested manually by changing to the appropriate `make` subdirectory (of the project root for MODFLOW 6, or inside the corresponding `utils` subdirectory for the zonebudget or converter utilities) and invoking `make` (`make clean` may first be necessary to remove previously created object files). + +### Installing `make` on Windows + +On Windows, it is recommended to generate and test makefiles from a Unix-like shell rather than PowerShell or Command Prompt. Make can be installed via [Conda](https://anaconda.org/conda-forge/make) or [Chocolatey](https://community.chocolatey.org/packages/make). Alternatively, it is included with [mingw](https://sourceforge.net/projects/mingw/), which is also available from [Chocolatey](https://community.chocolatey.org/packages/mingw). + +#### Using Conda from Git Bash + +To use Conda from Git Bash on Windows, first run the `conda.sh` script located in your Conda installation's `/etc/profile.d` subdirectory. For instance, with Anaconda3: + +```shell +. /c/Anaconda3/etc/profile.d/conda.sh +``` + +Or Miniconda3: + +```shell +. /c/ProgramData/miniconda3/etc/profile.d/conda.sh +``` + +After this, `conda` commands should be available. + +This command may be added to a `.bashrc` or `.bash_profile` file in your home directory to permanently configure Git Bash for Conda. + +## Branching model + +This section documents MODFLOW 6 branching strategy and other VCS-related procedures. + +### Overview + +This project follows the [git flow](https://nvie.com/posts/a-successful-git-branching-model/): development occurs on the `develop` branch, while `master` is reserved for the state of the latest release. Development PRs are typically squashed to `develop` to avoid merge commits. At release time, release branches are merged to `master`, and then `master` is merged back into `develop`. + +### Managing long-lived branches + +When a feature branch takes a long time to develop, it is easy to become out of sync with the develop branch. Depending on the situation, it may be advisable to periodically squash the commits on the feature branch and rebase the change set with develop. The following approach for updating a long-lived feature branch has proven robust. + +In the example below, the feature branch is assumed to be called `feat-xyz`. + +#### Backup + +Begin by creating a backup copy of the feature branch in case anything goes terribly wrong. + +``` +git checkout feat-xyz +git checkout -b feat-xyz-backup +git checkout feat-xyz +``` + +#### Squash + +Next, consider squashing commits on the feature branch. If there are many commits, it is beneficial to squash them before trying to rebase with develop. There is a nice article on [squashing commits into one using git](https://www.internalpointers.com/post/squash-commits-into-one-git), which has been very useful for consolidating commits on a long-lived modflow6 feature branch. + +A quick and dirty way to squash without interactive rebase (as an alternative to the approach described in the article mentioned in the preceding paragraph) is a soft reset followed by an ammended commit. First making a backup of the feature branch is strongly recommended before using this approach, as accidentally typing `--hard` instead of `--soft` will wipe out all your work. + +``` +git reset --soft +git commit --amend -m "consolidated commit message" +``` + +Once the commits on the feature branch have been consolidated, a force push to origin is recommended. This is not strictly required, but it can serve as an intermediate backup/checkpoint so the squashed branch state can be retrieved if rebasing fails. The following command will push `feat-xyz` to origin. + +``` +git push origin feat-xyz --force +``` + +The `--force` flag's short form is `-f`. + +#### Rebase + +Now that the commits on `feat-xyz` have been consolidated, it is time to rebase with develop. If there are multiple commits in `feat-xyz` that make changes, undo them, rename files, and/or move things around in subsequent commits, then there may be multiple sets of merge conflicts that will need to be resolved as the rebase works its way through the commit change sets. This is why it is beneficial to squash the feature commits before rebasing with develop. + +To rebase with develop, make sure the feature branch is checked out and then type: + +``` +git rebase develop +``` + +If anything goes wrong during a rebase, there is the `rebase --abort` command to unwind it. + +If there are merge conflicts, they will need to be resolved before going forward. Once any conflicts are resolved, it may be worthwhile to rebuild the MODFLOW 6 program and run the smoke tests to ensure nothing is broken. + +At this point, you will want to force push the updated feature branch to origin using the same force push command as before. + +``` +git push origin feat-xyz --force +``` + +#### Cleanup + +Lastly, if you are satisfied with the results and confident the procedure went well, then you can delete the backup that you created at the start. + +``` +git branch -d feat-xyz-backup +``` + +This process can be repeated periodically to stay in sync with the develop branch and keep a clean commit history. + +## Deprecation policy + +To deprecate a MODFLOW 6 input/output option in a DFN file: + +- Add a new `deprecated x.y.z` attribute to the appropriate variable in the package DFN file, where `x.y.z` is the version the deprecation is introduced. Mention the deprecation prominently in the release notes. +- If support for the deprecated option is removed (typically after at least 2 minor or major releases or 1 year), add a new `removed x.y.z` attribute to the variable in the DFN file, where `x.y.z` is the version in which support for the option was removed. The line containing `deprecated x.y.z` should not be deleted. Mention the removal prominently in the release notes. +- Deprecated/removed attributes are not removed from DFN files but remain in perpetuity. The `doc/mf6io/mf6ivar/deprecations.py` script generates a markdown deprecation table which is converted to LaTeX by `doc/ReleaseNotes/mk_deprecations.py` for inclusion in the MODFLOW 6 release notes. Deprecations and removals should still be mentioned separately in the release notes, however. + +### Finding deprecations + +To search for deprecations and removals in DFN files on a system with `git` and standard Unix commands available: + +```shell +git grep 'deprecated' -- '*.dfn' | awk '/^*.dfn:deprecated/' +``` diff --git a/PARALLEL.md b/PARALLEL.md index 8229ae1cbbb..3d1e8f11ebc 100644 --- a/PARALLEL.md +++ b/PARALLEL.md @@ -5,7 +5,7 @@ This document describes how to set up your build environment for developing and --- **DISCLAIMER** -*Expectations on platform compatibility* +*Expectations on platform compatibility* The serial version of the MODFLOW 6 program has had no external dependencies and is traditionally available for a variety of platforms (Windows, GNU/linux, macOS) and compatible with the mainstream Fortran compilers (gfortran, ifort). The parallel version comes with dependencies on third party components, most notably the MPI and PETSc libraries. While the goal is a continued support of the above mentioned configurations, this has become more challenging and can generally not be guaranteed. To assist developers as well as end users who are planning to compile the code themselves, a list of successfully tested build configurations will be included in this document. @@ -19,7 +19,7 @@ The design philosophy has been to maintain MODFLOW as a single codebase and have ## Prerequisites -The parallel version of MODFLOW 6 requires the the Message Passing Interface (MPI) and the Portable, Extensible Toolkit for Scientific Computation (PETSc - pronounced PET-see (/ˈpɛt-siː/)) libraries. +The parallel version of MODFLOW 6 requires the Message Passing Interface (MPI) and the Portable, Extensible Toolkit for Scientific Computation (PETSc - pronounced PET-see (/ˈpɛt-siː/)) libraries. ### MPI @@ -36,7 +36,7 @@ In addition to compiling, the MPI toolset is also required to run a parallel sim ### PETSc -The PETSc library is a suite of data structures and routines for the scalable (parallel) solution of scientific applications modeled by partial differential equations: +The PETSc library is a suite of data structures and routines for the scalable (parallel) solution of scientific applications modeled by partial differential equations: https://petsc.org/release/ @@ -44,38 +44,41 @@ The PETSc library (version 3.16 or higher) is used by MODFLOW for its parallel l ## Compiling MPI and PETSC from source -The PETSc website gives details on a large number of configurations, depending on the target platform/OS, and many different ways to configure/make/install the library: https://petsc.org/release/install/. Building on Windows is notoriously challenging and discouraged by the PETSc development team. On Linux, however, PETSc can be installed (configure/make/install) by executing the following command +The PETSc website gives details on a large number of configurations, depending on the target platform/OS, and many different ways to configure/make/install the library: https://petsc.org/release/install/. Building on Windows is notoriously challenging and discouraged by the PETSc development team. On Linux, however, PETSc can be installed (configure/make/install) by executing the following command + ``` $ ./configure --download-openmpi --download-fblaslapack $ make all ``` -in a terminal open in the root directory of your PETSc download - +in a terminal open in the root directory of your PETSc download ## Using a package manager to install MPI and PETSc Use of a package manager can simplify the process of building the parallel version of MODFLOW 6. ### MacOS + [OpenMPI](https://formulae.brew.sh/formula/open-mpi) and [PETSc](https://formulae.brew.sh/formula/petsc) are available on Homebrew for Intel and Apple Silicon (M1). Both of these depend on [gcc 13.1.0](https://formulae.brew.sh/formula/gcc). [pkg-config](https://formulae.brew.sh/formula/pkg-config) should also be installed from Homebrew, if not already installed, so that Meson will be able to resolve the installation location of MPI and PETSc. ### Ubuntu -OpenMPI and PETSc are available for a variety of Ubuntu versions using the Advanced Packaging Tool (apt). + +OpenMPI and PETSc are available for a variety of Ubuntu versions using the Advanced Packaging Tool (apt). ### Windows -??? +Under evaluation. ## Using pkg-config to check your PETSc installation -Eventually, the MODFLOW build process has to resolve the installation location of all external dependencies. The pkg-config tool (https://en.wikipedia.org/wiki/Pkg-config) can be used to take care of that. +Eventually, the MODFLOW build process has to resolve the installation location of all external dependencies. The pkg-config tool (https://en.wikipedia.org/wiki/Pkg-config) can be used to take care of that. ``` pkg-config --libs petsc ``` If PETSc was build from source, you can check the contents of the folder + ``` $PETSC_DIR/$PETSC_ARCH/lib/pkgconfig/ ``` @@ -84,7 +87,6 @@ and confirm that there are one or more `*.pc` files in there. A similar `pkgconf To connect everything, both of these folder paths have to be added to the `PKG_CONFIG_PATH` variable so that the `pkg-config` executable can resolve the installed libraries. - ## Building the parallel version of MODFLOW 6 The primary build system for MODFLOW is Meson (https://mesonbuild.com/). The `meson.build` script takes an additional argument to activate a parallel build of the software. E.g for building and installing a parallel release version: @@ -95,11 +97,12 @@ meson setup builddir -Ddebug=false -Dparallel=true \ meson install -C builddir meson test --verbose --no-rebuild -C builddir ``` + Note that changing the option flags in the `meson setup` command requires the flag `--reconfigure` to reconfigure the build directory. If the `PKG_CONFIG_PATH` was set as described above, the linking to PETSc and MPI is done automatically. -It's always a good idea to check your `mf6pro` executable to confirm that it is successfully linked against the external dependencies. You can use the command line tools `ldd` (Linux), `otool` (macOS), or `Dependencies.exe` (Windows, https://github.com/lucasg/Dependencies) to do that. In the list of dependencies, you should be able to identify `libpetsc` and `libmpi` for parallel builds. +It's always a good idea to check your parallel MODFLOW executable to confirm that it is successfully linked against the external dependencies. You can use the command line tools `ldd` (Linux), `otool` (macOS), or `Dependencies.exe` (Windows, https://github.com/lucasg/Dependencies) to do that. In the list of dependencies, you should be able to identify `libpetsc` and `libmpi` for parallel builds. -The other build systems in the MODFLOW project (MS Visual Studio, `pymake`, `Makefile`) continue to be supported for *serial* builds only. `pymake` uses the `excludefiles.txt` to ignore those files that can only be build when MPI and PETSc are present on the system. In MS Visual Studio these same files are included in the solution but not in the build process. +The other build systems in the MODFLOW project (MS Visual Studio, `pymake`, `Makefile`) continue to be supported for *serial* builds only. `pymake` uses the `excludefiles.txt` to ignore those files that can only be build when MPI and PETSc are present on the system. In MS Visual Studio these same files are included in the solution but not in the build process. --- @@ -111,8 +114,7 @@ Parallel MODFLOW was designed to have all third party functionality (MPI and PET --- - -## Testing the parallel of MODFLOW 6 +## Testing the parallel of MODFLOW 6 Parallel MODFLOW can be tested using the same test framework as the serial program, with just a few modifications. To run a test inside the `autotest` folder in parallel mode, make sure to add a marker `@pytest.mark.parallel` so that the test is only executed in the Continuous Integration when running a configuration with a parallel build of MODFLOW. @@ -121,6 +123,7 @@ The `TestSimulation` object that is being run from the framework should be confi ``` $ pytest -s --parallel test_par_gwf01.py ``` + Running without the `--parallel` flag will simply skip the test. ## Debugging @@ -130,11 +133,13 @@ The most straightforward way to debug a parallel simulation is to start a run an ``` -wait_dbg ``` + telling MODFLOW to pause immediately after startup. This will give you time to attach one or multiple debuggers to the processes. Then start the parallel program, for example on two cores: ``` mpiexec -np 2 mf6 -p ``` + In the process explorer you should now see 2 processes called `mf6` or `mf6.exe`. On the prompt where the command was executed, MODFLOW waits for input: ``` @@ -165,7 +170,8 @@ In VSCode parallel debugging is easiest done by duplicating the development envi ] } ``` -After building parallel MODFLOW, press `Ctrl+Shift+p` to execute *Workspaces: Duplicate As Workspace in New Window*. This will open a second VSCode window, identical to the first. Starting the debug process and selecting *"Attach to ..."* pop ups a process selection window with the processes started from the `mpiexec` command described above. Select both, each from their own instance of the VSCode program. Now you can put breakpoints in the code, "Hit enter to continue" on the command prompt, and step through the parallel processes side-by-side. + +After building parallel MODFLOW, press `Ctrl+Shift+p` to execute *Workspaces: Duplicate As Workspace in New Window*. This will open a second VSCode window, identical to the first. Starting the debug process and selecting *"Attach to ..."* opens a process selection window with the processes started from the `mpiexec` command described above. Select both, each from their own instance of the VSCode program. Now you can put breakpoints in the code, "Hit enter to continue" on the command prompt, and step through the parallel processes side-by-side. --- **TIP** @@ -174,19 +180,23 @@ Make sure that you work with gdb versions >= 10. We have found that earlier vers --- - ## Compatibility Parallel MODFLOW has been built successfully with the following configurations: -| Operating System | Toolchain | MPI | PETSc | Package Manager | -|-----------------------|-------------|---------------|--------|-----------------| -| MS Windows | ? | ? | ? | NA | -| WSL2 (Ubuntu 20.04.5) | gcc 9.4.0 | OpenMPI 4.0.3 | 3.18.2 | NA | -| Ubuntu 22.04 | gcc 9.5.0 | OpenMPI 4.1.4 | 3.18.5 | NA | -| Ubuntu 23.04 | gcc 13 | OpenMPI 4.1.4 | 3.18.1 | apt | -| macOS 12.6.3 | gcc 9.5.0 | OpenMPI 4.1.4 | 3.18.5 | NA | -| macOS 12.6.6 | gcc 13.1.0 | OpenMPI 4.1.5 | 3.19.1 | Homebrew | +| Operating System | Toolchain | MPI | PETSc | Package Manager | +|-------------------------------------|---------------------------|-------------------|---------------------|-----------------| +| MS Windows | ? | ? | ? | NA | +| WSL2 (Ubuntu 20.04.5) | gcc 9.4.0 | OpenMPI 4.0.3 | 3.18.2 | NA | +| macOS 12.6.3 | gcc 9.5.0 | OpenMPI 4.1.4 | 3.18.5 | NA | +| macOS 12.6.6 | gcc 13.1.0 | OpenMPI 4.1.5 | 3.19.1 | Homebrew | +| Ubuntu 22.04 | gcc 9.5.0 | OpenMPI 4.1.4 | 3.18.5 | NA | +| Ubuntu 22.04 ARM64 | gcc 11.4.0 | OpenMPI 4.1.5 | 3.19.3 | apt | +| Ubuntu 22.04 ARM64 | gcc 9.5.0 | MPICH 3.4.1 | 3.15.5 | NA | +| Ubuntu 22.04 ARM64 | gcc 12.3.0 | MPICH 4.1.1 | 3.19.6 | NA | +| Ubuntu 22.04 ARM64 | gcc 12.3.0 | MPICH 4.1.1 | 3.20.0 | NA | +| SUSE Linux Enterprise Server 15 SP2 | intel 19.1.0.166 20191121 | CRAY-MPICH 7.7.19 | CRAY-PETSC 3.14.5.0 | NA | +| Red Hat Enterprise Linux 8.7 | intel 2021.10.0 20230609 | CRAY-MPICH 8.1.26 | 3.15.5 | NA | The most up-to-date configurations are available in the GitHub CI script: `.github/workflows/ci.yml` under the task `parallel_test`. These are being tested upon every change to the `develop` branch of MODFLOW. @@ -194,4 +204,46 @@ To improve support, we kindly ask you to share your experience with building and ## Known issues -tbd \ No newline at end of file +### Building PETSc on Ubuntu 22.04 with MPICH and GNU compilers + +Versions of PETSc that use MPICH 3.4 (v3.14, v3.15, v3.16)) must be built with gcc-9 or earlier. Versions of PETSc that use MPICH 4.1 (v3.17 or newer) can be built with newer versions of the gcc compiler (gcc-11, gcc-12, etc.). + +Meson does not correctly load the Fortran compiler flags from the `mpich.pc` package configuration file in the `$PETSC_DIR/$PETSC_ARCH/lib/pkgconfig` directory. To overcome this issue, make a copy of `mpich.pc` and name it `mpichfort.pc`. Then determine the appropriate Fortran flags using + +``` +$PETSC_DIR/$PETSC_ARCH/bin/mpifort -show +``` + +which will return something like + +``` +$ linux-real-gcc12.3.0-3.20.0/bin/mpifort -show +gfortran -fPIC -ffree-line-length-none -ffree-line-length-0 -Wno-lto-type-mismatch -O2 -fallow-argument-mismatch -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -L/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -lmpifort -Wl,-rpath -Wl,/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -Wl,--enable-new-dtags -lmpi +``` + +Copy the returned Fortran flags and replace the `Libs:` and `Cflags:` attributes in the `mpichfort.pc` file. Also modify the `Name:` attribute to `mpichfort`. The modified `mpichfort.pc` file should look something like + +``` +# this gives access to the mpich header files +prefix=/media/psf/Development/petsc/linux-real-gcc9.5.0-3.20.0 +exec_prefix=${prefix} +libdir=/media/psf/Development/petsc/linux-real-gcc9.5.0-3.20.0/lib +includedir=${prefix}/include + +Name: mpichfort +Description: High Performance and portable MPI +Version: 4.1.2 +URL: http://www.mcs.anl.gov/research/projects/mpich +Requires: +Libs: -fPIC -ffree-line-length-none -ffree-line-length-0 -Wno-lto-type-mismatch -O2 -fallow-argument-mismatch -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -L/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -lmpifort -Wl,-rpath -Wl,/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -Wl,--enable-new-dtags -lmpi +Cflags: -fPIC -ffree-line-length-none -ffree-line-length-0 -Wno-lto-type-mismatch -O2 -fallow-argument-mismatch -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -I/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include -L/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -lmpifort -Wl,-rpath -Wl,/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib -Wl,--enable-new-dtags -lmpi + +# pkg-config does not understand Cxxflags, etc. So we allow users to +# query them using the --variable option + +cxxflags= -Wno-lto-type-mismatch -Wno-psabi -O2 -std=gnu++17 -fPIC -I${includedir} +fflags=-fPIC -ffree-line-length-none -ffree-line-length-0 -Wno-lto-type-mismatch -O2 -I${includedir} +fcflags=-fPIC -ffree-line-length-none -ffree-line-length-0 -Wno-lto-type-mismatch -O2 -I${includedir} +``` + +The `/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/include` and `/media/psf/Development/petsc/linux-real-gcc12.3.0-3.20.0/lib` entries in the `Libs:` and `Cflags:` attributes can be replaced with `${includedir}` and `${libdir}`, respectively, to simplify `mpichfort.pc`. \ No newline at end of file diff --git a/README.md b/README.md index 306731b232e..5e561c379b6 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ This is the development repository for the USGS MODFLOW 6 Hydrologic Model. The official USGS distribution is available at [USGS Release Page](https://water.usgs.gov/ogw/modflow/MODFLOW.html). -### Version 6.4.2 +### Version 6.4.3 [![GitHub release](https://img.shields.io/github/release/MODFLOW-USGS/modflow6.svg)](https://github.com/MODFLOW-USGS/modflow6/releases/latest) [![MODFLOW 6 continuous integration](https://github.com/MODFLOW-USGS/modflow6/actions/workflows/ci.yml/badge.svg)](https://github.com/MODFLOW-USGS/modflow6/actions/workflows/ci.yml) @@ -94,6 +94,8 @@ The GWT model for MODFLOW 6 simulates three-dimensional transport of a single so [Hughes, J.D., Leake, S.A., Galloway, D.L., and White, J.T., 2022, Documentation for the Skeletal Storage, Compaction, and Subsidence (CSUB) Package of MODFLOW 6: U.S. Geological Survey Techniques and Methods, book 6, chap. A62, 57 p., https://doi.org/10.3133/tm6A62](https://doi.org/10.3133/tm6A62) +[Langevin, C.D., Hughes, J.D., Provost, A.M., Russcher, M.J. and Panday, S., 2023, MODFLOW as a Configurable Multi-Model Hydrologic Simulator: Groundwater, https://doi.org/10.1111/gwat.13351](https://doi.org/10.1111/gwat.13351) + #### ***Software/Code*** The following is the general citation for the MODFLOW 6 software. diff --git a/autotest/TestArrayHandlers.f90 b/autotest/TestArrayHandlers.f90 new file mode 100644 index 00000000000..321beb7b16c --- /dev/null +++ b/autotest/TestArrayHandlers.f90 @@ -0,0 +1,353 @@ +module TestArrayHandlers + use KindModule, only: I4B, DP, LGP + use testdrive, only: error_type, unittest_type, new_unittest, check, & + test_failed, to_string + use ArrayHandlersModule, only: ExpandArray, ExpandArray2D, ExtendPtrArray, & + remove_character + use ConstantsModule, only: LINELENGTH + implicit none + private + public :: collect_arrayhandlers + +contains + + subroutine collect_arrayhandlers(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("ExpandArray_int", & + test_ExpandArray_int), & + new_unittest("ExpandArray_dbl", & + test_ExpandArray_dbl), & + new_unittest("ExpandArray_lgp", & + test_ExpandArray_lgp), & + new_unittest("ExpandArray2D_int", & + test_ExpandArray2D_int), & + new_unittest("ExpandArray2D_dbl", & + test_ExpandArray2D_dbl), & + ! new_unittest("ExtendPtrArray_int", & + ! test_ExtendPtrArray_int), & + ! new_unittest("ExtendPtrArray_dbl", & + ! test_ExtendPtrArray_dbl), & + new_unittest("remove_character", & + test_remove_character) & + ] + end subroutine collect_arrayhandlers + + !> @brief Test 1D int array expansion + subroutine test_ExpandArray_int(error) + type(error_type), allocatable, intent(out) :: error + integer(I4B), allocatable :: a(:) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test default lower bound (1) as well as 0 and -1 + ! allocate/populate array + allocate (a(lb:(lb + n1 - 1))) + a(lb) = lb + a(lb + 1) = lb + 1 + + ! resize array and check new size and bounds + call ExpandArray(a, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected lower bound: "//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected upper bound: "//to_string(ubound(a, 1))) + if (allocated(error)) return + + ! set new array elements and check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i) = i + end do + do i = lb, lb + n2 - 1 + call check(error, a(i) == i, & + "unexpected value "//to_string(a(i)) & + //" at i="//to_string(i)) + if (allocated(error)) return + end do + deallocate (a) + end do + end subroutine test_ExpandArray_int + + !> @brief Test 1D dbl array expansion + subroutine test_ExpandArray_dbl(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: a(:) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array + allocate (a(lb:(lb + n1 - 1))) + a(lb) = real(lb) + a(lb + 1) = real(lb + 1) + + ! resize array and check new size and bounds + call ExpandArray(a, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected lower bound: "//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected upper bound: "//to_string(ubound(a, 1))) + if (allocated(error)) return + + ! set new array elements and check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i) = real(i) + end do + do i = lb, lb + n2 - 1 + call check(error, a(i) == real(i), & + "unexpected value "//to_string(a(i)) & + //" at i="//to_string(i)) + if (allocated(error)) return + end do + deallocate (a) + end do + end subroutine test_ExpandArray_dbl + + !> @brief Test 1D logical array expansion + subroutine test_ExpandArray_lgp(error) + type(error_type), allocatable, intent(out) :: error + logical(LGP), allocatable :: a(:) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array (alternate T/F starting with false) + allocate (a(lb:(lb + n1 - 1))) + a(lb) = mod(lb, 2) == 0 + a(lb + 1) = mod(lb + 1, 2) == 0 + + ! resize array and check new size and bounds + call ExpandArray(a, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected lower bound: "//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected upper bound: "//to_string(ubound(a, 1))) + if (allocated(error)) return + + ! set new array elements and check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i) = mod(i, 2) == 0 + end do + do i = lb, lb + n2 - 1 + call check(error, a(i) .eqv. (mod(i, 2) == 0), & + "unexpected value "// & + merge('t', 'f', a(i)) & + //" at i="//to_string(i)) + if (allocated(error)) return + end do + deallocate (a) + end do + end subroutine test_ExpandArray_lgp + + !> @brief Test 2D int array expansion + subroutine test_ExpandArray2D_int(error) + type(error_type), allocatable, intent(out) :: error + integer(I4B), allocatable :: a(:, :) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array and check initial size, with + ! same lower bound and starting/new size for both dims + allocate (a(lb:(lb + n1 - 1), lb:(lb + n1 - 1))) + a(lb, :) = lb + a(lb + 1, :) = lb + 1 + call check(error, size(a, 1) == n1 .and. size(a, 2) == n1) + if (allocated(error)) return + + ! resize array and check new size and bounds + call ExpandArray2D(a, n2 - n1, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected dim1 size: "//to_string(size(a, 1))) + call check(error, size(a, 1) == n2, & + "unexpected dim2 size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected dim1 lower bound:"//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected dim1 upper bound:"//to_string(ubound(a, 1))) + call check(error, lbound(a, 2) == lb, & + "unexpected dim2 lower bound:"//to_string(lbound(a, 2))) + call check(error, ubound(a, 2) == lb + n2 - 1, & + "unexpected dim2 upper bound:"//to_string(ubound(a, 2))) + if (allocated(error)) return + + ! set new elements starting from the new region, check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i, :) = i + end do + do i = lb, lb + n2 - 1 + if (i < (lb + n1 - 1)) then + ! old contents, expect uninitialized values in new slots + call check(error, all(a(i, lb:(lb + n1 - 1)) == i), & + "unexpected value "//to_string(a(i, i)) & + //" at i="//to_string(i)) + else + ! new contents, expect all values as set in prior loop + call check(error, all(a(i, :) == i), & + "unexpected value "//to_string(a(i, i)) & + //" at i="//to_string(i)) + end if + if (allocated(error)) return + end do + deallocate (a) + end do + end subroutine test_ExpandArray2D_int + + !> @brief Test 2D dbl array expansion + subroutine test_ExpandArray2D_dbl(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: a(:, :) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array and check initial size, with + ! same lower bound and starting/new size for both dims + allocate (a(lb:(lb + n1 - 1), lb:(lb + n1 - 1))) + a(lb, :) = real(lb) + a(lb + 1, :) = real(lb + 1) + call check(error, size(a, 1) == n1 .and. size(a, 2) == n1) + if (allocated(error)) return + + ! resize array and check new size and bounds + call ExpandArray2D(a, n2 - n1, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected dim1 size: "//to_string(size(a, 1))) + call check(error, size(a, 1) == n2, & + "unexpected dim2 size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected dim1 lower bound:"//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected dim1 upper bound:"//to_string(ubound(a, 1))) + call check(error, lbound(a, 2) == lb, & + "unexpected dim2 lower bound:"//to_string(lbound(a, 2))) + call check(error, ubound(a, 2) == lb + n2 - 1, & + "unexpected dim2 upper bound:"//to_string(ubound(a, 2))) + if (allocated(error)) return + + ! set new elements starting from the new region, check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i, :) = real(i) + end do + do i = lb, lb + n2 - 1 + if (i < (lb + n1 - 1)) then + ! old contents, expect uninitialized values in new slots + call check(error, all(a(i, lb:(lb + n1 - 1)) == real(i)), & + "unexpected value "//to_string(a(i, i)) & + //" at i="//to_string(i)) + else + ! new contents, expect all values as set in prior loop + call check(error, all(a(i, :) == real(i)), & + "unexpected value "//to_string(a(i, i)) & + //" at i="//to_string(i)) + end if + if (allocated(error)) return + end do + deallocate (a) + end do + end subroutine test_ExpandArray2D_dbl + + !> @brief Test 1D int ptr array expansion + subroutine test_ExtendPtrArray_int(error) + type(error_type), allocatable, intent(out) :: error + integer(I4B), allocatable, target :: aa(:) + integer(I4B), pointer, contiguous :: a(:) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array and set pointer + allocate (aa(lb:(lb + n1 - 1))) + aa(lb) = lb + aa(lb + 1) = lb + 1 + a => aa + + ! resize array and check new size and bounds + call ExtendPtrArray(a, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected lower bound: "//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected upper bound: "//to_string(ubound(a, 1))) + if (allocated(error)) return + + ! set new array elements and check new/old contents + do i = lb + n1 - 1, lb + n2 - 1 + a(i) = i + end do + do i = lb, lb + n2 - 1 + call check(error, a(i) == i, & + "unexpected value "//to_string(a(i)) & + //" at i="//to_string(i)) + if (allocated(error)) return + end do + nullify (a) + deallocate (aa) + end do + end subroutine test_ExtendPtrArray_int + + !> @brief Test 1D dbl ptr array expansion + subroutine test_ExtendPtrArray_dbl(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable, target :: aa(:) + real(DP), pointer, contiguous :: a(:) + integer(I4B) :: i, lb, n1, n2 + + n1 = 2 ! starting size + n2 = 5 ! expanded size + do lb = -1, 1 ! test with default lower bound (1) as well as 0 and -1 + ! allocate/populate array and set pointer + allocate (aa(lb:(lb + n1 - 1))) + aa(lb) = real(lb) + aa(lb + 1) = real(lb + 1) + a => aa + + ! resize array and check new size and bounds + call ExtendPtrArray(a, n2 - n1) + call check(error, size(a, 1) == n2, & + "unexpected size: "//to_string(size(a, 1))) + call check(error, lbound(a, 1) == lb, & + "unexpected lower bound: "//to_string(lbound(a, 1))) + call check(error, ubound(a, 1) == lb + n2 - 1, & + "unexpected upper bound: "//to_string(ubound(a, 1))) + if (allocated(error)) return + + ! set new array elements and check new/old contents + do i = lb + n1 - 1, n2 + a(i) = real(i) + end do + do i = lb, lb + n2 - 1 + call check(error, a(i) == real(i), & + "unexpected value "//to_string(a(i)) & + //" at i="//to_string(i)) + if (allocated(error)) return + end do + nullify (a) + deallocate (aa) + end do + end subroutine test_ExtendPtrArray_dbl + + subroutine test_remove_character(error) + type(error_type), allocatable, intent(out) :: error + character(len=11), allocatable :: s(:) + allocate (s(2)) + s(1) = "hello world" + s(2) = "hello earth" + call remove_character(s, 1) + call check(error, s(1) == "hello earth") + end subroutine test_remove_character + +end module TestArrayHandlers diff --git a/autotest/TestDevFeature.f90 b/autotest/TestDevFeature.f90 new file mode 100644 index 00000000000..243c2e9e233 --- /dev/null +++ b/autotest/TestDevFeature.f90 @@ -0,0 +1,28 @@ +module TestDevFeature + use testdrive, only: error_type, unittest_type, new_unittest, check + use DevFeatureModule, only: dev_feature + use ConstantsModule, only: LINELENGTH + use VersionModule, only: IDEVELOPMODE + + implicit none + private + public :: collect_dev_feature + +contains + + subroutine collect_dev_feature(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + ! expect failure if in release mode, otherwise pass + new_unittest("dev_feature", test_dev_feature, & + should_fail=(IDEVELOPMODE == 0)) & + ] + end subroutine collect_dev_feature + + subroutine test_dev_feature(error) + type(error_type), allocatable, intent(out) :: error + character(len=LINELENGTH) :: errmsg + call dev_feature(errmsg) + end subroutine test_dev_feature + +end module TestDevFeature diff --git a/autotest/TestGeomUtil.f90 b/autotest/TestGeomUtil.f90 new file mode 100644 index 00000000000..3447f8eb6e9 --- /dev/null +++ b/autotest/TestGeomUtil.f90 @@ -0,0 +1,323 @@ +module TestGeomUtil + use KindModule, only: I4B, DP + use testdrive, only: check, error_type, new_unittest, test_failed, & + to_string, unittest_type + use GeomUtilModule, only: get_node, get_ijk, get_jk, point_in_polygon, & + skew + use ConstantsModule, only: LINELENGTH + implicit none + private + public :: collect_geomutil + +contains + + subroutine collect_geomutil(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("get_node_get_ijk", & + test_get_node_get_ijk), & + new_unittest("point_in_polygon_sq", & + test_point_in_polygon_sq), & + new_unittest("point_in_polygon_tri", & + test_point_in_polygon_tri), & + new_unittest("point_in_polygon_irr", & + test_point_in_polygon_irr), & + new_unittest("skew", test_skew) & + ] + end subroutine collect_geomutil + + ! 2D arrays for polygons and check points use column-major indexing + + subroutine test_get_node_get_ijk(error) + type(error_type), allocatable, intent(out) :: error + integer :: ilay + integer :: irow + integer :: icol + integer :: nlay + integer :: nrow + integer :: ncol + integer :: nnum + integer :: ncls + integer :: k, i, j + + ! trivial grid with 1 cell + nnum = get_node(1, 1, 1, 1, 1, 1) + call get_ijk(nnum, 1, 1, 1, ilay, irow, icol) + call check(error, nnum == 1) + call check(error, ilay == 1) + call check(error, irow == 1) + call check(error, icol == 1) + if (allocated(error)) return + + ! small grid, 3x4x5 + nlay = 3 + nrow = 4 + ncol = 5 + ncls = nlay * nrow * ncol + do k = 1, nlay + do i = 1, nrow + do j = 1, ncol + ! node number from ijk + nnum = get_node(k, i, j, nlay, nrow, ncol) + call check(error, nnum == (k - 1) * nrow * ncol + (i - 1) * ncol + j) + if (allocated(error)) return + + ! ijk from node number + call get_ijk(nnum, nrow, ncol, nlay, irow, icol, ilay) + call check(error, ilay == k) + call check(error, irow == i) + call check(error, icol == j) + if (allocated(error)) return + end do + end do + end do + end subroutine test_get_node_get_ijk + + subroutine test_point_in_polygon(error, shape, & + poly, in_pts, out_pts, vert_pts, face_pts) + type(error_type), allocatable, intent(inout) :: error + character(len=*), intent(in) :: shape + real(DP), allocatable, intent(in) :: poly(:, :) + real(DP), allocatable, intent(in) :: in_pts(:, :) + real(DP), allocatable, intent(in) :: out_pts(:, :) + real(DP), allocatable, intent(in) :: vert_pts(:, :) + real(DP), allocatable, intent(in) :: face_pts(:, :) + integer(I4B) :: i + real(DP) :: x, y + + ! test inside points + do i = 1, size(in_pts, 2) + x = in_pts(1, i) + y = in_pts(2, i) + call check(error, point_in_polygon(x, y, poly), & + "point inside "//shape//" failed: " & + //to_string(x)//", "//to_string(y)) + if (allocated(error)) return + end do + + ! test outside points + do i = 1, size(out_pts, 2) + x = out_pts(1, i) + y = out_pts(2, i) + call check(error, (.not. point_in_polygon(x, y, poly)), & + "point outside "//shape//" failed: " & + //to_string(x)//", "//to_string(y)) + if (allocated(error)) return + end do + + ! test vertex points + do i = 1, size(vert_pts, 2) + x = vert_pts(1, i) + y = vert_pts(2, i) + call check(error, point_in_polygon(x, y, poly), & + "point on "//shape//" vertex failed: " & + //to_string(x)//", "//to_string(y)) + if (allocated(error)) return + end do + + ! test face points + do i = 1, size(face_pts, 2) + x = face_pts(1, i) + y = face_pts(2, i) + call check(error, point_in_polygon(x, y, poly), & + "point on "//shape//" face failed: " & + //to_string(x)//", "//to_string(y)) + if (allocated(error)) return + end do + end subroutine test_point_in_polygon + + !> @brief Test a unit square + subroutine test_point_in_polygon_sq(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: poly(:, :) + real(DP), allocatable :: in_pts(:, :) + real(DP), allocatable :: out_pts(:, :) + real(DP), allocatable :: vert_pts(:, :) + real(DP), allocatable :: face_pts(:, :) + + allocate (poly(2, 4)) + + allocate (in_pts(2, 3)) + in_pts(:, 1) = (/0.99_DP, 0.01_DP/) + in_pts(:, 2) = (/0.5_DP, 0.5_DP/) + in_pts(:, 3) = (/0.0001_DP, 0.9999_DP/) + + allocate (out_pts(2, 2)) + out_pts(:, 1) = (/0.5_DP, 1.00001_DP/) + out_pts(:, 2) = (/-0.5_DP, 34.0_DP/) + + allocate (vert_pts(2, 4)) + vert_pts(:, 1) = (/0.0_DP, 0.0_DP/) + vert_pts(:, 2) = (/1.0_DP, 0.0_DP/) + vert_pts(:, 3) = (/0.0_DP, 1.0_DP/) + vert_pts(:, 4) = (/1.0_DP, 1.0_DP/) + + allocate (face_pts(2, 4)) + face_pts(:, 1) = (/0.0_DP, 0.5_DP/) + face_pts(:, 2) = (/0.5_DP, 0.0_DP/) + face_pts(:, 3) = (/1.0_DP, 0.5_DP/) + face_pts(:, 4) = (/0.5_DP, 1.0_DP/) + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/0.0_DP, 1.0_DP/) + poly(:, 3) = (/1.0_DP, 1.0_DP/) + poly(:, 4) = (/1.0_DP, 0.0_DP/) + call test_point_in_polygon(error, "clockwise square", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/1.0_DP, 0.0_DP/) + poly(:, 3) = (/1.0_DP, 1.0_DP/) + poly(:, 4) = (/0.0_DP, 1.0_DP/) + call test_point_in_polygon(error, "counter-clockwise square", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + deallocate (poly) + deallocate (in_pts) + deallocate (out_pts) + deallocate (vert_pts) + deallocate (face_pts) + end subroutine test_point_in_polygon_sq + + !> @brief Test a right triangle + subroutine test_point_in_polygon_tri(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: poly(:, :) + real(DP), allocatable :: in_pts(:, :) + real(DP), allocatable :: out_pts(:, :) + real(DP), allocatable :: vert_pts(:, :) + real(DP), allocatable :: face_pts(:, :) + + allocate (poly(2, 3)) + + allocate (in_pts(2, 3)) + in_pts(:, 1) = (/0.8_DP, 0.0001_DP/) + in_pts(:, 2) = (/0.5_DP, 0.49999_DP/) + in_pts(:, 3) = (/0.0001_DP, 0.8_DP/) + + allocate (out_pts(2, 2)) + out_pts(:, 1) = (/0.5_DP, 0.50001_DP/) + out_pts(:, 2) = (/-0.5_DP, 34.0_DP/) + + allocate (vert_pts(2, 3)) + vert_pts(:, 1) = (/0.0_DP, 0.0_DP/) + vert_pts(:, 2) = (/1.0_DP, 0.0_DP/) + vert_pts(:, 3) = (/0.0_DP, 1.0_DP/) + + allocate (face_pts(2, 3)) + face_pts(:, 1) = (/0.0_DP, 0.5_DP/) + face_pts(:, 2) = (/0.5_DP, 0.0_DP/) + face_pts(:, 3) = (/0.5_DP, 0.5_DP/) + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/0.0_DP, 1.0_DP/) + poly(:, 3) = (/1.0_DP, 0.0_DP/) + call test_point_in_polygon(error, "clockwise triangle", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/1.0_DP, 0.0_DP/) + poly(:, 3) = (/0.0_DP, 1.0_DP/) + call test_point_in_polygon(error, "counter-clockwise triangle", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + deallocate (poly) + deallocate (in_pts) + deallocate (out_pts) + deallocate (vert_pts) + deallocate (face_pts) + end subroutine test_point_in_polygon_tri + + !> @brief Test an irregular polygon + subroutine test_point_in_polygon_irr(error) + type(error_type), allocatable, intent(out) :: error + real(DP), allocatable :: poly(:, :) + real(DP), allocatable :: in_pts(:, :) + real(DP), allocatable :: out_pts(:, :) + real(DP), allocatable :: vert_pts(:, :) + real(DP), allocatable :: face_pts(:, :) + + allocate (poly(2, 5)) + + allocate (in_pts(2, 3)) + in_pts(:, 1) = (/0.5_DP, 0.1_DP/) + in_pts(:, 2) = (/0.5_DP, 0.49_DP/) + in_pts(:, 3) = (/1.999_DP, 1.999_DP/) + + allocate (out_pts(2, 3)) + out_pts(:, 1) = (/0.5_DP, -0.1_DP/) + out_pts(:, 2) = (/0.5_DP, 0.51_DP/) + out_pts(:, 3) = (/-0.5_DP, 34.0_DP/) + + allocate (vert_pts(2, 5)) + vert_pts(:, 1) = (/0.0_DP, 0.0_DP/) + vert_pts(:, 2) = (/1.0_DP, 1.0_DP/) + vert_pts(:, 3) = (/1.0_DP, 2.0_DP/) + vert_pts(:, 4) = (/2.0_DP, 2.0_DP/) + vert_pts(:, 5) = (/2.0_DP, 0.0_DP/) + + allocate (face_pts(2, 3)) + face_pts(:, 1) = (/0.5_DP, 0.5_DP/) + face_pts(:, 2) = (/2.0_DP, 1.0_DP/) + face_pts(:, 3) = (/1.5_DP, 2.0_DP/) + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/1.0_DP, 1.0_DP/) + poly(:, 3) = (/1.0_DP, 2.0_DP/) + poly(:, 4) = (/2.0_DP, 2.0_DP/) + poly(:, 5) = (/2.0_DP, 0.0_DP/) + call test_point_in_polygon(error, & + "clockwise irregular polygon", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + poly(:, 1) = (/0.0_DP, 0.0_DP/) + poly(:, 2) = (/2.0_DP, 0.0_DP/) + poly(:, 3) = (/2.0_DP, 2.0_DP/) + poly(:, 4) = (/1.0_DP, 2.0_DP/) + poly(:, 5) = (/1.0_DP, 1.0_DP/) + call test_point_in_polygon(error, & + "counter-clockwise irregular polygon", & + poly, in_pts, out_pts, vert_pts, face_pts) + if (allocated(error)) return + + deallocate (poly) + deallocate (in_pts) + deallocate (out_pts) + deallocate (vert_pts) + deallocate (face_pts) + end subroutine test_point_in_polygon_irr + + subroutine test_skew(error) + type(error_type), allocatable, intent(out) :: error + real(DP) :: v(2) + + ! shear to right + v = (/1.0_DP, 1.0_DP/) + v = skew(v, (/1.0_DP, 1.0_DP, 1.0_DP/)) + call check(error, v(1) == 2.0_DP .and. v(2) == 1.0_DP) + v = (/2.0_DP, 2.0_DP/) + v = skew(v, (/1.0_DP, 0.5_DP, 1.0_DP/)) + call check(error, v(1) == 3.0_DP .and. v(2) == 2.0_DP) + + ! collapse x dim + v = (/2.0_DP, 2.0_DP/) + v = skew(v, (/0.0_DP, 0.5_DP, 1.0_DP/)) + call check(error, v(1) == 1.0_DP .and. v(2) == 2.0_DP, to_string(v(1))) + + ! mirror over x axis + v = (/2.0_DP, 2.0_DP/) + v = skew(v, (/-1.0_DP, 0.0_DP, 1.0_DP/)) + call check(error, v(1) == -2.0_DP .and. v(2) == 2.0_DP, to_string(v(1))) + + ! mirror over x and y axis + v = (/2.0_DP, 2.0_DP/) + v = skew(v, (/-1.0_DP, 0.0_DP, -1.0_DP/)) + call check(error, v(1) == -2.0_DP .and. v(2) == -2.0_DP, to_string(v(1))) + end subroutine test_skew + +end module TestGeomUtil diff --git a/autotest/TestHashTable.f90 b/autotest/TestHashTable.f90 new file mode 100644 index 00000000000..5e20d853a9b --- /dev/null +++ b/autotest/TestHashTable.f90 @@ -0,0 +1,41 @@ +module TestHashTable + use KindModule, only: I4B, DP + use ConstantsModule, only: DNODATA, DZERO + use testdrive, only: check, error_type, new_unittest, test_failed, & + to_string, unittest_type + use HashTableModule, only: HashTableType, hash_table_cr, hash_table_da + implicit none + private + public :: collect_hashtable + +contains + + subroutine collect_hashtable(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("add_and_get_value", & + test_add_and_get_value) & + ] + end subroutine collect_hashtable + + subroutine test_add_and_get_value(error) + type(error_type), allocatable, intent(out) :: error + type(HashTableType), pointer :: map + integer(I4B) :: i, n + + allocate (map) + call hash_table_cr(map) + + n = 3 + do i = 1, n + call map%add(to_string(i), i) + end do + + do i = 1, n + call check(error, map%get(to_string(i)) == i, & + 'wrong value for '//to_string(i)) + end do + + end subroutine test_add_and_get_value + +end module TestHashTable diff --git a/autotest/TestInputOutput.f90 b/autotest/TestInputOutput.f90 new file mode 100644 index 00000000000..49ca3483321 --- /dev/null +++ b/autotest/TestInputOutput.f90 @@ -0,0 +1,16 @@ +module TestInputOutput + use testdrive, only: error_type, unittest_type, new_unittest, check + use ConstantsModule, only: LINELENGTH + ! use InputOutputModule, only: ??? + implicit none + private + public :: collect_inputoutput + +contains + + subroutine collect_inputoutput(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + allocate (testsuite(0)) + end subroutine collect_inputoutput + +end module TestInputOutput diff --git a/autotest/TestList.f90 b/autotest/TestList.f90 new file mode 100644 index 00000000000..605460ec9d2 --- /dev/null +++ b/autotest/TestList.f90 @@ -0,0 +1,254 @@ +module TestList + use KindModule, only: I4B + use testdrive, only: error_type, unittest_type, new_unittest, check + use ConstantsModule, only: LINELENGTH + use ListModule, only: ListType + implicit none + private + public :: collect_list + + type :: IntNodeType + integer :: value + end type IntNodeType + +contains + + subroutine collect_list(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("add_count_get_item", & + test_add_count_get_item), & + new_unittest("get_get_index_contains", & + test_get_index_contains), & + new_unittest("get_next_previous_item_reset", & + test_get_next_previous_item_reset), & + new_unittest("insert_after", & + test_insert_after), & + new_unittest("remove_node", & + test_remove_node) & + ] + end subroutine collect_list + + subroutine test_add_count_get_item(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list + type(IntNodeType), pointer :: n + class(*), pointer :: p + + allocate (list) + allocate (n) + + ! empty + call check(error, list%Count() == 0, "count should be 0") + if (allocated(error)) return + + ! add one node + n%value = 1 + p => n + call list%Add(p) + + ! check count + call check(error, list%Count() == 1, "count should be 1") + if (allocated(error)) return + + ! retrieve item + p => list%GetItem(1) + call check(error, associated(p, n)) + select type (item => p) + type is (IntNodeType) + call check(error, item%value == 1, "wrong value") + class default + call check(error, .false., "wrong node type") + end select + if (allocated(error)) return + + deallocate (list) + deallocate (n) + end subroutine test_add_count_get_item + + subroutine test_get_index_contains(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list + type(IntNodeType), pointer :: n1, n2 + class(*), pointer :: p + integer(I4B) :: i + + allocate (list) + allocate (n1) + allocate (n2) + + ! add nodes + n1%value = 1 + n2%value = 2 + p => n1 + call list%Add(p) + p => n2 + call list%Add(p) + + ! check count + call check(error, list%Count() == 2, "count should be 1") + if (allocated(error)) return + + ! check get index + i = list%GetIndex(p) + call check(error, i == 2, "wrong index") + if (allocated(error)) return + + ! check contains + p => n1 + call check(error, list%ContainsObject(p), "should contain n1") + if (allocated(error)) return + p => n2 + call check(error, list%ContainsObject(p), "should contain n2") + if (allocated(error)) return + + deallocate (list) + deallocate (n1) + deallocate (n2) + end subroutine test_get_index_contains + + subroutine test_get_next_previous_item_reset(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list + type(IntNodeType), pointer :: n1, n2, n3 + class(*), pointer :: p + integer(I4B) :: i + + allocate (list) + allocate (n1) + allocate (n2) + allocate (n3) + + ! add nodes + n1%value = 1 + n2%value = 2 + n3%value = 3 + p => n1 + call list%Add(p) + p => n2 + call list%Add(p) + p => n3 + call list%Add(p) + + ! check count + call check(error, list%Count() == 3, "count should be 3") + if (allocated(error)) return + + ! check get next/previous item + p => list%GetNextItem() + call check(error, associated(p, n1)) + p => list%GetNextItem() + call check(error, associated(p, n2)) + p => list%GetPreviousItem() + call check(error, associated(p, n1)) + p => list%GetNextItem() + call check(error, associated(p, n2)) + p => list%GetNextItem() + call check(error, associated(p, n3)) + p => list%GetNextItem() + call check(error, (.not. associated(p))) + call list%Reset() + p => list%GetPreviousItem() + call check(error, (.not. associated(p))) + + deallocate (list) + deallocate (n1) + deallocate (n2) + deallocate (n3) + end subroutine test_get_next_previous_item_reset + + subroutine test_insert_after(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list + type(IntNodeType), pointer :: n1, n2, n3 + class(*), pointer :: p + + allocate (list) + allocate (n1) + allocate (n2) + allocate (n3) + + ! add nodes 1 and 3 + n1%value = 1 + n2%value = 2 + n3%value = 3 + p => n1 + call list%Add(p) + p => n3 + call list%Add(p) + + ! check count + call check(error, list%Count() == 2, "count should be 2") + if (allocated(error)) return + + ! insert item after first item + p => n2 + call list%InsertAfter(p, 1) + + ! check count + call check(error, list%Count() == 3, "count should be 3") + if (allocated(error)) return + + ! check get next/previous item + call list%Reset() + p => list%GetNextItem() + call check(error, associated(p, n1)) + p => list%GetNextItem() + call check(error, associated(p, n2)) + p => list%GetNextItem() + call check(error, associated(p, n3)) + if (allocated(error)) return + + deallocate (list) + deallocate (n1) + deallocate (n2) + deallocate (n3) + end subroutine test_insert_after + + subroutine test_remove_node(error) + type(error_type), allocatable, intent(out) :: error + type(ListType), pointer :: list + type(IntNodeType), pointer :: n1, n2, n3 + class(*), pointer :: p + + allocate (list) + allocate (n1) + allocate (n2) + allocate (n3) + + ! add nodes + n1%value = 1 + n2%value = 2 + n3%value = 3 + p => n1 + call list%Add(p) + p => n2 + call list%Add(p) + p => n3 + call list%Add(p) + + ! check count + call check(error, list%Count() == 3, "count should be 3") + if (allocated(error)) return + + ! remove first node + call list%RemoveNode(1, .false.) + call check(error, list%Count() == 2, "count should be 2") + p => list%GetItem(1) + call check(error, associated(p, n2)) + p => list%GetItem(2) + call check(error, associated(p, n3)) + + ! remove last node + call list%RemoveNode(2, .false.) + call check(error, list%Count() == 1, "count should be 1") + p => list%GetItem(1) + call check(error, associated(p, n2)) + + deallocate (list) + deallocate (n1) + deallocate (n2) + deallocate (n3) + end subroutine test_remove_node + +end module TestList diff --git a/autotest/TestMathUtil.f90 b/autotest/TestMathUtil.f90 new file mode 100644 index 00000000000..a07ad0af55c --- /dev/null +++ b/autotest/TestMathUtil.f90 @@ -0,0 +1,243 @@ +module TestMathUtil + use KindModule, only: I4B, DP + use ConstantsModule, only: DNODATA, DZERO + use testdrive, only: check, error_type, new_unittest, test_failed, & + to_string, unittest_type + use MathUtilModule, only: f1d, is_close, mod_offset, & + zeroch, zerotest, zeroin + implicit none + private + public :: collect_mathutil + +contains + + subroutine collect_mathutil(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("is_close_symmetric", test_is_close_symmetric), & + new_unittest("is_close_symmetric_near_0", & + test_is_close_symmetric_near_0), & + new_unittest("mod_offset", & + test_mod_offset), & + new_unittest("zeroch", & + test_zeroch), & + new_unittest("zeroin", & + test_zeroin), & + new_unittest("zerotest", & + test_zerotest) & + ] + end subroutine collect_mathutil + + subroutine test_mod_offset(error) + type(error_type), allocatable, intent(out) :: error + + ! with no offset specified, should behave just like mod + call check(error, mod_offset(2, 2) == 0) + call check(error, mod_offset(2, 3) == 2) + call check(error, mod_offset(2.0_DP, 2.0_DP) == 0.0_DP) + call check(error, mod_offset(2.0_DP, 3.0_DP) == 2.0_DP) + + ! with offset d specified, if the result x = a mod n falls + ! between 0 and n - 1, the new result x = a mod_d n falls + ! between d and d + n - 1. + call check(error, mod_offset(2, 3, -2) == -1) + call check(error, mod_offset(2, 3, -1) == -1) + call check(error, mod_offset(2, 3, 0) == 2) + call check(error, mod_offset(2, 3, 1) == 2) + call check(error, mod_offset(2, 3, 2) == 2) + call check(error, mod_offset(2, 3, 3) == 5) + call check(error, mod_offset(2, 3, 4) == 5) + call check(error, mod_offset(2.0_DP, 3.0_DP, -1.0_DP) == -1.0_DP) + call check(error, mod_offset(2.0_DP, 3.0_DP, 2.0_DP) == 2.0_DP) + call check(error, mod_offset(2.0_DP, 3.0_DP, 3.0_DP) == 5.0_DP) + end subroutine test_mod_offset + + subroutine test_is_close_symmetric(error) + type(error_type), allocatable, intent(out) :: error + real(DP) :: a, b, rtol + + ! exact match + a = 1.0_DP + b = 1.0_DP + call check(error, is_close(a, b), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + if (allocated(error)) return + + ! mismatch with default rtol + b = 1.0001_DP + call check(error, (.not. (is_close(a, b))), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + if (allocated(error)) return + + ! inexact match with large rtol + rtol = 1d-2 + call check(error, is_close(a, b, rtol=rtol), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol="//to_string(rtol)) + if (allocated(error)) return + + ! mismatch when we reduce rtol + rtol = 0.5d-5 + call check(error, (.not. is_close(a, b, rtol=rtol)), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol="//to_string(rtol)) + if (allocated(error)) return + + ! +/-0 + call check(error, is_close(0.0_DP, -0.0_DP), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + + ! DNODATA + call check(error, (.not. is_close(0.0_DP, DNODATA)), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + call check(error, is_close(DNODATA, DNODATA), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + call check(error, (.not. is_close(DNODATA, DNODATA / 10)), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + call check(error, (.not. is_close(DNODATA, DNODATA * 10)), & + "exp ne: a="//to_string(a)// & + ", b="//to_string(b)// & + ", eps=default") + + end subroutine test_is_close_symmetric + + subroutine test_is_close_symmetric_near_0(error) + type(error_type), allocatable, intent(out) :: error + real(DP) :: a, b, rtol, atol + + a = 0.0_DP + b = 0.0_DP + call check(error, is_close(a, b), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol=default") + if (allocated(error)) return + + a = DZERO + b = DZERO + call check(error, is_close(a, b), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol=default") + if (allocated(error)) return + + b = 1d-4 + call check(error, (.not. is_close(a, b)), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol=default") + if (allocated(error)) return + + rtol = 0.999_DP + call check(error, & + ! expect failure, see above + (.not. is_close(a, b, rtol=rtol)), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", rtol="//to_string(rtol)) + if (allocated(error)) return + + ! absolute comparison is appropriate when a and/or b are near or equal to 0 + b = 1d-4 + atol = 1d-3 + call check(error, is_close(a, b, atol=atol), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", atol="//to_string(atol)) + if (allocated(error)) return + + ! make sure the absolute tolerance is applied + b = 1d-4 + atol = 1d-5 + call check(error, (.not. is_close(a, b, atol=atol)), & + "exp eq: a="//to_string(a)// & + ", b="//to_string(b)// & + ", atol="//to_string(atol)) + if (allocated(error)) return + + end subroutine test_is_close_symmetric_near_0 + + pure function sine(bet) result(s) + real(DP), intent(in) :: bet + real(DP) :: s + s = sin(bet) + end function sine + + subroutine test_zeroch(error) + type(error_type), allocatable, intent(out) :: error + real(DP), parameter :: pi = 4 * atan(1.0_DP) + real(DP) :: z + procedure(f1d), pointer :: f + + f => sine + + z = zeroch(-1.0_DP, 1.0_DP, f, 0.001_DP) + call check(error, is_close(z, 0.0_DP, atol=1d-6), & + 'expected 0, got: '//to_string(z)) + + z = zeroch(-4.0_DP, -1.0_DP, f, 0.001_DP) + call check(error, is_close(z, -pi, atol=1d-6), & + 'expected -pi, got: '//to_string(z)) + + z = zeroch(1.0_DP, 4.0_DP, f, 0.001_DP) + call check(error, is_close(z, pi, atol=1d-6), & + 'expected pi, got: '//to_string(z)) + end subroutine test_zeroch + + subroutine test_zeroin(error) + type(error_type), allocatable, intent(out) :: error + real(DP), parameter :: pi = 4 * atan(1.0_DP) + real(DP) :: z + procedure(f1d), pointer :: f + + f => sine + + z = zeroin(-1.0_DP, 1.0_DP, f, 0.001_DP) + call check(error, is_close(z, 0.0_DP, atol=1d-6), & + 'expected 0, got: '//to_string(z)) + + z = zeroin(-4.0_DP, -1.0_DP, f, 0.001_DP) + call check(error, is_close(z, -pi, atol=1d-6), & + 'expected -pi, got: '//to_string(z)) + + z = zeroin(1.0_DP, 4.0_DP, f, 0.001_DP) + call check(error, is_close(z, pi, atol=1d-6), & + 'expected pi, got: '//to_string(z)) + end subroutine test_zeroin + + subroutine test_zerotest(error) + type(error_type), allocatable, intent(out) :: error + real(DP), parameter :: pi = 4 * atan(1.0_DP) + real(DP) :: z + procedure(f1d), pointer :: f + + f => sine + + z = zerotest(-1.0_DP, 1.0_DP, f, 0.001_DP) + call check(error, is_close(z, 0.0_DP, atol=1d-6), & + 'expected 0, got: '//to_string(z)) + + z = zerotest(-4.0_DP, -1.0_DP, f, 0.001_DP) + call check(error, is_close(z, -pi, atol=1d-6), & + 'expected -pi, got: '//to_string(z)) + + z = zerotest(1.0_DP, 4.0_DP, f, 0.001_DP) + call check(error, is_close(z, pi, atol=1d-6), & + 'expected pi, got: '//to_string(z)) + end subroutine test_zerotest + +end module TestMathUtil diff --git a/autotest/TestMessage.f90 b/autotest/TestMessage.f90 new file mode 100644 index 00000000000..b78d490df5b --- /dev/null +++ b/autotest/TestMessage.f90 @@ -0,0 +1,41 @@ +module TestMessage + use testdrive, only: error_type, unittest_type, new_unittest, check + use MessageModule, only: MessagesType + use ConstantsModule, only: LINELENGTH + + implicit none + private + public :: collect_message + +contains + + subroutine collect_message(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("init_and_count", test_init_and_count), & + new_unittest("store_count_and_write_all", & + test_store_count_and_write_all) & + ] + end subroutine collect_message + + subroutine test_init_and_count(error) + type(error_type), allocatable, intent(out) :: error + type(MessagesType) :: messages + messages = MessagesType() + call messages%init() + call check(error, messages%count() == 0) + end subroutine test_init_and_count + + subroutine test_store_count_and_write_all(error) + type(error_type), allocatable, intent(out) :: error + type(MessagesType) :: messages + messages = MessagesType() + call messages%init() + call messages%store("1") + call messages%store("2") + call check(error, messages%count() == 2) + ! debug visually with e.g. `meson test --no-rebuild -C builddir --verbose Message` + call messages%write_all() + end subroutine test_store_count_and_write_all + +end module TestMessage diff --git a/autotest/TestSim.f90 b/autotest/TestSim.f90 new file mode 100644 index 00000000000..b01b9ea93a8 --- /dev/null +++ b/autotest/TestSim.f90 @@ -0,0 +1,58 @@ +module TestSim + use testdrive, only: error_type, unittest_type, new_unittest, check + use SimModule, only: store_error, store_warning, store_note, & + initial_message, count_errors, count_notes, & + count_warnings + use ConstantsModule, only: LINELENGTH + + implicit none + private + public :: collect_sim + +contains + + subroutine collect_sim(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("store_and_count", test_store_and_count) & + ] + end subroutine collect_sim + + subroutine test_store_and_count(error) + type(error_type), allocatable, intent(out) :: error + character(len=LINELENGTH) :: ntemsg + character(len=LINELENGTH) :: wrnmsg + character(len=LINELENGTH) :: errmsg + + ! define messages + ntemsg = "NOTE" + wrnmsg = "WARNING" + errmsg = "ERROR" + + ! initialize message arrays + call initial_message() + + ! check no messages stored + call check(error, count_errors() == 0) + call check(error, count_warnings() == 0) + call check(error, count_notes() == 0) + if (allocated(error)) return + + ! todo store a note and check that it's stored + call store_note(ntemsg) + call check(error, count_notes() == 1) + if (allocated(error)) return + + ! todo store a warning and check that it's stored + call store_warning(wrnmsg) + call check(error, count_warnings() == 1) + if (allocated(error)) return + + ! store an error and check that it's stored + call store_error(errmsg, terminate=.false.) + call check(error, count_errors() == 1) + if (allocated(error)) return + + end subroutine test_store_and_count + +end module TestSim diff --git a/autotest/build_exes.py b/autotest/build_exes.py index ede1d7a67e7..bd7125bd478 100644 --- a/autotest/build_exes.py +++ b/autotest/build_exes.py @@ -2,9 +2,10 @@ from pathlib import Path import pytest -from conftest import project_root_path from modflow_devtools.build import meson_build +from conftest import project_root_path + repository = "MODFLOW-USGS/modflow6" top_bin_path = project_root_path / "bin" diff --git a/autotest/build_mfio_tex.py b/autotest/build_mfio_tex.py index ab57f2da85d..aca75f8e242 100644 --- a/autotest/build_mfio_tex.py +++ b/autotest/build_mfio_tex.py @@ -49,7 +49,6 @@ def test_rebuild_from_dfn(): pth = "./" with cwd(npth): - # get list of TeX files files = [ f diff --git a/autotest/common_regression.py b/autotest/common_regression.py index a167d9235ee..a1307adc23f 100644 --- a/autotest/common_regression.py +++ b/autotest/common_regression.py @@ -1,8 +1,31 @@ import os import shutil -import sys - -ignore_ext = ( +from pathlib import Path +from typing import Iterator, List, Optional, Tuple, Union +from warnings import warn + +import numpy as np +from flopy.utils import CellBudgetFile +from flopy.utils.compare import compare_heads + +COMPARE_PROGRAMS = ( + "mf2005", + "mfnwt", + "mfusg", + "mflgr", + "libmf6", + "mf6", + "mf6_regression" + # todo: "mp7" +) +EXTTEXT = { + "hds": "head", + "hed": "head", + "bhd": "head", + "ucn": "concentration", + "cbc": "cell-by-cell", +} +IGNORE_EXTENSIONS = ( ".hds", ".hed", ".bud", @@ -19,185 +42,64 @@ ) -def model_setup(namefile, dst, remove_existing=True, extrafiles=None): - """Setup MODFLOW-based model files for autotests. - - Parameters - ---------- - namefile : str - MODFLOW-based model name file. - dst : str - destination path for comparison model or file(s) - remove_existing : bool - boolean indicating if an existing comparision model or file(s) should - be replaced (default is True) - extrafiles : str or list of str - list of extra files to include in the comparision - - Returns - ------- - - """ - # Construct src pth from namefile or lgr file - src = os.path.dirname(namefile) - - # Create the destination folder, if required - create_dir = False - if os.path.exists(dst): - if remove_existing: - print("Removing folder " + dst) - shutil.rmtree(dst) - create_dir = True - else: - create_dir = True - if create_dir: - os.mkdir(dst) - - # determine if a namefile is a lgr control file - get individual - # name files out of the lgr control file - namefiles = [namefile] - ext = os.path.splitext(namefile)[1] - if ".lgr" in ext.lower(): - lines = [line.rstrip("\n") for line in open(namefile)] - for line in lines: - if len(line) < 1: - continue - if line[0] == "#": - continue - t = line.split() - if ".nam" in t[0].lower(): - fpth = os.path.join(src, t[0]) - namefiles.append(fpth) - - # Make list of files to copy - files2copy = [] - for fpth in namefiles: - files2copy.append(os.path.basename(fpth)) - ext = os.path.splitext(fpth)[1] - # copy additional files contained in the name file and - # associated package files - if ext.lower() == ".nam": - fname = os.path.abspath(fpth) - files2copy = files2copy + get_input_files(fname) - - if extrafiles is not None: - if isinstance(extrafiles, str): - extrafiles = [extrafiles] - for fl in extrafiles: - files2copy.append(os.path.basename(fl)) - - # Copy the files - for f in files2copy: - srcf = os.path.join(src, f) - dstf = os.path.join(dst, f) - - # Check to see if dstf is going into a subfolder, and create that - # subfolder if it doesn't exist - sf = os.path.dirname(dstf) - if not os.path.isdir(sf): - os.makedirs(sf) - - # Now copy the file - if os.path.exists(srcf): - print("Copy file '" + srcf + "' -> '" + dstf + "'") - shutil.copy(srcf, dstf) - else: - print(srcf + " does not exist") - - return - - -def setup_comparison(namefile, dst, remove_existing=True): - """Setup a comparison model or comparision file(s) for a MODFLOW-based - model. +def adjust_htol( + workspace: Union[str, os.PathLike], htol: float = 0.001 +) -> Optional[float]: + """Get outer_dvclose value from MODFLOW 6 ims file""" + + dvclose = get_dvclose(workspace) + if not dvclose: + return htol + + # adjust htol if < IMS outer_dvclose + dvclose *= 5.0 + return dvclose if (htol is None or htol < dvclose) else htol + + +def get_dvclose(workspace: Union[str, os.PathLike]) -> Optional[float]: + """Get outer_dvclose value from MODFLOW 6 ims file""" + dvclose = None + files = os.listdir(workspace) + for file_name in files: + pth = os.path.join(workspace, file_name) + if os.path.isfile(pth): + if file_name.lower().endswith(".ims"): + with open(pth) as f: + lines = f.read().splitlines() + for line in lines: + if "outer_dvclose" in line.lower(): + v = float(line.split()[1]) + if dvclose is None: + dvclose = v + else: + if v > dvclose: + dvclose = v + break - Parameters - ---------- - namefile : str - MODFLOW-based model name file. - dst : str - destination path for comparison model or file(s) - remove_existing : bool - boolean indicating if an existing comparision model or file(s) should - be replaced (default is True) + return dvclose - Returns - ------- +def get_rclose(workspace: Union[str, os.PathLike]) -> Optional[float]: + """Get inner_rclose value from MODFLOW 6 ims file""" - """ - # Construct src pth from namefile - src = os.path.dirname(namefile) - action = None - for root, dirs, files in os.walk(src): - dl = [d.lower() for d in dirs] - if any(".cmp" in s for s in dl): - idx = None - for jdx, d in enumerate(dl): - if ".cmp" in d: - idx = jdx - break - if idx is not None: - if "mf2005.cmp" in dl[idx] or "mf2005" in dl[idx]: - action = dirs[idx] - elif "mfnwt.cmp" in dl[idx] or "mfnwt" in dl[idx]: - action = dirs[idx] - elif "mfusg.cmp" in dl[idx] or "mfusg" in dl[idx]: - action = dirs[idx] - elif "mf6.cmp" in dl[idx] or "mf6" in dl[idx]: - action = dirs[idx] - elif "libmf6.cmp" in dl[idx] or "libmf6" in dl[idx]: - action = dirs[idx] - else: - action = dirs[idx] - break - if action is not None: - dst = os.path.join(dst, f"{action}") - if not os.path.isdir(dst): - try: - os.mkdir(dst) - except: - print("Could not make " + dst) - # clean directory - else: - print(f"cleaning...{dst}") - for root, dirs, files in os.walk(dst): - for f in files: - tpth = os.path.join(root, f) - print(f" removing...{tpth}") - os.remove(tpth) - for d in dirs: - tdir = os.path.join(root, d) - print(f" removing...{tdir}") - shutil.rmtree(tdir) - # copy files - cmppth = os.path.join(src, action) - files = os.listdir(cmppth) - files2copy = [] - if action.lower() == ".cmp": - for file in files: - if ".cmp" in os.path.splitext(file)[1].lower(): - files2copy.append(os.path.join(cmppth, file)) - for srcf in files2copy: - f = os.path.basename(srcf) - dstf = os.path.join(dst, f) - # Now copy the file - if os.path.exists(srcf): - print("Copy file '" + srcf + "' -> '" + dstf + "'") - shutil.copy(srcf, dstf) - else: - print(srcf + " does not exist") - else: - for file in files: - if ".nam" in os.path.splitext(file)[1].lower(): - files2copy.append( - os.path.join(cmppth, os.path.basename(file)) - ) - nf = os.path.join(src, action, os.path.basename(file)) - model_setup(nf, dst, remove_existing=remove_existing) + rclose = None + for pth in workspace.glob("*.ims"): + with open(pth, "r") as f: + for line in f: + if "inner_rclose" in line.lower(): + v = float(line.split()[1]) + if rclose is None: + rclose = v + else: + if v > rclose: + rclose = v break - return action + if rclose is None: + return 0.5 + + rclose *= 5.0 + return rclose def get_input_files(namefile): @@ -227,7 +129,7 @@ def get_input_files(namefile): if line.strip()[0] in ["#", "!"]: continue ext = os.path.splitext(ll[2])[1] - if ext.lower() not in ignore_ext: + if ext.lower() not in IGNORE_EXTENSIONS: if len(ll) > 3: if "replace" in ll[3].lower(): continue @@ -242,7 +144,6 @@ def get_input_files(namefile): try: f = open(fname, "r") for line in f: - # Skip invalid lines ll = line.strip().split() if len(ll) < 2: @@ -259,7 +160,7 @@ def get_input_files(namefile): otherfiles.append(stmp) break except: - print(fname + " does not exist") + print(f"{fname} does not exist") filelist = filelist + otherfiles @@ -302,132 +203,38 @@ def get_namefiles(pth, exclude=None): return namefiles -def get_sim_name(namefiles, rootpth=None): - """Get simulation name. - - Parameters - ---------- - namefiles : str or list of strings - path(s) to MODFLOW-based model name files - rootpth : str - optional root directory path (default is None) - - Returns - ------- - simname : list - list of namefiles without the file extension - +def get_matching_files( + workspace: Union[str, os.PathLike], extensions: Union[str, Iterator[str]] +) -> Iterator[str]: """ - if isinstance(namefiles, str): - namefiles = [namefiles] - sim_name = [] - for namefile in namefiles: - t = namefile.split(os.sep) - if rootpth is None: - idx = -1 - else: - idx = t.index(os.path.split(rootpth)[1]) - - # build dst with everything after the rootpth and before - # the namefile file name. - dst = "" - if idx < len(t): - for d in t[idx + 1 : -1]: - dst += f"{d}_" - - # add namefile basename without extension - dst += t[-1].replace(".nam", "") - sim_name.append(dst) - - return sim_name - - -def setup_mf6( - src, dst, mfnamefile="mfsim.nam", extrafiles=None, remove_existing=True -): - """Copy all of the MODFLOW 6 input files from the src directory to the dst - directory. - + Get MF6 regression files in the specified workspace, + optionally filtering by one or more file extensions. Parameters ---------- - src : src - directory path with original MODFLOW 6 input files - dst : str - directory path that original MODFLOW 6 input files will be copied to - mfnamefile : str - optional MODFLOW 6 simulation name file (default is mfsim.nam) - extrafiles : bool - boolean indicating if extra files should be included (default is None) - remove_existing : bool - boolean indicating if existing file in dst should be removed (default - is True) - + workspace : str or PathLike + MODFLOW 6 simulation workspace path + extensions : str or list of str + file extensions to filter Returns ------- - mf6inp : list - list of MODFLOW 6 input files - mf6outp : list - list of MODFLOW 6 output files - + An iterator of regression files found """ - # Create the destination folder - create_dir = False - if os.path.exists(dst): - if remove_existing: - print("Removing folder " + dst) - shutil.rmtree(dst) - create_dir = True - else: - create_dir = True - if create_dir: - os.makedirs(dst) + workspace = Path(workspace).expanduser().absolute() + if isinstance(extensions, str): + extensions = [extensions] - # Make list of files to copy - fname = os.path.join(src, mfnamefile) - fname = os.path.abspath(fname) - mf6inp, mf6outp = get_mf6_files(fname) - files2copy = [mfnamefile] + mf6inp - - # determine if there are any .ex files - exinp = [] - for f in mf6outp: - ext = os.path.splitext(f)[1] - if ext.lower() == ".hds": - pth = os.path.join(src, f + ".ex") - if os.path.isfile(pth): - exinp.append(f + ".ex") - if len(exinp) > 0: - files2copy += exinp - if extrafiles is not None: - files2copy += extrafiles - - # Copy the files - for f in files2copy: - srcf = os.path.join(src, f) - dstf = os.path.join(dst, f) - - # Check to see if dstf is going into a subfolder, and create that - # subfolder if it doesn't exist - sf = os.path.dirname(dstf) - if not os.path.isdir(sf): - try: - os.mkdir(sf) - except: - print("Could not make " + sf) - - # Now copy the file - if os.path.exists(srcf): - print("Copy file '" + srcf + "' -> '" + dstf + "'") - shutil.copy(srcf, dstf) - else: - print(srcf + " does not exist") - - return mf6inp, mf6outp + for ext in extensions: + for file in workspace.glob(f"*.{ext}"): + yield file def get_mf6_comparison(src): - """Determine comparison type for MODFLOW 6 simulation. + """ + Determine the comparison type for a MODFLOW 6 simulation + based on files present in the simulation workspace. Some + files take precedence over others according to the order + specified in `COMPARE_PROGRAMS`. Parameters ---------- @@ -440,210 +247,36 @@ def get_mf6_comparison(src): comparison type """ - action = None - # Possible comparison - the order matters - optcomp = ( - "compare", - ".cmp", - "mf2005", - "mf2005.cmp", - "mfnwt", - "mfnwt.cmp", - "mfusg", - "mfusg.cmp", - "mflgr", - "mflgr.cmp", - "libmf6", - "libmf6.cmp", - "mf6", - "mf6.cmp", - ) - # Construct src pth from namefile - action = None + for _, dirs, _ in os.walk(src): dl = [d.lower() for d in dirs] - for oc in optcomp: - if any(oc in s for s in dl): - action = oc - break - return action + for pattern in COMPARE_PROGRAMS: + if any(pattern in s for s in dl): + return pattern -def setup_mf6_comparison(src, dst, remove_existing=True): - """Setup comparision for MODFLOW 6 simulation. +def get_mf6_files(namefile, verbose=False): + """Get all MODFLOW 6 input and output files in this simulation. Parameters ---------- - src : src - directory path with original MODFLOW 6 input files - dst : str - directory path that original MODFLOW 6 input files will be copied to - remove_existing : bool - boolean indicating if existing file in dst should be removed (default - is True) - - Returns - ------- - action : str - comparison type - - """ - # get the type of comparison to use (compare, mf2005, etc.) - action = get_mf6_comparison(src) - - if action is not None: - dst = os.path.join(dst, f"{action}") - if not os.path.isdir(dst): - try: - os.mkdir(dst) - except: - print("Could not make " + dst) - # clean directory - else: - print(f"cleaning...{dst}") - for root, dirs, files in os.walk(dst): - for f in files: - tpth = os.path.join(root, f) - print(f" removing...{tpth}") - os.remove(tpth) - for d in dirs: - tdir = os.path.join(root, d) - print(f" removing...{tdir}") - shutil.rmtree(tdir) - # copy files - cmppth = os.path.join(src, action) - files = os.listdir(cmppth) - files2copy = [] - if action.lower() == "compare" or action.lower() == ".cmp": - for file in files: - if ".cmp" in os.path.splitext(file)[1].lower(): - files2copy.append(os.path.join(cmppth, file)) - for srcf in files2copy: - f = os.path.basename(srcf) - dstf = os.path.join(dst, f) - # Now copy the file - if os.path.exists(srcf): - print("Copy file '" + srcf + "' -> '" + dstf + "'") - shutil.copy(srcf, dstf) - else: - print(srcf + " does not exist") - else: - if "mf6" in action.lower(): - for file in files: - if "mfsim.nam" in file.lower(): - srcf = os.path.join(cmppth, os.path.basename(file)) - files2copy.append(srcf) - srcdir = os.path.join(src, action) - setup_mf6(srcdir, dst, remove_existing=remove_existing) - break - else: - for file in files: - if ".nam" in os.path.splitext(file)[1].lower(): - srcf = os.path.join(cmppth, os.path.basename(file)) - files2copy.append(srcf) - nf = os.path.join(src, action, os.path.basename(file)) - model_setup(nf, dst, remove_existing=remove_existing) - break - - return action - - -def get_mf6_nper(tdisfile): - """Return the number of stress periods in the MODFLOW 6 model. - - Parameters - ---------- - tdisfile : str - path to the TDIS file - - Returns - ------- - nper : int - number of stress periods in the simulation - - """ - with open(tdisfile, "r") as f: - lines = f.readlines() - line = [line for line in lines if "NPER" in line.upper()][0] - nper = line.strip().split()[1] - return nper - - -def get_mf6_mshape(disfile): - """Return the shape of the MODFLOW 6 model. - - Parameters - ---------- - disfile : str - path to a MODFLOW 6 discretization file - - Returns - ------- - mshape : tuple - tuple with the shape of the MODFLOW 6 model. - - """ - with open(disfile, "r") as f: - lines = f.readlines() - - d = {} - for line in lines: - - # Skip over blank and commented lines - ll = line.strip().split() - if len(ll) < 2: - continue - if line.strip()[0] in ["#", "!"]: - continue - - for key in ["NODES", "NCPL", "NLAY", "NROW", "NCOL"]: - if ll[0].upper() in key: - d[key] = int(ll[1]) - - if "NODES" in d: - mshape = (d["NODES"],) - elif "NCPL" in d: - mshape = (d["NLAY"], d["NCPL"]) - elif "NLAY" in d: - mshape = (d["NLAY"], d["NROW"], d["NCOL"]) - else: - print(d) - raise Exception("Could not determine model shape") - return mshape - - -def get_mf6_files(mfnamefile): - """Return a list of all the MODFLOW 6 input and output files in this model. - - Parameters - ---------- - mfnamefile : str + namefile : pathlike path to the MODFLOW 6 simulation name file Returns ------- - filelist : list - list of MODFLOW 6 input files in a simulation - outplist : list - list of MODFLOW 6 output files in a simulation - + A tuple of lists of paths (input files, output files) """ - srcdir = os.path.dirname(mfnamefile) - filelist = [] - outplist = [] - - filekeys = ["TDIS6", "GWF6", "GWT", "GWF6-GWF6", "GWF-GWT", "IMS6"] - namefilekeys = ["GWF6", "GWT"] - namefiles = [] - - with open(mfnamefile) as f: - - # Read line and skip comments - lines = f.readlines() - - for line in lines: - + srcdir = os.path.dirname(namefile) + mdl_files = [] + pkg_files = [] + out_files = [] + pkg_keys = ["TDIS6", "GWF6", "GWT6", "GWF6-GWF6", "GWF-GWT", "IMS6"] + model_keys = ["GWF6", "GWT"] + + # find model and simulation-level package input files in simulation namefile + for line in open(namefile).readlines(): # Skip over blank and commented lines ll = line.strip().split() if len(ll) < 2: @@ -651,21 +284,20 @@ def get_mf6_files(mfnamefile): if line.strip()[0] in ["#", "!"]: continue - for key in filekeys: + for key in pkg_keys: if key in ll[0].upper(): fname = ll[1] - filelist.append(fname) + pkg_files.append(fname) - for key in namefilekeys: + for key in model_keys: if key in ll[0].upper(): fname = ll[1] - namefiles.append(fname) + mdl_files.append(fname) - # Go through name files and get files - for namefile in namefiles: + # find model-level package input files in model namefiles + for namefile in mdl_files: fname = os.path.join(srcdir, namefile) - with open(fname, "r") as f: - lines = f.readlines() + lines = open(fname, "r").readlines() insideblock = False for line in lines: @@ -684,31 +316,34 @@ def get_mf6_files(mfnamefile): continue if line.strip()[0] in ["#", "!"]: continue - filelist.append(ll[1]) + pkg_files.append(ll[1]) - # Recursively go through every file and look for other files to copy, - # such as 'OPEN/CLOSE' and 'TIMESERIESFILE'. If found, then - # add that file to the list of files to copy. - flist = filelist - # olist = outplist + # Recurse through package input files and look for input or + # output file entries, e.g. 'OPEN/CLOSE', 'TIMESERIESFILE' + # or similar + flist = pkg_files while True: olist = [] - flist, olist = _get_mf6_external_files(srcdir, olist, flist) - # add to filelist - if len(flist) > 0: - filelist = filelist + flist - # add to outplist - if len(olist) > 0: - outplist = outplist + olist + flist, olist = get_mf6_external_files(srcdir, olist, flist) + pkg_files += flist + out_files += olist # terminate loop if no additional files # if len(flist) < 1 and len(olist) < 1: if len(flist) < 1: break - return filelist, outplist + if verbose: + from pprint import pprint + + print(f"Found input files for {namefile}:") + pprint(pkg_files) + print(f"Expecting output files for {namefile}:") + pprint(out_files) + + return pkg_files, out_files -def _get_mf6_external_files(srcdir, outplist, files): +def get_mf6_external_files(srcdir, outplist, files): """Get list of external files in a MODFLOW 6 simulation. Parameters @@ -731,7 +366,6 @@ def _get_mf6_external_files(srcdir, outplist, files): try: f = open(fname, "r") for line in f: - # Skip invalid lines ll = line.strip().split() if len(ll) < 2: @@ -829,7 +463,6 @@ def get_mf6_ftypes(namefile, ftypekeys): ftypes = [] for line in lines: - # Skip over blank and commented lines ll = line.strip().split() if len(ll) < 2: @@ -844,36 +477,264 @@ def get_mf6_ftypes(namefile, ftypekeys): return ftypes -def get_mf6_blockdata(f, blockstr): - """Return list with all non comments between start and end of block - specified by blockstr. +def get_regression_files( + workspace: os.PathLike, extensions +) -> Tuple[List[str], List[str]]: + if isinstance(extensions, str): + extensions = [extensions] + files = os.listdir(workspace) + files0 = [] + files1 = [] + for file_name in files: + fpth0 = os.path.join(workspace, file_name) + if os.path.isfile(fpth0): + for extension in extensions: + if file_name.lower().endswith(extension): + files0.append(fpth0) + fpth1 = os.path.join( + workspace, "mf6_regression", file_name + ) + files1.append(fpth1) + break + return files0, files1 + + +def setup_model(namefile, dst, remove_existing=True, extrafiles=None): + """ + Setup a non-MF6 model test, copying input files to the destination workspace. Parameters ---------- - f : file object - open file object - blockstr : str - name of block to search + namefile : str + MODFLOW-based model name file. + dst : str + destination path for comparison model or file(s) + remove_existing : bool + boolean indicating if an existing comparision model or file(s) should + be replaced (default is True) + extrafiles : str or list of str + list of extra files to include in the comparision + + """ + # Construct src pth from namefile or lgr file + src = os.path.dirname(namefile) + + # Create the destination folder, if required + create_dir = False + if os.path.exists(dst): + if remove_existing: + print(f"Removing directory '{dst}'") + shutil.rmtree(dst) + create_dir = True + else: + create_dir = True + if create_dir: + os.mkdir(dst) + + # determine if a namefile is a lgr control file - get individual + # name files out of the lgr control file + namefiles = [namefile] + ext = os.path.splitext(namefile)[1] + if ".lgr" in ext.lower(): + lines = [line.rstrip("\n") for line in open(namefile)] + for line in lines: + if len(line) < 1: + continue + if line[0] == "#": + continue + t = line.split() + if ".nam" in t[0].lower(): + fpth = os.path.join(src, t[0]) + namefiles.append(fpth) + + # Make list of files to copy + files2copy = [] + for fpth in namefiles: + files2copy.append(os.path.basename(fpth)) + ext = os.path.splitext(fpth)[1] + # copy additional files contained in the name file and + # associated package files + if ext.lower() == ".nam": + fname = os.path.abspath(fpth) + files2copy = files2copy + get_input_files(fname) + + if extrafiles is not None: + if isinstance(extrafiles, str): + extrafiles = [extrafiles] + for fl in extrafiles: + files2copy.append(os.path.basename(fl)) + + # Copy the files + for f in files2copy: + srcf = os.path.join(src, f) + dstf = os.path.join(dst, f) + + # Check to see if dstf is going into a subfolder, and create that + # subfolder if it doesn't exist + sf = os.path.dirname(dstf) + if not os.path.isdir(sf): + os.makedirs(sf) + + # Now copy the file + if os.path.exists(srcf): + print(f"Copying file '{srcf}' -> '{dstf}'") + shutil.copy(srcf, dstf) + else: + print(f"{srcf} does not exist") + + +def setup_mf6( + src, dst, mfnamefile="mfsim.nam", extrafiles=None, remove_existing=True +): + """ + Setup an MF6 simulation test, copying input files from the source + to the destination workspace. + + Parameters + ---------- + src : src + directory path with original MODFLOW 6 input files + dst : str + directory path that original MODFLOW 6 input files will be copied to + mfnamefile : str + optional MODFLOW 6 simulation name file (default is mfsim.nam) + extrafiles : bool + boolean indicating if extra files should be included (default is None) + remove_existing : bool + boolean indicating if existing file in dst should be removed (default + is True) Returns ------- - data : list - list of data in specified block + mf6inp : list + list of MODFLOW 6 input files + mf6outp : list + list of MODFLOW 6 output files """ - data = [] - # find beginning of block - for line in f: - if line[0] != "#": - t = line.split() - if t[0].lower() == "begin" and t[1].lower() == blockstr.lower(): + # Create the destination folder + create_dir = False + if os.path.exists(dst): + if remove_existing: + print(f"Removing {dst}") + shutil.rmtree(dst) + create_dir = True + else: + create_dir = True + if create_dir: + os.makedirs(dst) + + # Make list of files to copy + fname = os.path.join(src, mfnamefile) + fname = os.path.abspath(fname) + mf6inp, mf6outp = get_mf6_files(fname) + files2copy = [mfnamefile] + mf6inp + + # determine if there are any .ex files + exinp = [] + for f in mf6outp: + ext = os.path.splitext(f)[1] + if ext.lower() == ".hds": + pth = os.path.join(src, f + ".ex") + if os.path.isfile(pth): + exinp.append(f + ".ex") + if len(exinp) > 0: + files2copy += exinp + if extrafiles is not None: + files2copy += extrafiles + + # Copy the files + for f in files2copy: + srcf = os.path.join(src, f) + dstf = os.path.join(dst, f) + + # Check to see if dstf is going into a subfolder, and create that + # subfolder if it doesn't exist + sf = os.path.dirname(dstf) + if not os.path.isdir(sf): + try: + os.mkdir(sf) + except: + print(f"Could not create directory '{sf}") + + # Now copy the file + if os.path.exists(srcf): + print(f"Copying file '{srcf}' -> '{dstf}'") + shutil.copy(srcf, dstf) + else: + print(f"{srcf} does not exist") + + return mf6inp, mf6outp + + +def setup_mf6_comparison( + src, dst, cmp_exe="mf6", overwrite=True, verbose=False +): + """Setup an output comparison for MODFLOW 6 simulation. + + Parameters + ---------- + src : path-like + Directory with original MODFLOW 6 input files. + dst : path-like + Directory to copy MODFLOW 6 input files to. + cmp_exe : str or PathLike, optional + Program to compare with, for supported see `COMPARE_PROGRAMSa. + overwrite : bool, optional + Whether to overwrite the destination directory if it exists (default is True). + verbose : bool, optional + Whether to show verbose output + + Returns + ------- + action : str + comparison type (also the name of the comparison subdirectory in dst) + + """ + + if cmp_exe is None: + warn(f"No action provided, aborting") + return + + # create and/or clean dest dir if needed + dst = Path(dst) / cmp_exe + dst.mkdir(exist_ok=True) + dls = list(os.walk(dst)) + if overwrite and any(dls): + if verbose: + print(f"Cleaning directory '{dst}'") + for root, dirs, files in dls: + for f in files: + tpth = os.path.join(root, f) + if verbose: + print("Removing file '{tpth}'") + os.remove(tpth) + for d in dirs: + tdir = os.path.join(root, d) + if verbose: + print("Removing directory '{tdir}'") + shutil.rmtree(tdir) + else: + raise ValueError(f"Destination exists but overwrite disabled: {dst}") + + # copy files + cmppth = os.path.join(src, cmp_exe) + files = os.listdir(cmppth) + files2copy = [] + if "mf6" in cmp_exe.lower(): + for file in files: + if "mfsim.nam" in file.lower(): + srcf = os.path.join(cmppth, os.path.basename(file)) + files2copy.append(srcf) + srcdir = os.path.join(src, cmp_exe) + setup_mf6(srcdir, dst, remove_existing=overwrite) break - for line in f: - if line[0] != "#": - t = line.split() - if t[0].lower() == "end" and t[1].lower() == blockstr.lower(): + else: + for file in files: + if ".nam" in os.path.splitext(file)[1].lower(): + srcf = os.path.join(cmppth, os.path.basename(file)) + files2copy.append(srcf) + nf = os.path.join(src, cmp_exe, os.path.basename(file)) + setup_model(nf, dst, remove_existing=overwrite) break - else: - data.append(line.rstrip()) - return data diff --git a/autotest/conftest.py b/autotest/conftest.py index 5f0073b18c2..f278abff0bb 100644 --- a/autotest/conftest.py +++ b/autotest/conftest.py @@ -1,51 +1,93 @@ -import platform +import sys from pathlib import Path +from typing import Dict +from warnings import warn import pytest -from modflow_devtools.executables import Executables, build_default_exe_dict +from modflow_devtools.ostags import get_binary_suffixes pytest_plugins = ["modflow_devtools.fixtures"] project_root_path = Path(__file__).resolve().parent.parent -def should_compare( - test: str, comparisons: dict, executables: Executables -) -> bool: - if test in comparisons.keys(): - dev_ver = Executables.get_version(path=executables.mf6).split(" ")[0] - reg_ver = Executables.get_version( - path=executables.mf6_regression - ).split(" ")[0] - print(f"MODFLOW 6 development version: {dev_ver}") - print(f"MODFLOW 6 regression version: {reg_ver}") - excluded = list(comparisons[test]) - if reg_ver in excluded: - print( - f"Regression version {reg_ver} not supported for test {test}, skipping comparison" - ) - return False - return True +_exe_ext, _lib_ext = get_binary_suffixes(sys.platform) +_binaries_path = project_root_path / "bin" +_dl_bin_path = _binaries_path / "downloaded" +_rb_bin_path = _binaries_path / "rebuilt" +_binaries = { + "development": [ + ("mf6", _binaries_path / f"mf6{_exe_ext}"), + ("libmf6", _binaries_path / f"libmf6{_lib_ext}"), + ("mf5to6", _binaries_path / f"mf5to6{_exe_ext}"), + ("zbud6", _binaries_path / f"zbud6{_exe_ext}"), + ], + "downloaded": [ + ("mf2000", _dl_bin_path / f"mf2000{_exe_ext}"), + ("mf2005", _dl_bin_path / f"mf2005dbl{_exe_ext}"), + ("mfnwt", _dl_bin_path / f"mfnwtdbl{_exe_ext}"), + ("mfusg", _dl_bin_path / f"mfusgdbl{_exe_ext}"), + ("mflgr", _dl_bin_path / f"mflgrdbl{_exe_ext}"), + ("mf2005s", _dl_bin_path / f"mf2005{_exe_ext}"), + ("mt3dms", _dl_bin_path / f"mt3dms{_exe_ext}"), + ("crt", _dl_bin_path / f"crt{_exe_ext}"), + ("gridgen", _dl_bin_path / f"gridgen{_exe_ext}"), + ("mp6", _dl_bin_path / f"mp6{_exe_ext}"), + ("mp7", _dl_bin_path / f"mp7{_exe_ext}"), + ("swtv4", _dl_bin_path / f"swtv4{_exe_ext}"), + ("sutra", _dl_bin_path / f"sutra{_exe_ext}"), + ("triangle", _dl_bin_path / f"triangle{_exe_ext}"), + ("vs2dt", _dl_bin_path / f"vs2dt{_exe_ext}"), + ("zonbudusg", _dl_bin_path / f"zonbudusg{_exe_ext}"), + ], + "rebuilt": [ + ("mf6_regression", _rb_bin_path / f"mf6{_exe_ext}"), + ("libmf6_regression", _rb_bin_path / f"libmf6{_lib_ext}"), + ("mf5to6_regression", _rb_bin_path / f"mf5to6{_exe_ext}"), + ("zbud6_regression", _rb_bin_path / f"zbud6{_exe_ext}"), + ], +} @pytest.fixture(scope="session") def bin_path() -> Path: - return project_root_path / "bin" + return _binaries_path @pytest.fixture(scope="session") -def libmf6_path(bin_path) -> Path: - ext = { - "Darwin": ".dylib", - "Linux": ".so", - "Windows": ".dll", - }[platform.system()] - lib_name = bin_path / f"libmf6{ext}" - return lib_name - - -@pytest.fixture(scope="session") -def targets(bin_path) -> Executables: - return Executables(**build_default_exe_dict(bin_path)) +def targets() -> Dict[str, Path]: + """ + Target executables for tests. These include local development builds as + well as binaries 1) downloaded from GitHub and 2) rebuilt from the last + official release. + """ + + d = dict() + for k, v in _binaries["development"]: + # require development binaries + assert v.is_file(), f"Couldn't find binary '{k}' expected at: {v}" + d[k] = v + for k, v in _binaries["downloaded"] + _binaries["rebuilt"]: + # downloaded/rebuilt binaries are optional + if v.is_file(): + d[k] = v + else: + warn(f"Couldn't find binary '{k}' expected at: {v}") + return d + + +def try_get_target(targets: Dict[str, Path], name: str) -> Path: + """Try to retrieve the path to a binary. If the binary is a development + target and can't be found, an error is raised. Otherwise (if the binary + is downloaded or rebuilt) the test is skipped. This is to allow testing + without downloaded or rebuilt binaries, e.g. if the network is down.""" + + exe = targets.get(name) + if exe: + return exe + elif name in _binaries["development"]: + raise ValueError(f"Couldn't find binary '{name}'") + else: + pytest.skip(f"Couldn't find binary '{name}'") @pytest.fixture @@ -55,7 +97,7 @@ def original_regression(request) -> bool: @pytest.fixture(scope="session") def markers(pytestconfig) -> str: - return pytestconfig.getoption('-m') + return pytestconfig.getoption("-m") def pytest_addoption(parser): @@ -63,13 +105,13 @@ def pytest_addoption(parser): "--original-regression", action="store_true", default=False, - help="TODO", + help="use non-MF6 models for regression tests", ) parser.addoption( - "--parallel", - action="store_true", - default=False, - help="include parallel test cases" + "--parallel", + action="store_true", + default=False, + help="include parallel test cases", ) diff --git a/autotest/cross_section_functions.py b/autotest/cross_section_functions.py index 1b22e137e0d..9bfda231dcd 100644 --- a/autotest/cross_section_functions.py +++ b/autotest/cross_section_functions.py @@ -12,7 +12,7 @@ def calculate_rectchan_mannings_discharge( """ area = width * depth - return conversion_factor * area * depth ** mpow * slope ** 0.5 / roughness + return conversion_factor * area * depth**mpow * slope**0.5 / roughness # n-point cross-section functions @@ -82,7 +82,7 @@ def get_wetted_perimeter( else: dlen = 0.0 - return np.sqrt(xlen ** 2.0 + dlen ** 2.0) + return np.sqrt(xlen**2.0 + dlen**2.0) def get_wetted_area(x0, x1, h0, h1, depth): @@ -257,7 +257,7 @@ def manningsq( if perimeter > 0.0: radius = area / perimeter q += ( - conv * area * radius ** mpow * slope ** 0.5 / roughness[i0] + conv * area * radius**mpow * slope**0.5 / roughness[i0] ) else: perimeter = wetted_perimeter(x, h, depth) @@ -265,7 +265,7 @@ def manningsq( radius = 0.0 if perimeter > 0.0: radius = area / perimeter - q = conv * area * radius ** mpow * slope ** 0.5 / roughness[0] + q = conv * area * radius**mpow * slope**0.5 / roughness[0] return q diff --git a/autotest/data/ex-gwf-bump/bottom.txt b/autotest/data/ex-gwf-bump/bottom.txt new file mode 100644 index 00000000000..fc7264d51e2 --- /dev/null +++ b/autotest/data/ex-gwf-bump/bottom.txt @@ -0,0 +1,52 @@ + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 7.145278E-02 1.258685E-01 1.649210E-01 1.884270E-01 1.962749E-01 1.884270E-01 1.649210E-01 1.258685E-01 7.145278E-02 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.920820E-02 1.962749E-01 2.988742E-01 3.865433E-01 4.588710E-01 5.155069E-01 5.561688E-01 5.806502E-01 5.888247E-01 5.806502E-01 5.561688E-01 5.155069E-01 4.588710E-01 3.865433E-01 2.988742E-01 1.962749E-01 7.920820E-02 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 1.649210E-01 3.147551E-01 4.508076E-01 5.724826E-01 6.792177E-01 7.704949E-01 8.458526E-01 9.048952E-01 9.473040E-01 9.728448E-01 9.813745E-01 9.728448E-01 9.473040E-01 9.048952E-01 8.458526E-01 7.704949E-01 6.792177E-01 5.724826E-01 4.508076E-01 3.147551E-01 1.649210E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.727501E-01 3.545715E-01 5.236254E-01 6.792177E-01 8.206647E-01 9.473040E-01 1.058507E+00 1.153693E+00 1.232340E+00 1.294000E+00 1.338311E+00 1.365007E+00 1.373924E+00 1.365007E+00 1.338311E+00 1.294000E+00 1.232340E+00 1.153693E+00 1.058507E+00 9.473040E-01 8.206647E-01 6.792177E-01 5.236254E-01 3.545715E-01 1.727501E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.025109E-01 3.147551E-01 5.155069E-01 7.040227E-01 8.795444E-01 1.041309E+00 1.188560E+00 1.320560E+00 1.436603E+00 1.536034E+00 1.618264E+00 1.682781E+00 1.729173E+00 1.757133E+00 1.766474E+00 1.757133E+00 1.729173E+00 1.682781E+00 1.618264E+00 1.536034E+00 1.436603E+00 1.320560E+00 1.188560E+00 1.041309E+00 8.795444E-01 7.040227E-01 5.155069E-01 3.147551E-01 1.025109E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.962749E-01 4.266580E-01 6.462466E-01 8.542639E-01 1.049904E+00 1.232340E+00 1.400731E+00 1.554238E+00 1.692039E+00 1.813339E+00 1.917398E+00 2.003544E+00 2.071192E+00 2.119867E+00 2.149216E+00 2.159024E+00 2.149216E+00 2.119867E+00 2.071192E+00 2.003544E+00 1.917398E+00 1.813339E+00 1.692039E+00 1.554238E+00 1.400731E+00 1.232340E+00 1.049904E+00 8.542639E-01 6.462466E-01 4.266580E-01 1.962749E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 2.592852E-01 5.073954E-01 7.455119E-01 9.728448E-01 1.188560E+00 1.391786E+00 1.581618E+00 1.757133E+00 1.917398E+00 2.061492E+00 2.188521E+00 2.297640E+00 2.388082E+00 2.459174E+00 2.510366E+00 2.541251E+00 2.551574E+00 2.541251E+00 2.510366E+00 2.459174E+00 2.388082E+00 2.297640E+00 2.188521E+00 2.061492E+00 1.917398E+00 1.757133E+00 1.581618E+00 1.391786E+00 1.188560E+00 9.728448E-01 7.455119E-01 5.073954E-01 2.592852E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.733338E-02 2.909435E-01 5.561688E-01 8.122841E-01 1.058507E+00 1.294000E+00 1.517869E+00 1.729173E+00 1.926925E+00 2.110108E+00 2.277686E+00 2.428624E+00 2.561911E+00 2.676584E+00 2.771759E+00 2.846658E+00 2.900641E+00 2.933228E+00 2.944124E+00 2.933228E+00 2.900641E+00 2.846658E+00 2.771759E+00 2.676584E+00 2.561911E+00 2.428624E+00 2.277686E+00 2.110108E+00 1.926925E+00 1.729173E+00 1.517869E+00 1.294000E+00 1.058507E+00 8.122841E-01 5.561688E-01 2.909435E-01 1.733338E-02 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 2.909435E-01 5.724826E-01 8.458526E-01 1.110300E+00 1.365007E+00 1.609087E+00 1.841588E+00 2.061492E+00 2.267728E+00 2.459174E+00 2.634679E+00 2.793080E+00 2.933228E+00 3.054020E+00 3.154432E+00 3.233560E+00 3.290650E+00 3.325138E+00 3.336673E+00 3.325138E+00 3.290650E+00 3.233560E+00 3.154432E+00 3.054020E+00 2.933228E+00 2.793080E+00 2.634679E+00 2.459174E+00 2.267728E+00 2.061492E+00 1.841588E+00 1.609087E+00 1.365007E+00 1.110300E+00 8.458526E-01 5.724826E-01 2.909435E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.592852E-01 5.561688E-01 8.458526E-01 1.127632E+00 1.400731E+00 1.664297E+00 1.917398E+00 2.159024E+00 2.388082E+00 2.603405E+00 2.803764E+00 2.987876E+00 3.154432E+00 3.302126E+00 3.429686E+00 3.535923E+00 3.619772E+00 3.680345E+00 3.716968E+00 3.729223E+00 3.716968E+00 3.680345E+00 3.619772E+00 3.535923E+00 3.429686E+00 3.302126E+00 3.154432E+00 2.987876E+00 2.803764E+00 2.603405E+00 2.388082E+00 2.159024E+00 1.917398E+00 1.664297E+00 1.400731E+00 1.127632E+00 8.458526E-01 5.561688E-01 2.592852E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.962749E-01 5.073954E-01 8.122841E-01 1.110300E+00 1.400731E+00 1.682781E+00 1.955571E+00 2.218129E+00 2.469384E+00 2.708172E+00 2.933228E+00 3.143203E+00 3.336673E+00 3.512165E+00 3.668184E+00 3.803263E+00 3.916008E+00 4.005163E+00 4.069664E+00 4.108703E+00 4.121773E+00 4.108703E+00 4.069664E+00 4.005163E+00 3.916008E+00 3.803263E+00 3.668184E+00 3.512165E+00 3.336673E+00 3.143203E+00 2.933228E+00 2.708172E+00 2.469384E+00 2.218129E+00 1.955571E+00 1.682781E+00 1.400731E+00 1.110300E+00 8.122841E-01 5.073954E-01 1.962749E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.025109E-01 4.266580E-01 7.455119E-01 1.058507E+00 1.365007E+00 1.664297E+00 1.955571E+00 2.237930E+00 2.510366E+00 2.771759E+00 3.020869E+00 3.256338E+00 3.476689E+00 3.680345E+00 3.865644E+00 4.030879E+00 4.174348E+00 4.294409E+00 4.389562E+00 4.458528E+00 4.500321E+00 4.514323E+00 4.500321E+00 4.458528E+00 4.389562E+00 4.294409E+00 4.174348E+00 4.030879E+00 3.865644E+00 3.680345E+00 3.476689E+00 3.256338E+00 3.020869E+00 2.771759E+00 2.510366E+00 2.237930E+00 1.955571E+00 1.664297E+00 1.365007E+00 1.058507E+00 7.455119E-01 4.266580E-01 1.025109E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 3.147551E-01 6.462466E-01 9.728448E-01 1.294000E+00 1.609087E+00 1.917398E+00 2.218129E+00 2.510366E+00 2.793080E+00 3.065105E+00 3.325138E+00 3.571724E+00 3.803263E+00 4.018007E+00 4.214092E+00 4.389562E+00 4.542434E+00 4.670765E+00 4.772752E+00 4.846834E+00 4.891797E+00 4.906873E+00 4.891797E+00 4.846834E+00 4.772752E+00 4.670765E+00 4.542434E+00 4.389562E+00 4.214092E+00 4.018007E+00 3.803263E+00 3.571724E+00 3.325138E+00 3.065105E+00 2.793080E+00 2.510366E+00 2.218129E+00 1.917398E+00 1.609087E+00 1.294000E+00 9.728448E-01 6.462466E-01 3.147551E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 1.727501E-01 5.155069E-01 8.542639E-01 1.188560E+00 1.517869E+00 1.841588E+00 2.159024E+00 2.469384E+00 2.771759E+00 3.065105E+00 3.348229E+00 3.619772E+00 3.878196E+00 4.121773E+00 4.348586E+00 4.556544E+00 4.743412E+00 4.906873E+00 5.044614E+00 5.154447E+00 5.234446E+00 5.283094E+00 5.299422E+00 5.283094E+00 5.234446E+00 5.154447E+00 5.044614E+00 4.906873E+00 4.743412E+00 4.556544E+00 4.348586E+00 4.121773E+00 3.878196E+00 3.619772E+00 3.348229E+00 3.065105E+00 2.771759E+00 2.469384E+00 2.159024E+00 1.841588E+00 1.517869E+00 1.188560E+00 8.542639E-01 5.155069E-01 1.727501E-01 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 1.924449E-03 3.545715E-01 7.040227E-01 1.049904E+00 1.391786E+00 1.729173E+00 2.061492E+00 2.388082E+00 2.708172E+00 3.020869E+00 3.325138E+00 3.619772E+00 3.903378E+00 4.174348E+00 4.430839E+00 4.670765E+00 4.891797E+00 5.091385E+00 5.266823E+00 5.415342E+00 5.534264E+00 5.621180E+00 5.674166E+00 5.691972E+00 5.674166E+00 5.621180E+00 5.534264E+00 5.415342E+00 5.266823E+00 5.091385E+00 4.891797E+00 4.670765E+00 4.430839E+00 4.174348E+00 3.903378E+00 3.619772E+00 3.325138E+00 3.020869E+00 2.708172E+00 2.388082E+00 2.061492E+00 1.729173E+00 1.391786E+00 1.049904E+00 7.040227E-01 3.545715E-01 1.924449E-03 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 1.649210E-01 5.236254E-01 8.795444E-01 1.232340E+00 1.581618E+00 1.926925E+00 2.267728E+00 2.603405E+00 2.933228E+00 3.256338E+00 3.571724E+00 3.878196E+00 4.174348E+00 4.458528E+00 4.728803E+00 4.982930E+00 5.218339E+00 5.432142E+00 5.621180E+00 5.782129E+00 5.911680E+00 6.006782E+00 6.064943E+00 6.084522E+00 6.064943E+00 6.006782E+00 5.911680E+00 5.782129E+00 5.621180E+00 5.432142E+00 5.218339E+00 4.982930E+00 4.728803E+00 4.458528E+00 4.174348E+00 3.878196E+00 3.571724E+00 3.256338E+00 2.933228E+00 2.603405E+00 2.267728E+00 1.926925E+00 1.581618E+00 1.232340E+00 8.795444E-01 5.236254E-01 1.649210E-01 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 3.147551E-01 6.792177E-01 1.041309E+00 1.400731E+00 1.757133E+00 2.110108E+00 2.459174E+00 2.803764E+00 3.143203E+00 3.476689E+00 3.803263E+00 4.121773E+00 4.430839E+00 4.728803E+00 5.013677E+00 5.283094E+00 5.534264E+00 5.763945E+00 5.968472E+00 6.143853E+00 6.285965E+00 6.390890E+00 6.455330E+00 6.477072E+00 6.455330E+00 6.390890E+00 6.285965E+00 6.143853E+00 5.968472E+00 5.763945E+00 5.534264E+00 5.283094E+00 5.013677E+00 4.728803E+00 4.430839E+00 4.121773E+00 3.803263E+00 3.476689E+00 3.143203E+00 2.803764E+00 2.459174E+00 2.110108E+00 1.757133E+00 1.400731E+00 1.041309E+00 6.792177E-01 3.147551E-01 0.000000E+00 0.000000E+00 + 0.000000E+00 7.920820E-02 4.508076E-01 8.206647E-01 1.188560E+00 1.554238E+00 1.917398E+00 2.277686E+00 2.634679E+00 2.987876E+00 3.336673E+00 3.680345E+00 4.018007E+00 4.348586E+00 4.670765E+00 4.982930E+00 5.283094E+00 5.568826E+00 5.837158E+00 6.084522E+00 6.306713E+00 6.498948E+00 6.656073E+00 6.772972E+00 6.845182E+00 6.869622E+00 6.845182E+00 6.772972E+00 6.656073E+00 6.498948E+00 6.306713E+00 6.084522E+00 5.837158E+00 5.568826E+00 5.283094E+00 4.982930E+00 4.670765E+00 4.348586E+00 4.018007E+00 3.680345E+00 3.336673E+00 2.987876E+00 2.634679E+00 2.277686E+00 1.917398E+00 1.554238E+00 1.188560E+00 8.206647E-01 4.508076E-01 7.920820E-02 0.000000E+00 + 0.000000E+00 1.962749E-01 5.724826E-01 9.473040E-01 1.320560E+00 1.692039E+00 2.061492E+00 2.428624E+00 2.793080E+00 3.154432E+00 3.512165E+00 3.865644E+00 4.214092E+00 4.556544E+00 4.891797E+00 5.218339E+00 5.534264E+00 5.837158E+00 6.123975E+00 6.390890E+00 6.633179E+00 6.845182E+00 7.020450E+00 7.152215E+00 7.234274E+00 7.262171E+00 7.234274E+00 7.152215E+00 7.020450E+00 6.845182E+00 6.633179E+00 6.390890E+00 6.123975E+00 5.837158E+00 5.534264E+00 5.218339E+00 4.891797E+00 4.556544E+00 4.214092E+00 3.865644E+00 3.512165E+00 3.154432E+00 2.793080E+00 2.428624E+00 2.061492E+00 1.692039E+00 1.320560E+00 9.473040E-01 5.724826E-01 1.962749E-01 0.000000E+00 + 0.000000E+00 2.988742E-01 6.792177E-01 1.058507E+00 1.436603E+00 1.813339E+00 2.188521E+00 2.561911E+00 2.933228E+00 3.302126E+00 3.668184E+00 4.030879E+00 4.389562E+00 4.743412E+00 5.091385E+00 5.432142E+00 5.763945E+00 6.084522E+00 6.390890E+00 6.679124E+00 6.944108E+00 7.179303E+00 7.376716E+00 7.527317E+00 7.622233E+00 7.654721E+00 7.622233E+00 7.527317E+00 7.376716E+00 7.179303E+00 6.944108E+00 6.679124E+00 6.390890E+00 6.084522E+00 5.763945E+00 5.432142E+00 5.091385E+00 4.743412E+00 4.389562E+00 4.030879E+00 3.668184E+00 3.302126E+00 2.933228E+00 2.561911E+00 2.188521E+00 1.813339E+00 1.436603E+00 1.058507E+00 6.792177E-01 2.988742E-01 0.000000E+00 + 1.924449E-03 3.865433E-01 7.704949E-01 1.153693E+00 1.536034E+00 1.917398E+00 2.297640E+00 2.676584E+00 3.054020E+00 3.429686E+00 3.803263E+00 4.174348E+00 4.542434E+00 4.906873E+00 5.266823E+00 5.621180E+00 5.968472E+00 6.306713E+00 6.633179E+00 6.944108E+00 7.234274E+00 7.496475E+00 7.721081E+00 7.896075E+00 8.008401E+00 8.047271E+00 8.008401E+00 7.896075E+00 7.721081E+00 7.496475E+00 7.234274E+00 6.944108E+00 6.633179E+00 6.306713E+00 5.968472E+00 5.621180E+00 5.266823E+00 4.906873E+00 4.542434E+00 4.174348E+00 3.803263E+00 3.429686E+00 3.054020E+00 2.676584E+00 2.297640E+00 1.917398E+00 1.536034E+00 1.153693E+00 7.704949E-01 3.865433E-01 1.924449E-03 + 7.145278E-02 4.588710E-01 8.458526E-01 1.232340E+00 1.618264E+00 2.003544E+00 2.388082E+00 2.771759E+00 3.154432E+00 3.535923E+00 3.916008E+00 4.294409E+00 4.670765E+00 5.044614E+00 5.415342E+00 5.782129E+00 6.143853E+00 6.498948E+00 6.845182E+00 7.179303E+00 7.496475E+00 7.789423E+00 8.047271E+00 8.254484E+00 8.391496E+00 8.439821E+00 8.391496E+00 8.254484E+00 8.047271E+00 7.789423E+00 7.496475E+00 7.179303E+00 6.845182E+00 6.498948E+00 6.143853E+00 5.782129E+00 5.415342E+00 5.044614E+00 4.670765E+00 4.294409E+00 3.916008E+00 3.535923E+00 3.154432E+00 2.771759E+00 2.388082E+00 2.003544E+00 1.618264E+00 1.232340E+00 8.458526E-01 4.588710E-01 7.145278E-02 + 1.258685E-01 5.155069E-01 9.048952E-01 1.294000E+00 1.682781E+00 2.071192E+00 2.459174E+00 2.846658E+00 3.233560E+00 3.619772E+00 4.005163E+00 4.389562E+00 4.772752E+00 5.154447E+00 5.534264E+00 5.911680E+00 6.285965E+00 6.656073E+00 7.020450E+00 7.376716E+00 7.721081E+00 8.047271E+00 8.344572E+00 8.594662E+00 8.768668E+00 8.832371E+00 8.768668E+00 8.594662E+00 8.344572E+00 8.047271E+00 7.721081E+00 7.376716E+00 7.020450E+00 6.656073E+00 6.285965E+00 5.911680E+00 5.534264E+00 5.154447E+00 4.772752E+00 4.389562E+00 4.005163E+00 3.619772E+00 3.233560E+00 2.846658E+00 2.459174E+00 2.071192E+00 1.682781E+00 1.294000E+00 9.048952E-01 5.155069E-01 1.258685E-01 + 1.649210E-01 5.561688E-01 9.473040E-01 1.338311E+00 1.729173E+00 2.119867E+00 2.510366E+00 2.900641E+00 3.290650E+00 3.680345E+00 4.069664E+00 4.458528E+00 4.846834E+00 5.234446E+00 5.621180E+00 6.006782E+00 6.390890E+00 6.772972E+00 7.152215E+00 7.527317E+00 7.896075E+00 8.254484E+00 8.594662E+00 8.899721E+00 9.132252E+00 9.224920E+00 9.132252E+00 8.899721E+00 8.594662E+00 8.254484E+00 7.896075E+00 7.527317E+00 7.152215E+00 6.772972E+00 6.390890E+00 6.006782E+00 5.621180E+00 5.234446E+00 4.846834E+00 4.458528E+00 4.069664E+00 3.680345E+00 3.290650E+00 2.900641E+00 2.510366E+00 2.119867E+00 1.729173E+00 1.338311E+00 9.473040E-01 5.561688E-01 1.649210E-01 + 1.884270E-01 5.806502E-01 9.728448E-01 1.365007E+00 1.757133E+00 2.149216E+00 2.541251E+00 2.933228E+00 3.325138E+00 3.716968E+00 4.108703E+00 4.500321E+00 4.891797E+00 5.283094E+00 5.674166E+00 6.064943E+00 6.455330E+00 6.845182E+00 7.234274E+00 7.622233E+00 8.008401E+00 8.391496E+00 8.768668E+00 9.132252E+00 9.454871E+00 9.617470E+00 9.454871E+00 9.132252E+00 8.768668E+00 8.391496E+00 8.008401E+00 7.622233E+00 7.234274E+00 6.845182E+00 6.455330E+00 6.064943E+00 5.674166E+00 5.283094E+00 4.891797E+00 4.500321E+00 4.108703E+00 3.716968E+00 3.325138E+00 2.933228E+00 2.541251E+00 2.149216E+00 1.757133E+00 1.365007E+00 9.728448E-01 5.806502E-01 1.884270E-01 + 1.962749E-01 5.888247E-01 9.813745E-01 1.373924E+00 1.766474E+00 2.159024E+00 2.551574E+00 2.944124E+00 3.336673E+00 3.729223E+00 4.121773E+00 4.514323E+00 4.906873E+00 5.299422E+00 5.691972E+00 6.084522E+00 6.477072E+00 6.869622E+00 7.262171E+00 7.654721E+00 8.047271E+00 8.439821E+00 8.832371E+00 9.224920E+00 9.617470E+00 9.990000E+00 9.617470E+00 9.224920E+00 8.832371E+00 8.439821E+00 8.047271E+00 7.654721E+00 7.262171E+00 6.869622E+00 6.477072E+00 6.084522E+00 5.691972E+00 5.299422E+00 4.906873E+00 4.514323E+00 4.121773E+00 3.729223E+00 3.336673E+00 2.944124E+00 2.551574E+00 2.159024E+00 1.766474E+00 1.373924E+00 9.813745E-01 5.888247E-01 1.962749E-01 + 1.884270E-01 5.806502E-01 9.728448E-01 1.365007E+00 1.757133E+00 2.149216E+00 2.541251E+00 2.933228E+00 3.325138E+00 3.716968E+00 4.108703E+00 4.500321E+00 4.891797E+00 5.283094E+00 5.674166E+00 6.064943E+00 6.455330E+00 6.845182E+00 7.234274E+00 7.622233E+00 8.008401E+00 8.391496E+00 8.768668E+00 9.132252E+00 9.454871E+00 9.617470E+00 9.454871E+00 9.132252E+00 8.768668E+00 8.391496E+00 8.008401E+00 7.622233E+00 7.234274E+00 6.845182E+00 6.455330E+00 6.064943E+00 5.674166E+00 5.283094E+00 4.891797E+00 4.500321E+00 4.108703E+00 3.716968E+00 3.325138E+00 2.933228E+00 2.541251E+00 2.149216E+00 1.757133E+00 1.365007E+00 9.728448E-01 5.806502E-01 1.884270E-01 + 1.649210E-01 5.561688E-01 9.473040E-01 1.338311E+00 1.729173E+00 2.119867E+00 2.510366E+00 2.900641E+00 3.290650E+00 3.680345E+00 4.069664E+00 4.458528E+00 4.846834E+00 5.234446E+00 5.621180E+00 6.006782E+00 6.390890E+00 6.772972E+00 7.152215E+00 7.527317E+00 7.896075E+00 8.254484E+00 8.594662E+00 8.899721E+00 9.132252E+00 9.224920E+00 9.132252E+00 8.899721E+00 8.594662E+00 8.254484E+00 7.896075E+00 7.527317E+00 7.152215E+00 6.772972E+00 6.390890E+00 6.006782E+00 5.621180E+00 5.234446E+00 4.846834E+00 4.458528E+00 4.069664E+00 3.680345E+00 3.290650E+00 2.900641E+00 2.510366E+00 2.119867E+00 1.729173E+00 1.338311E+00 9.473040E-01 5.561688E-01 1.649210E-01 + 1.258685E-01 5.155069E-01 9.048952E-01 1.294000E+00 1.682781E+00 2.071192E+00 2.459174E+00 2.846658E+00 3.233560E+00 3.619772E+00 4.005163E+00 4.389562E+00 4.772752E+00 5.154447E+00 5.534264E+00 5.911680E+00 6.285965E+00 6.656073E+00 7.020450E+00 7.376716E+00 7.721081E+00 8.047271E+00 8.344572E+00 8.594662E+00 8.768668E+00 8.832371E+00 8.768668E+00 8.594662E+00 8.344572E+00 8.047271E+00 7.721081E+00 7.376716E+00 7.020450E+00 6.656073E+00 6.285965E+00 5.911680E+00 5.534264E+00 5.154447E+00 4.772752E+00 4.389562E+00 4.005163E+00 3.619772E+00 3.233560E+00 2.846658E+00 2.459174E+00 2.071192E+00 1.682781E+00 1.294000E+00 9.048952E-01 5.155069E-01 1.258685E-01 + 7.145278E-02 4.588710E-01 8.458526E-01 1.232340E+00 1.618264E+00 2.003544E+00 2.388082E+00 2.771759E+00 3.154432E+00 3.535923E+00 3.916008E+00 4.294409E+00 4.670765E+00 5.044614E+00 5.415342E+00 5.782129E+00 6.143853E+00 6.498948E+00 6.845182E+00 7.179303E+00 7.496475E+00 7.789423E+00 8.047271E+00 8.254484E+00 8.391496E+00 8.439821E+00 8.391496E+00 8.254484E+00 8.047271E+00 7.789423E+00 7.496475E+00 7.179303E+00 6.845182E+00 6.498948E+00 6.143853E+00 5.782129E+00 5.415342E+00 5.044614E+00 4.670765E+00 4.294409E+00 3.916008E+00 3.535923E+00 3.154432E+00 2.771759E+00 2.388082E+00 2.003544E+00 1.618264E+00 1.232340E+00 8.458526E-01 4.588710E-01 7.145278E-02 + 1.924449E-03 3.865433E-01 7.704949E-01 1.153693E+00 1.536034E+00 1.917398E+00 2.297640E+00 2.676584E+00 3.054020E+00 3.429686E+00 3.803263E+00 4.174348E+00 4.542434E+00 4.906873E+00 5.266823E+00 5.621180E+00 5.968472E+00 6.306713E+00 6.633179E+00 6.944108E+00 7.234274E+00 7.496475E+00 7.721081E+00 7.896075E+00 8.008401E+00 8.047271E+00 8.008401E+00 7.896075E+00 7.721081E+00 7.496475E+00 7.234274E+00 6.944108E+00 6.633179E+00 6.306713E+00 5.968472E+00 5.621180E+00 5.266823E+00 4.906873E+00 4.542434E+00 4.174348E+00 3.803263E+00 3.429686E+00 3.054020E+00 2.676584E+00 2.297640E+00 1.917398E+00 1.536034E+00 1.153693E+00 7.704949E-01 3.865433E-01 1.924449E-03 + 0.000000E+00 2.988742E-01 6.792177E-01 1.058507E+00 1.436603E+00 1.813339E+00 2.188521E+00 2.561911E+00 2.933228E+00 3.302126E+00 3.668184E+00 4.030879E+00 4.389562E+00 4.743412E+00 5.091385E+00 5.432142E+00 5.763945E+00 6.084522E+00 6.390890E+00 6.679124E+00 6.944108E+00 7.179303E+00 7.376716E+00 7.527317E+00 7.622233E+00 7.654721E+00 7.622233E+00 7.527317E+00 7.376716E+00 7.179303E+00 6.944108E+00 6.679124E+00 6.390890E+00 6.084522E+00 5.763945E+00 5.432142E+00 5.091385E+00 4.743412E+00 4.389562E+00 4.030879E+00 3.668184E+00 3.302126E+00 2.933228E+00 2.561911E+00 2.188521E+00 1.813339E+00 1.436603E+00 1.058507E+00 6.792177E-01 2.988742E-01 0.000000E+00 + 0.000000E+00 1.962749E-01 5.724826E-01 9.473040E-01 1.320560E+00 1.692039E+00 2.061492E+00 2.428624E+00 2.793080E+00 3.154432E+00 3.512165E+00 3.865644E+00 4.214092E+00 4.556544E+00 4.891797E+00 5.218339E+00 5.534264E+00 5.837158E+00 6.123975E+00 6.390890E+00 6.633179E+00 6.845182E+00 7.020450E+00 7.152215E+00 7.234274E+00 7.262171E+00 7.234274E+00 7.152215E+00 7.020450E+00 6.845182E+00 6.633179E+00 6.390890E+00 6.123975E+00 5.837158E+00 5.534264E+00 5.218339E+00 4.891797E+00 4.556544E+00 4.214092E+00 3.865644E+00 3.512165E+00 3.154432E+00 2.793080E+00 2.428624E+00 2.061492E+00 1.692039E+00 1.320560E+00 9.473040E-01 5.724826E-01 1.962749E-01 0.000000E+00 + 0.000000E+00 7.920820E-02 4.508076E-01 8.206647E-01 1.188560E+00 1.554238E+00 1.917398E+00 2.277686E+00 2.634679E+00 2.987876E+00 3.336673E+00 3.680345E+00 4.018007E+00 4.348586E+00 4.670765E+00 4.982930E+00 5.283094E+00 5.568826E+00 5.837158E+00 6.084522E+00 6.306713E+00 6.498948E+00 6.656073E+00 6.772972E+00 6.845182E+00 6.869622E+00 6.845182E+00 6.772972E+00 6.656073E+00 6.498948E+00 6.306713E+00 6.084522E+00 5.837158E+00 5.568826E+00 5.283094E+00 4.982930E+00 4.670765E+00 4.348586E+00 4.018007E+00 3.680345E+00 3.336673E+00 2.987876E+00 2.634679E+00 2.277686E+00 1.917398E+00 1.554238E+00 1.188560E+00 8.206647E-01 4.508076E-01 7.920820E-02 0.000000E+00 + 0.000000E+00 0.000000E+00 3.147551E-01 6.792177E-01 1.041309E+00 1.400731E+00 1.757133E+00 2.110108E+00 2.459174E+00 2.803764E+00 3.143203E+00 3.476689E+00 3.803263E+00 4.121773E+00 4.430839E+00 4.728803E+00 5.013677E+00 5.283094E+00 5.534264E+00 5.763945E+00 5.968472E+00 6.143853E+00 6.285965E+00 6.390890E+00 6.455330E+00 6.477072E+00 6.455330E+00 6.390890E+00 6.285965E+00 6.143853E+00 5.968472E+00 5.763945E+00 5.534264E+00 5.283094E+00 5.013677E+00 4.728803E+00 4.430839E+00 4.121773E+00 3.803263E+00 3.476689E+00 3.143203E+00 2.803764E+00 2.459174E+00 2.110108E+00 1.757133E+00 1.400731E+00 1.041309E+00 6.792177E-01 3.147551E-01 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 1.649210E-01 5.236254E-01 8.795444E-01 1.232340E+00 1.581618E+00 1.926925E+00 2.267728E+00 2.603405E+00 2.933228E+00 3.256338E+00 3.571724E+00 3.878196E+00 4.174348E+00 4.458528E+00 4.728803E+00 4.982930E+00 5.218339E+00 5.432142E+00 5.621180E+00 5.782129E+00 5.911680E+00 6.006782E+00 6.064943E+00 6.084522E+00 6.064943E+00 6.006782E+00 5.911680E+00 5.782129E+00 5.621180E+00 5.432142E+00 5.218339E+00 4.982930E+00 4.728803E+00 4.458528E+00 4.174348E+00 3.878196E+00 3.571724E+00 3.256338E+00 2.933228E+00 2.603405E+00 2.267728E+00 1.926925E+00 1.581618E+00 1.232340E+00 8.795444E-01 5.236254E-01 1.649210E-01 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 1.924449E-03 3.545715E-01 7.040227E-01 1.049904E+00 1.391786E+00 1.729173E+00 2.061492E+00 2.388082E+00 2.708172E+00 3.020869E+00 3.325138E+00 3.619772E+00 3.903378E+00 4.174348E+00 4.430839E+00 4.670765E+00 4.891797E+00 5.091385E+00 5.266823E+00 5.415342E+00 5.534264E+00 5.621180E+00 5.674166E+00 5.691972E+00 5.674166E+00 5.621180E+00 5.534264E+00 5.415342E+00 5.266823E+00 5.091385E+00 4.891797E+00 4.670765E+00 4.430839E+00 4.174348E+00 3.903378E+00 3.619772E+00 3.325138E+00 3.020869E+00 2.708172E+00 2.388082E+00 2.061492E+00 1.729173E+00 1.391786E+00 1.049904E+00 7.040227E-01 3.545715E-01 1.924449E-03 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 1.727501E-01 5.155069E-01 8.542639E-01 1.188560E+00 1.517869E+00 1.841588E+00 2.159024E+00 2.469384E+00 2.771759E+00 3.065105E+00 3.348229E+00 3.619772E+00 3.878196E+00 4.121773E+00 4.348586E+00 4.556544E+00 4.743412E+00 4.906873E+00 5.044614E+00 5.154447E+00 5.234446E+00 5.283094E+00 5.299422E+00 5.283094E+00 5.234446E+00 5.154447E+00 5.044614E+00 4.906873E+00 4.743412E+00 4.556544E+00 4.348586E+00 4.121773E+00 3.878196E+00 3.619772E+00 3.348229E+00 3.065105E+00 2.771759E+00 2.469384E+00 2.159024E+00 1.841588E+00 1.517869E+00 1.188560E+00 8.542639E-01 5.155069E-01 1.727501E-01 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 3.147551E-01 6.462466E-01 9.728448E-01 1.294000E+00 1.609087E+00 1.917398E+00 2.218129E+00 2.510366E+00 2.793080E+00 3.065105E+00 3.325138E+00 3.571724E+00 3.803263E+00 4.018007E+00 4.214092E+00 4.389562E+00 4.542434E+00 4.670765E+00 4.772752E+00 4.846834E+00 4.891797E+00 4.906873E+00 4.891797E+00 4.846834E+00 4.772752E+00 4.670765E+00 4.542434E+00 4.389562E+00 4.214092E+00 4.018007E+00 3.803263E+00 3.571724E+00 3.325138E+00 3.065105E+00 2.793080E+00 2.510366E+00 2.218129E+00 1.917398E+00 1.609087E+00 1.294000E+00 9.728448E-01 6.462466E-01 3.147551E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.025109E-01 4.266580E-01 7.455119E-01 1.058507E+00 1.365007E+00 1.664297E+00 1.955571E+00 2.237930E+00 2.510366E+00 2.771759E+00 3.020869E+00 3.256338E+00 3.476689E+00 3.680345E+00 3.865644E+00 4.030879E+00 4.174348E+00 4.294409E+00 4.389562E+00 4.458528E+00 4.500321E+00 4.514323E+00 4.500321E+00 4.458528E+00 4.389562E+00 4.294409E+00 4.174348E+00 4.030879E+00 3.865644E+00 3.680345E+00 3.476689E+00 3.256338E+00 3.020869E+00 2.771759E+00 2.510366E+00 2.237930E+00 1.955571E+00 1.664297E+00 1.365007E+00 1.058507E+00 7.455119E-01 4.266580E-01 1.025109E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.962749E-01 5.073954E-01 8.122841E-01 1.110300E+00 1.400731E+00 1.682781E+00 1.955571E+00 2.218129E+00 2.469384E+00 2.708172E+00 2.933228E+00 3.143203E+00 3.336673E+00 3.512165E+00 3.668184E+00 3.803263E+00 3.916008E+00 4.005163E+00 4.069664E+00 4.108703E+00 4.121773E+00 4.108703E+00 4.069664E+00 4.005163E+00 3.916008E+00 3.803263E+00 3.668184E+00 3.512165E+00 3.336673E+00 3.143203E+00 2.933228E+00 2.708172E+00 2.469384E+00 2.218129E+00 1.955571E+00 1.682781E+00 1.400731E+00 1.110300E+00 8.122841E-01 5.073954E-01 1.962749E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 2.592852E-01 5.561688E-01 8.458526E-01 1.127632E+00 1.400731E+00 1.664297E+00 1.917398E+00 2.159024E+00 2.388082E+00 2.603405E+00 2.803764E+00 2.987876E+00 3.154432E+00 3.302126E+00 3.429686E+00 3.535923E+00 3.619772E+00 3.680345E+00 3.716968E+00 3.729223E+00 3.716968E+00 3.680345E+00 3.619772E+00 3.535923E+00 3.429686E+00 3.302126E+00 3.154432E+00 2.987876E+00 2.803764E+00 2.603405E+00 2.388082E+00 2.159024E+00 1.917398E+00 1.664297E+00 1.400731E+00 1.127632E+00 8.458526E-01 5.561688E-01 2.592852E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 2.909435E-01 5.724826E-01 8.458526E-01 1.110300E+00 1.365007E+00 1.609087E+00 1.841588E+00 2.061492E+00 2.267728E+00 2.459174E+00 2.634679E+00 2.793080E+00 2.933228E+00 3.054020E+00 3.154432E+00 3.233560E+00 3.290650E+00 3.325138E+00 3.336673E+00 3.325138E+00 3.290650E+00 3.233560E+00 3.154432E+00 3.054020E+00 2.933228E+00 2.793080E+00 2.634679E+00 2.459174E+00 2.267728E+00 2.061492E+00 1.841588E+00 1.609087E+00 1.365007E+00 1.110300E+00 8.458526E-01 5.724826E-01 2.909435E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.733338E-02 2.909435E-01 5.561688E-01 8.122841E-01 1.058507E+00 1.294000E+00 1.517869E+00 1.729173E+00 1.926925E+00 2.110108E+00 2.277686E+00 2.428624E+00 2.561911E+00 2.676584E+00 2.771759E+00 2.846658E+00 2.900641E+00 2.933228E+00 2.944124E+00 2.933228E+00 2.900641E+00 2.846658E+00 2.771759E+00 2.676584E+00 2.561911E+00 2.428624E+00 2.277686E+00 2.110108E+00 1.926925E+00 1.729173E+00 1.517869E+00 1.294000E+00 1.058507E+00 8.122841E-01 5.561688E-01 2.909435E-01 1.733338E-02 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 2.592852E-01 5.073954E-01 7.455119E-01 9.728448E-01 1.188560E+00 1.391786E+00 1.581618E+00 1.757133E+00 1.917398E+00 2.061492E+00 2.188521E+00 2.297640E+00 2.388082E+00 2.459174E+00 2.510366E+00 2.541251E+00 2.551574E+00 2.541251E+00 2.510366E+00 2.459174E+00 2.388082E+00 2.297640E+00 2.188521E+00 2.061492E+00 1.917398E+00 1.757133E+00 1.581618E+00 1.391786E+00 1.188560E+00 9.728448E-01 7.455119E-01 5.073954E-01 2.592852E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.962749E-01 4.266580E-01 6.462466E-01 8.542639E-01 1.049904E+00 1.232340E+00 1.400731E+00 1.554238E+00 1.692039E+00 1.813339E+00 1.917398E+00 2.003544E+00 2.071192E+00 2.119867E+00 2.149216E+00 2.159024E+00 2.149216E+00 2.119867E+00 2.071192E+00 2.003544E+00 1.917398E+00 1.813339E+00 1.692039E+00 1.554238E+00 1.400731E+00 1.232340E+00 1.049904E+00 8.542639E-01 6.462466E-01 4.266580E-01 1.962749E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.025109E-01 3.147551E-01 5.155069E-01 7.040227E-01 8.795444E-01 1.041309E+00 1.188560E+00 1.320560E+00 1.436603E+00 1.536034E+00 1.618264E+00 1.682781E+00 1.729173E+00 1.757133E+00 1.766474E+00 1.757133E+00 1.729173E+00 1.682781E+00 1.618264E+00 1.536034E+00 1.436603E+00 1.320560E+00 1.188560E+00 1.041309E+00 8.795444E-01 7.040227E-01 5.155069E-01 3.147551E-01 1.025109E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.727501E-01 3.545715E-01 5.236254E-01 6.792177E-01 8.206647E-01 9.473040E-01 1.058507E+00 1.153693E+00 1.232340E+00 1.294000E+00 1.338311E+00 1.365007E+00 1.373924E+00 1.365007E+00 1.338311E+00 1.294000E+00 1.232340E+00 1.153693E+00 1.058507E+00 9.473040E-01 8.206647E-01 6.792177E-01 5.236254E-01 3.545715E-01 1.727501E-01 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 1.649210E-01 3.147551E-01 4.508076E-01 5.724826E-01 6.792177E-01 7.704949E-01 8.458526E-01 9.048952E-01 9.473040E-01 9.728448E-01 9.813745E-01 9.728448E-01 9.473040E-01 9.048952E-01 8.458526E-01 7.704949E-01 6.792177E-01 5.724826E-01 4.508076E-01 3.147551E-01 1.649210E-01 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.920820E-02 1.962749E-01 2.988742E-01 3.865433E-01 4.588710E-01 5.155069E-01 5.561688E-01 5.806502E-01 5.888247E-01 5.806502E-01 5.561688E-01 5.155069E-01 4.588710E-01 3.865433E-01 2.988742E-01 1.962749E-01 7.920820E-02 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.924449E-03 7.145278E-02 1.258685E-01 1.649210E-01 1.884270E-01 1.962749E-01 1.884270E-01 1.649210E-01 1.258685E-01 7.145278E-02 1.924449E-03 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 + diff --git a/autotest/data/ex-gwf-bump/results.hds.cmp b/autotest/data/ex-gwf-bump/results.hds.cmp new file mode 100644 index 00000000000..ec8e622f7ba Binary files /dev/null and b/autotest/data/ex-gwf-bump/results.hds.cmp differ diff --git a/autotest/data/prudic2004test2/sfr-packagedata.dat b/autotest/data/prudic2004test2/sfr-packagedata.dat index 7c6623704c5..ca8dff8916a 100644 --- a/autotest/data/prudic2004test2/sfr-packagedata.dat +++ b/autotest/data/prudic2004test2/sfr-packagedata.dat @@ -1,39 +1,39 @@ -#rno rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv - 0 400.0000 5.000000 0.1818182E-02 48.63636 1.000000 100.0000 0.3000000E-01 1 1.0000 0 - 1 200.0000 5.000000 0.1818182E-02 48.09091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 2 400.0000 5.000000 0.1818182E-02 47.54546 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 3 400.0000 5.000000 0.1818182E-02 46.81818 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 4 400.0000 5.000000 0.1818182E-02 46.09091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 5 400.0000 5.000000 0.1818182E-02 45.36364 1.000000 100.0000 0.3000000E-01 1 1.0000 0 - 6 400.0000 5.000000 0.2187500E-02 44.06250 1.000000 100.0000 0.3000000E-01 1 1.0000 0 - 7 400.0000 5.000000 0.2187500E-02 43.18750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 8 400.0000 5.000000 0.2187500E-02 42.31250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 9 400.0000 5.000000 0.2187500E-02 41.43750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 10 400.0000 5.000000 0.2187500E-02 40.56250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 11 400.0000 5.000000 0.2187500E-02 39.68750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 12 400.0000 5.000000 0.2187500E-02 38.81250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 13 400.0000 5.000000 0.2187500E-02 37.93750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 14 400.0000 5.000000 0.2187500E-02 37.06250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 15 400.0000 5.000000 0.2187500E-02 36.18750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 16 400.0000 5.000000 0.2187500E-02 35.31250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 17 400.0000 5.000000 0.2187500E-02 34.43750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 18 400.0000 5.000000 0.1704545E-02 41.15909 1.000000 100.0000 0.3000000E-01 1 1.0000 0 - 19 200.0000 5.000000 0.1704545E-02 40.64773 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 20 200.0000 5.000000 0.1704545E-02 40.30682 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 21 400.0000 5.000000 0.1704545E-02 39.79546 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 22 400.0000 5.000000 0.1704545E-02 39.11364 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 23 400.0000 5.000000 0.1704545E-02 38.43182 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 24 400.0000 5.000000 0.1704545E-02 37.75000 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 25 200.0000 5.000000 0.1704545E-02 37.23864 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 26 200.0000 5.000000 0.1704545E-02 36.89773 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 27 400.0000 5.000000 0.1704545E-02 36.38636 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 28 400.0000 5.000000 0.1704545E-02 35.70454 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 29 400.0000 5.000000 0.1704545E-02 35.02273 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 30 400.0000 5.000000 0.1704545E-02 34.34091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 31 400.0000 5.000000 0.2428571E-02 33.51429 1.000000 100.0000 0.3000000E-01 3 1.0000 0 - 32 400.0000 5.000000 0.2428571E-02 32.54286 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 33 400.0000 5.000000 0.2428571E-02 31.57143 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 34 400.0000 5.000000 0.2428571E-02 30.60000 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 35 400.0000 5.000000 0.2428571E-02 29.62857 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 36 400.0000 5.000000 0.2428571E-02 28.65714 1.000000 100.0000 0.3000000E-01 2 1.0000 0 - 37 400.0000 5.000000 0.2428571E-02 27.68571 1.000000 100.0000 0.3000000E-01 1 1.0000 0 +#ifno rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv + 0 400.0000 5.000000 0.1818182E-02 48.63636 1.000000 100.0000 0.3000000E-01 1 1.0000 0 + 1 200.0000 5.000000 0.1818182E-02 48.09091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 2 400.0000 5.000000 0.1818182E-02 47.54546 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 3 400.0000 5.000000 0.1818182E-02 46.81818 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 4 400.0000 5.000000 0.1818182E-02 46.09091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 5 400.0000 5.000000 0.1818182E-02 45.36364 1.000000 100.0000 0.3000000E-01 1 1.0000 0 + 6 400.0000 5.000000 0.2187500E-02 44.06250 1.000000 100.0000 0.3000000E-01 1 1.0000 0 + 7 400.0000 5.000000 0.2187500E-02 43.18750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 8 400.0000 5.000000 0.2187500E-02 42.31250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 9 400.0000 5.000000 0.2187500E-02 41.43750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 10 400.0000 5.000000 0.2187500E-02 40.56250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 11 400.0000 5.000000 0.2187500E-02 39.68750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 12 400.0000 5.000000 0.2187500E-02 38.81250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 13 400.0000 5.000000 0.2187500E-02 37.93750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 14 400.0000 5.000000 0.2187500E-02 37.06250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 15 400.0000 5.000000 0.2187500E-02 36.18750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 16 400.0000 5.000000 0.2187500E-02 35.31250 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 17 400.0000 5.000000 0.2187500E-02 34.43750 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 18 400.0000 5.000000 0.1704545E-02 41.15909 1.000000 100.0000 0.3000000E-01 1 1.0000 0 + 19 200.0000 5.000000 0.1704545E-02 40.64773 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 20 200.0000 5.000000 0.1704545E-02 40.30682 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 21 400.0000 5.000000 0.1704545E-02 39.79546 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 22 400.0000 5.000000 0.1704545E-02 39.11364 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 23 400.0000 5.000000 0.1704545E-02 38.43182 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 24 400.0000 5.000000 0.1704545E-02 37.75000 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 25 200.0000 5.000000 0.1704545E-02 37.23864 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 26 200.0000 5.000000 0.1704545E-02 36.89773 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 27 400.0000 5.000000 0.1704545E-02 36.38636 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 28 400.0000 5.000000 0.1704545E-02 35.70454 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 29 400.0000 5.000000 0.1704545E-02 35.02273 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 30 400.0000 5.000000 0.1704545E-02 34.34091 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 31 400.0000 5.000000 0.2428571E-02 33.51429 1.000000 100.0000 0.3000000E-01 3 1.0000 0 + 32 400.0000 5.000000 0.2428571E-02 32.54286 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 33 400.0000 5.000000 0.2428571E-02 31.57143 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 34 400.0000 5.000000 0.2428571E-02 30.60000 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 35 400.0000 5.000000 0.2428571E-02 29.62857 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 36 400.0000 5.000000 0.2428571E-02 28.65714 1.000000 100.0000 0.3000000E-01 2 1.0000 0 + 37 400.0000 5.000000 0.2428571E-02 27.68571 1.000000 100.0000 0.3000000E-01 1 1.0000 0 diff --git a/autotest/framework.py b/autotest/framework.py index 6e4e89c0832..8bfd0855169 100644 --- a/autotest/framework.py +++ b/autotest/framework.py @@ -1,53 +1,798 @@ +import os +import shutil +import time +from itertools import repeat +from pathlib import Path +from subprocess import PIPE, STDOUT, Popen +from traceback import format_exc +from typing import Callable, Dict, Iterable, List, Optional, Tuple, Union +from warnings import warn + import flopy +import numpy as np +from common_regression import ( + COMPARE_PROGRAMS, + adjust_htol, + get_mf6_comparison, + get_mf6_files, + get_namefiles, + get_rclose, + get_regression_files, + setup_mf6, + setup_mf6_comparison, +) +from flopy.mbase import BaseModel +from flopy.mf6 import MFSimulation +from flopy.utils.compare import compare_heads +from modflow_devtools.misc import get_ostag, is_in_ci + +DNODATA = 3.0e30 +EXTTEXT = { + "hds": "head", + "hed": "head", + "bhd": "head", + "ucn": "concentration", + "cbc": "cell-by-cell", +} +HDS_EXT = ( + "hds", + "hed", + "bhd", + "ahd", + "bin", +) +CBC_EXT = ( + "cbc", + "bud", +) + + +def api_return(success, model_ws) -> Tuple[bool, List[str]]: + """ + parse libmf6 stdout shared object file + """ + fpth = os.path.join(model_ws, "mfsim.stdout") + return success, open(fpth).readlines() + + +def get_mfsim_lst_tail(path: os.PathLike, lines=100) -> str: + """Get the tail of the mfsim.lst listing file""" + msg = "" + _lines = open(path).read().splitlines() + msg = "\n" + 79 * "-" + "\n" + i0 = -lines if len(_lines) > lines else 0 + for line in _lines[i0:]: + if len(line) > 0: + msg += f"{line}\n" + msg += 79 * "-" + "\n\n" + return msg + + +def get_workspace(sim_or_model) -> Path: + if isinstance(sim_or_model, MFSimulation): + return sim_or_model.sim_path + elif isinstance(sim_or_model, BaseModel): + return Path(sim_or_model.model_ws) + else: + raise ValueError(f"Unsupported model type: {type(sim_or_model)}") + + +def run_parallel(workspace, target, ncpus) -> Tuple[bool, List[str]]: + if not is_in_ci() and get_ostag() in ["mac"]: + oversubscribed = ["--hostfile", "localhost"] + with open(f"{workspace}/localhost", "w") as f: + f.write(f"localhost slots={ncpus}\n") + else: + oversubscribed = ["--oversubscribe"] + + normal_msg = "normal termination" + success = False + nr_success = 0 + buff = [] + + # parallel commands + mpiexec_cmd = ( + ["mpiexec"] + oversubscribed + ["-np", str(ncpus), target, "-p"] + ) + + proc = Popen(mpiexec_cmd, stdout=PIPE, stderr=STDOUT, cwd=workspace) + + while True: + line = proc.stdout.readline().decode("utf-8") + if line == "" and proc.poll() is not None: + break + if line: + # success is when the success message appears + # in every process of the parallel simulation + if normal_msg in line.lower(): + nr_success += 1 + if nr_success == ncpus: + success = True + line = line.rstrip("\r\n") + print(line) + buff.append(line) + else: + break + + return success, buff + + +def write_input(*sims, overwrite: bool = True, verbose: bool = True): + """ + Write input files for `flopy.mf6.MFSimulation` or `flopy.mbase.BaseModel`. + + Parameters + ---------- + + sims : arbitrary list + Simulations or models + verbose : bool, optional + whether to show verbose output + """ + + if sims is None: + warn("No simulations or models!") + return + + # write input files for each model or simulation + for sim in sims: + if sim is None: + continue + + if isinstance(sim, flopy.mf6.MFSimulation): + workspace = Path(sim.sim_path) + if any(workspace.glob("*")) and not overwrite: + warn(f"Workspace is not empty, not writing input files") + return + if verbose: + print( + f"Writing mf6 simulation '{sim.name}' to: {sim.sim_path}" + ) + sim.write_simulation() + elif isinstance(sim, flopy.mbase.BaseModel): + workspace = Path(sim.model_ws) + if any(workspace.glob("*")) and not overwrite: + warn(f"Workspace is not empty, not writing input files") + return + if verbose: + print( + f"Writing {type(sim)} model '{sim.name}' to: {sim.model_ws}" + ) + sim.write_input() + else: + raise ValueError(f"Unsupported simulation/model type: {type(sim)}") class TestFramework: - # tell pytest this isn't a test class, don't collect it + """ + Defines a MODFLOW 6 test and its lifecycle, with configurable + hooks to evaluate results or run other models for comparison: + + - MODFLOW 6 (directly or via API) + - MODFLOW-2005 + - MODFLOW-NWT + - MODFLOW-USG + - MODFLOW-LGR + + Parameters + ---------- + name : str + The test name + workspace : pathlike + The test workspace + targets : dict + Binary targets to test against. Development binaries are + required, downloads/rebuilt binaries are optional (if not + found, comparisons and regression tests will be skipped). + Dictionary maps target names to paths. The test framework + will refuse to run a program if it is not a known target. + build : function, optional + User defined function returning one or more simulations/models. + Takes `self` as input. This is the place to build simulations. + If no build function is provided, input files must be written + to the test `workspace` prior to calling `run()`. + check : function, optional + User defined function to evaluate results of the simulation. + Takes `self` as input. This is a good place for assertions. + parallel : bool, optional + Whether to test mf6 parallel capabilities. + ncpus : int, optional + Number of CPUs for mf6 parallel testing. + htol : float, optional + Tolerance for result comparisons. + rclose : float, optional + Residual tolerance for convergence + verbose: bool, optional + Whether to show verbose output + xfail : bool, optional + Whether the test is expected to fail + api_func: function, optional + User defined function invoking the MODFLOW API, accepting + the MF6 library path and the test workspace as parameters + compare: str, optional + String selecting the comparison executable. Must be a key + into the `targets` dictionary, i.e. the name of a program + to use for the comparison model. Acceptable values: auto, + mf6, mf6_regression, libmf6, mf2005, mfnwt, mflgr, mfnwt. + If 'auto', the program to use is determined automatically + by contents of the comparison model/simulation workspace. + """ + + # tell pytest this class doesn't contain tests, don't collect it __test__ = False - def build(self, build_function, idx, exdir): + def __init__( + self, + name: str, + workspace: Union[str, os.PathLike], + targets: Dict[str, Path], + api_func: Optional[Callable] = None, + build: Optional[Callable] = None, + check: Optional[Callable] = None, + compare: Optional[str] = "auto", + parallel=False, + ncpus=1, + htol=None, + rclose=None, + overwrite=True, + verbose=False, + xfail=False, + ): + # make sure workspace exists + workspace = Path(workspace).expanduser().absolute() + assert workspace.is_dir(), f"{workspace} is not a valid directory" + if verbose: + print("Initializing test", name, "in workspace", workspace) + + self.name = name + self.workspace = workspace + self.targets = targets + self.build = build + self.check = check + self.parallel = parallel + self.ncpus = [ncpus] if isinstance(ncpus, int) else ncpus + self.api_func = api_func + self.compare = compare + self.outp = None + self.htol = 0.001 if htol is None else htol + self.rclose = 0.001 if rclose is None else rclose + self.overwrite = overwrite + self.verbose = verbose + self.xfail = [xfail] if isinstance(xfail, bool) else xfail + + def __repr__(self): + return self.name + + # private + + def _compare_heads( + self, cpth=None, extensions="hds", mf6=False, htol=0.001 + ) -> bool: + if isinstance(extensions, str): + extensions = [extensions] + + if cpth: + files1 = [] + files2 = [] + exfiles = [] + for file1 in self.outp: + ext = os.path.splitext(file1)[1][1:] + if ext.lower() in extensions: + # simulation file + pth = os.path.join(self.workspace, file1) + files1.append(pth) + + # look for an exclusion file + pth = os.path.join(self.workspace, file1 + ".ex") + exfiles.append(pth if os.path.isfile(pth) else None) + + # look for a comparison file + coutp = None + if mf6: + _, coutp = get_mf6_files(cpth / "mfsim.nam") + if coutp is not None: + for file2 in coutp: + ext = os.path.splitext(file2)[1][1:] + if ext.lower() in extensions: + files2.append(os.path.join(cpth, file2)) + else: + files2.append(None) + + if self.cmp_namefile is None: + pth = None + else: + pth = os.path.join(cpth, self.cmp_namefile) + + for i in range(len(files1)): + file1 = files1[i] + ext = os.path.splitext(file1)[1][1:].lower() + outfile = os.path.splitext(os.path.basename(file1))[0] + outfile = os.path.join( + self.workspace, outfile + "." + ext + ".cmp.out" + ) + file2 = None if files2 is None else files2[i] + + # set exfile + exfile = None + if file2 is None: + if len(exfiles) > 0: + exfile = exfiles[i] + if exfile is not None: + print( + f"Exclusion file {i + 1}", + os.path.basename(exfile), + ) + + # make comparison + success = compare_heads( + None, + pth, + precision="double", + text=EXTTEXT[ext], + outfile=outfile, + files1=file1, + files2=file2, + htol=htol, + difftol=True, + verbose=self.verbose, + exfile=exfile, + ) + print(f"{EXTTEXT[ext]} comparison {i + 1}", self.name) + if not success: + return False + return True + + # otherwise it's a regression comparison + files0, files1 = get_regression_files(self.workspace, extensions) + extension = "hds" + for i, (fpth0, fpth1) in enumerate(zip(files0, files1)): + outfile = os.path.splitext(os.path.basename(fpth0))[0] + outfile = os.path.join( + self.workspace, outfile + f".{extension}.cmp.out" + ) + success = compare_heads( + None, + None, + precision="double", + htol=htol, + text=EXTTEXT[extension], + outfile=outfile, + files1=fpth0, + files2=fpth1, + verbose=self.verbose, + ) + print( + ( + f"{EXTTEXT[extension]} comparison {i + 1}" + + f"{self.name} ({os.path.basename(fpth0)})" + ) + ) + if not success: + return False + return True + + def _compare_concentrations(self, extensions="ucn", htol=0.001) -> bool: + if isinstance(extensions, str): + extensions = [extensions] + + files0, files1 = get_regression_files(self.workspace, extensions) + extension = "ucn" + for i, (fpth0, fpth1) in enumerate(zip(files0, files1)): + outfile = os.path.splitext(os.path.basename(fpth0))[0] + outfile = os.path.join( + self.workspace, outfile + f".{extension}.cmp.out" + ) + success = compare_heads( + None, + None, + precision="double", + htol=htol, + text=EXTTEXT[extension], + outfile=outfile, + files1=fpth0, + files2=fpth1, + verbose=self.verbose, + ) + print( + ( + f"{EXTTEXT[extension]} comparison {i + 1}" + + f"{self.name} ({os.path.basename(fpth0)})", + ) + ) + if not success: + return False + return True + + def _compare_budgets(self, extensions="cbc", rclose=0.001) -> bool: + if isinstance(extensions, str): + extensions = [extensions] + files0, files1 = get_regression_files(self.workspace, extensions) + extension = "cbc" + for i, (fpth0, fpth1) in enumerate(zip(files0, files1)): + print( + f"{EXTTEXT[extension]} comparison {i + 1}", + f"{self.name} ({os.path.basename(fpth0)})", + ) + success = self._compare_budget_files( + extension, fpth0, fpth1, rclose + ) + if not success: + return False + return True + + def _compare_budget_files( + self, extension, fpth0, fpth1, rclose=0.001 + ) -> bool: + success = True + if os.stat(fpth0).st_size * os.stat(fpth0).st_size == 0: + return success, "" + outfile = os.path.splitext(os.path.basename(fpth0))[0] + outfile = os.path.join( + self.workspace, outfile + f".{extension}.cmp.out" + ) + fcmp = open(outfile, "w") + fcmp.write("Performing CELL-BY-CELL to CELL-BY-CELL comparison\n") + fcmp.write(f"{fpth0}\n") + fcmp.write(f"{fpth1}\n\n") + + # open the files + cbc0 = flopy.utils.CellBudgetFile( + fpth0, precision="double", verbose=self.verbose + ) + cbc1 = flopy.utils.CellBudgetFile( + fpth1, precision="double", verbose=self.verbose + ) + + # build list of cbc data to retrieve + avail0 = cbc0.get_unique_record_names() + avail1 = cbc1.get_unique_record_names() + avail0 = [t.decode().strip() for t in avail0] + avail1 = [t.decode().strip() for t in avail1] + + # initialize list for storing totals for each budget term terms + cbc_keys0 = [] + cbc_keys1 = [] + for t in avail0: + t1 = t + if t not in avail1: + # check if RCHA or EVTA is available and use that instead + # should be able to remove this once v6.3.0 is released + if t[:-1] in avail1: + t1 = t[:-1] + else: + raise Exception(f"Could not find {t} in {fpth1}") + cbc_keys0.append(t) + cbc_keys1.append(t1) + + # get list of times and kstpkper + kk = cbc0.get_kstpkper() + times = cbc0.get_times() + + # process data + for key, key1 in zip(cbc_keys0, cbc_keys1): + for idx, (k, t) in enumerate(zip(kk, times)): + v0 = cbc0.get_data(kstpkper=k, text=key)[0] + v1 = cbc1.get_data(kstpkper=k, text=key1)[0] + if v0.dtype.names is not None: + v0 = v0["q"] + v1 = v1["q"] + # skip empty vectors + if v0.size < 1: + continue + vmin = rclose + if vmin < 1e-6: + vmin = 1e-6 + vmin_tol = 5.0 * vmin + if v0.shape != v1.shape: + v0 = v0.flatten() + v1 = v1.flatten() + idx = (abs(v0) > vmin) & (abs(v1) > vmin) + diff = np.zeros(v0.shape, dtype=v0.dtype) + diff[idx] = abs(v0[idx] - v1[idx]) + diffmax = diff.max() + indices = np.where(diff == diffmax)[0] + if diffmax > vmin_tol: + success = False + msg = ( + f"{os.path.basename(fpth0)} - " + + f"{key:16s} " + + f"difference ({diffmax:10.4g}) " + + f"> {vmin_tol:10.4g} " + + f"at {indices.size} nodes " + + f" [first location ({indices[0] + 1})] " + + f"at time {t} " + ) + fcmp.write(f"{msg}\n") + if self.verbose: + print(msg) + + fcmp.close() + return success + + # public + + def setup(self, src, dst): + print("Setting up MF6 test", self.name) + print(" Source:", src) + print(" Destination:", dst) + self.workspace = dst + + # setup workspace and expected output files + _, self.outp = setup_mf6(src=src, dst=dst) + print("waiting...") + time.sleep(0.5) + + if self.compare == "mf6_regression": + shutil.copytree(self.workspace, self.workspace / self.compare) + else: + self.compare = get_mf6_comparison(src) # detect comparison + setup_mf6_comparison(src, dst, self.compare, overwrite=True) + + def run_sim_or_model( + self, + workspace: Union[str, os.PathLike], + target: Union[str, os.PathLike], + xfail: bool = False, + ncpus: int = 1, + ) -> Tuple[bool, List[str]]: """ - Build base and regression MODFLOW 6 models - - Parameters - ---------- - build_function : function - user defined function that builds a base model and optionally - builds a regression model. If a regression model is not built - then None must be returned from the function for the regression - model. - idx : int - counter that corresponds to exdir entry - exdir : str - path to regression model files + Run a simulation or model with FloPy. + + workspace : str or path-like + The simulation or model workspace + target : str or path-like + The target executable to use + xfail : bool + Whether to expect failure + ncpus : int + The number of CPUs for a parallel run """ - base, regression = build_function(idx, exdir) - base.write_simulation() - if regression is not None: - if isinstance(regression, flopy.mf6.MFSimulation): - regression.write_simulation() + + # make sure workspace exists + workspace = Path(workspace).expanduser().absolute() + assert workspace.is_dir(), f"Workspace not found: {workspace}" + + # make sure executable exists and framework knows about it + tgt = Path(shutil.which(target)) + assert tgt.is_file(), f"Target executable not found: {target}" + assert ( + tgt in self.targets.values() + ), f"Targets must be explicitly registered with the test framework" + + if self.verbose: + print(f"Running {target} in {workspace}") + + # needed in _compare_heads()... todo: inject explicitly? + nf = next(iter(get_namefiles(workspace)), None) + self.cmp_namefile = ( + None + if "mf6" in target.name or "libmf6" in target.name + else os.path.basename(nf) + if nf + else None + ) + + # run the model + try: + # via MODFLOW API + if "libmf6" in target.name and self.api_func: + success, buff = self.api_func(target, workspace) + # via MF6 executable + elif "mf6" in target.name: + # parallel test if configured + if self.parallel and ncpus > 1: + print( + f"Parallel test {self.name} on {self.ncpus} processes" + ) + try: + success, buff = run_parallel(workspace, target, ncpus) + except Exception: + warn( + "MODFLOW 6 parallel test", + self.name, + f"failed with error:\n{format_exc()}", + ) + success = False + else: + # otherwise serial run + try: + success, buff = flopy.run_model( + target, + self.workspace / "mfsim.nam", + model_ws=workspace, + report=True, + ) + except Exception: + warn( + "MODFLOW 6 serial test", + self.name, + f"failed with error:\n{format_exc()}", + ) + success = False else: - regression.write_input() + # non-MF6 model + try: + success, buff = flopy.run_model( + target, self.cmp_namefile, workspace, report=True + ) + except Exception: + warn(f"{target} model failed:\n{format_exc()}") + success = False - def run(self, sim, workspace=None): + if xfail: + if success: + warn("MODFLOW 6 model should have failed!") + success = False + else: + success = True + + lst_file_path = Path(workspace) / "mfsim.lst" + if ( + "mf6" in target.name + and not success + and lst_file_path.is_file() + ): + warn( + "MODFLOW 6 listing file ended with: \n" + + get_mfsim_lst_tail(lst_file_path) + ) + except Exception: + success = False + warn( + f"Unhandled error in comparison model {self.name}:\n{format_exc()}" + ) + + return success, buff + + def compare_output(self, compare): """ - Run the MODFLOW 6 simulation and compare to existing head file or - appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. - - Parameters - ---------- - sim : Simulation object - MODFLOW 6 autotest simulation object that runs the base and - regression models, compares the results, and tears down the - test if successful. - workspace : str - The path to the workspace where the test is run. + Compare the main simulation's output with that of another simulation or model. + + compare : str + The comparison executable name: mf6, mf6_regression, libmf6, mf2005, + mfnwt, mflgr, or mfusg. + """ + + if compare not in COMPARE_PROGRAMS: + raise ValueError(f"Unsupported comparison program: {compare}") + + if self.verbose: + print("Comparison test", self.name) + + # adjust htol if < IMS outer_dvclose, and rclose for budget comparisons + htol = adjust_htol(self.workspace, self.htol) + rclose = get_rclose(self.workspace) + cmp_path = self.workspace / compare + if "mf6_regression" in compare: + assert self._compare_heads( + extensions=HDS_EXT, htol=htol + ), "head comparison failed" + assert self._compare_budgets( + extensions=CBC_EXT, rclose=rclose + ), "budget comparison failed" + assert self._compare_concentrations( + htol=htol + ), "concentration comparison failed" + else: + assert self._compare_heads( + cpth=cmp_path, + extensions=HDS_EXT, + mf6="mf6" in compare, + htol=htol, + ), "head comparison failed" + + def run(self): + """ + Run the test case end-to-end. + """ - sim.set_model( - sim.name if workspace is None else workspace, testModel=False + # if build fn provided, build models/simulations and write input files + if self.build: + sims = self.build(self) + sims = sims if isinstance(sims, Iterable) else [sims] + sims = [sim for sim in sims if sim] # filter Nones + self.sims = sims + nsims = len(sims) + self.buffs = list(repeat(None, nsims)) + + assert len(self.xfail) in [ + 1, + nsims, + ], f"Invalid xfail: expected a single boolean or one for each model" + if len(self.xfail) == 1 and nsims: + self.xfail = list(repeat(self.xfail[0], nsims)) + + assert len(self.ncpus) in [ + 1, + nsims, + ], f"Invalid ncpus: expected a single integer or one for each model" + if len(self.ncpus) == 1 and nsims: + self.ncpus = list(repeat(self.ncpus[0], nsims)) + + write_input(*sims, overwrite=self.overwrite, verbose=self.verbose) + else: + self.sims = [MFSimulation.load(sim_ws=self.workspace)] + self.buffs = [None] + assert ( + len(self.xfail) == 1 + ), f"Invalid xfail: expected a single boolean" + assert ( + len(self.ncpus) == 1 + ), f"Invalid ncpus: expected a single integer" + + # run models/simulations + for i, sim_or_model in enumerate(self.sims): + tgts = self.targets + workspace = get_workspace(sim_or_model) + exe_path = ( + Path(sim_or_model.exe_name) + if sim_or_model.exe_name + else tgts["mf6"] + ) + target = ( + exe_path + if exe_path in tgts.values() + else tgts.get(exe_path.stem, tgts["mf6"]) + ) + xfail = self.xfail[i] + ncpus = self.ncpus[i] + success, buff = self.run_sim_or_model( + workspace, target, xfail, ncpus + ) + self.buffs[i] = buff # store model output for assertions later + assert success, ( + f"{'Simulation' if 'mf6' in str(target) else 'Model'} " + f"{'should have failed' if xfail else 'failed'}: {workspace}" + ) + + # get expected output files from main simulation + _, self.outp = get_mf6_files( + self.workspace / "mfsim.nam", self.verbose ) - sim.run() - sim.compare() - if sim.exfunc is not None: - sim.exfunc(sim) + + # setup and run comparison model(s), if enabled + if self.compare: + # try to autodetect comparison type if enabled + if self.compare == "auto": + if self.verbose: + print("Auto-detecting comparison type") + self.compare = get_mf6_comparison(self.workspace) + if self.compare: + if self.verbose: + print(f"Using comparison type: {self.compare}") + + # copy simulation files to comparison workspace if mf6 regression + if self.compare == "mf6_regression": + cmp_path = self.workspace / self.compare + if os.path.isdir(cmp_path): + if self.verbose: + print(f"Cleaning {cmp_path}") + shutil.rmtree(cmp_path) + if self.verbose: + print( + f"Copying simulation files from {self.workspace} to {cmp_path}" + ) + shutil.copytree(self.workspace, cmp_path) + + # run comparison simulation if libmf6 or mf6 regression + if self.compare in ["mf6_regression", "libmf6"]: + # todo: don't hardcode workspace or assume agreement with test case + # simulation workspace, set & access simulation workspaces directly + workspace = self.workspace / self.compare + success, _ = self.run_sim_or_model( + workspace, + self.targets.get(self.compare, self.targets["mf6"]), + ) + assert success, f"Comparison model failed: {workspace}" + + # compare model results, if enabled + if self.verbose: + print("Comparing outputs") + self.compare_output(self.compare) + + # check results, if enabled + if self.check: + if self.verbose: + print("Checking outputs") + self.check(self) diff --git a/autotest/get_exes.py b/autotest/get_exes.py index 0a071d50fea..d5c789ceb11 100644 --- a/autotest/get_exes.py +++ b/autotest/get_exes.py @@ -1,15 +1,18 @@ import argparse +from os import environ from pathlib import Path +from platform import system from tempfile import TemporaryDirectory from warnings import warn import flopy import pytest -from conftest import project_root_path from flaky import flaky from modflow_devtools.build import meson_build from modflow_devtools.download import download_and_unzip, get_release -from modflow_devtools.misc import get_ostag +from modflow_devtools.misc import get_ostag, is_in_ci, set_env + +from conftest import project_root_path repository = "MODFLOW-USGS/modflow6" top_bin_path = project_root_path / "bin" @@ -73,11 +76,21 @@ def test_rebuild_release(rebuilt_bin_path: Path): f.write(f"{line}\n") # rebuild with Meson - meson_build( - project_path=source_files_path.parent, - build_path=download_path / "builddir", - bin_path=rebuilt_bin_path, - ) + def rebuild(): + meson_build( + project_path=source_files_path.parent, + build_path=download_path / "builddir", + bin_path=rebuilt_bin_path, + ) + + # temp workaround until next release, + # ifx fails to build 6.4.2 on Windows + # most likely due to backspace issues + if system() == "Windows" and environ.get("FC") == "ifx": + with set_env(FC="ifort", CC="icl"): + rebuild() + else: + rebuild() @flaky(max_runs=3) diff --git a/autotest/meson.build b/autotest/meson.build new file mode 100644 index 00000000000..a36d6e1e82e --- /dev/null +++ b/autotest/meson.build @@ -0,0 +1,34 @@ +test_drive = dependency('test-drive', required : false) +if test_drive.found() and not fc_id.contains('intel') + tests = [ + 'ArrayHandlers', + 'DevFeature', + 'GeomUtil', + 'HashTable', + 'InputOutput', + 'List', + 'MathUtil', + 'Message', + 'Sim' + ] + + test_srcs = files( + 'tester.f90', + ) + foreach t : tests + test_srcs += files('Test@0@.f90'.format(t.underscorify())) + endforeach + + tester = executable( + 'tester', + sources: test_srcs, + link_with: mf6core, + dependencies: test_drive, + ) + + test('Test source modules', tester) + + foreach t : tests + test(t, tester, args: t) + endforeach +endif \ No newline at end of file diff --git a/autotest/pytest.ini b/autotest/pytest.ini index bc9cdb0cc74..b8e144f9f5c 100644 --- a/autotest/pytest.ini +++ b/autotest/pytest.ini @@ -1,4 +1,5 @@ [pytest] +addopts = --color=yes python_files = test_*.py *_test*.py diff --git a/autotest/simulation.py b/autotest/simulation.py deleted file mode 100644 index 73516fbfdee..00000000000 --- a/autotest/simulation.py +++ /dev/null @@ -1,784 +0,0 @@ -import os -import shutil -import sys -import time -from traceback import format_exc -from subprocess import PIPE, STDOUT, Popen - -import flopy -import numpy as np -from common_regression import ( - get_mf6_comparison, - get_mf6_files, - get_namefiles, - setup_mf6, - setup_mf6_comparison, -) -from flopy.utils.compare import compare_heads -from modflow_devtools.misc import is_in_ci - -sfmt = "{:25s} - {}" -extdict = { - "hds": "head", - "hed": "head", - "bhd": "head", - "ucn": "concentration", - "cbc": "cell-by-cell", -} - - -class TestSimulation: - # tell pytest this isn't a test class, don't collect it - __test__ = False - - def __init__( - self, - name, - parallel=False, - ncpus=1, - exfunc=None, - exe_dict=None, - htol=None, - pdtol=None, - rclose=None, - idxsim=None, - cmp_verbose=True, - require_failure=None, - api_func=None, - mf6_regression=False, - make_comparison=True, - simpath=None, - ): - msg = sfmt.format("Initializing test", name) - print(msg) - - self.name = name - self.parallel = parallel - self.ncpus = ncpus - self.exfunc = exfunc - self.targets = exe_dict - self.simpath = simpath - self.inpt = None - self.outp = None - self.coutp = None - self.api_func = api_func - self.mf6_regression = mf6_regression - self.make_comparison = make_comparison - self.action = None - - # set htol for comparisons - if htol is None: - htol = 0.001 - else: - msg = sfmt.format("User specified comparison htol", htol) - print(msg) - - self.htol = htol - - # set pdtol for comparisons - if pdtol is None: - pdtol = 0.001 - else: - msg = sfmt.format( - "User specified percent difference comparison pdtol", pdtol - ) - print(msg) - - self.pdtol = pdtol - - # set rclose for comparisons - if rclose is None: - rclose = 0.001 - else: - msg = sfmt.format( - "User specified percent difference comparison rclose", rclose - ) - print(msg) - - self.rclose = rclose - - # set index for multi-simulation comparisons - self.idxsim = idxsim - - # set compare verbosity - self.cmp_verbose = cmp_verbose - - # set allow failure - self.require_failure = require_failure - - self.success = False - - # set is_ci - self.is_CI = is_in_ci() - - return - - def __repr__(self): - return self.name - - def set_model(self, pth, testModel=True): - """ - Set paths to MODFLOW 6 model and associated comparison test - """ - # make sure this is a valid path - if not os.path.isdir(pth): - assert False, f"{pth} is not a valid directory" - - self.simpath = pth - - # get MODFLOW 6 output file names - fpth = os.path.join(pth, "mfsim.nam") - mf6inp, mf6outp = get_mf6_files(fpth) - self.outp = mf6outp - - # determine comparison model - self.setup_comparison(pth, pth, testModel=testModel) - # if self.mf6_regression: - # self.action = "mf6_regression" - # else: - # self.action = get_mf6_comparison(pth) - if self.action is not None: - if "mf6" in self.action or "mf6_regression" in self.action: - cinp, self.coutp = get_mf6_files(fpth) - - def setup(self, src, dst): - msg = sfmt.format("Setting up test workspace", self.name) - print(msg) - self.originpath = src - self.simpath = dst - try: - self.inpt, self.outp = setup_mf6(src=src, dst=dst) - print("waiting...") - time.sleep(0.5) - success = True - except: - success = False - print(f"source: {src}") - print(f"destination: {dst}") - assert success, f"Failed to set up test workspace: {format_exc()}" - - if success: - self.setup_comparison(src, dst) - - return - - def setup_comparison(self, src, dst, testModel=True): - - # evaluate if comparison should be made - if not self.make_comparison: - return - - # adjust htol if it is smaller than IMS outer_dvclose - dvclose = self._get_dvclose(dst) - if dvclose is not None: - dvclose *= 5.0 - if self.htol < dvclose: - self.htol = dvclose - - # get rclose to use with budget comparisons - rclose = self._get_rclose(dst) - if rclose is None: - rclose = 0.5 - else: - rclose *= 5.0 - self.rclose = rclose - - # Copy comparison simulations if available - if self.mf6_regression: - action = "mf6_regression" - pth = os.path.join(dst, action) - if os.path.isdir(pth): - shutil.rmtree(pth) - shutil.copytree(dst, pth) - elif testModel: - action = setup_mf6_comparison(src, dst, remove_existing=True) - else: - action = get_mf6_comparison(dst) - - self.action = action - - return - - def run(self): - """ - Run the model and assert if the model terminated successfully - """ - msg = sfmt.format("Run test", self.name) - print(msg) - - # Set nam as namefile name without path - nam = None - - # run mf6 models - exe = str(self.targets["mf6"].absolute()) - msg = sfmt.format("using executable", exe) - print(msg) - - if self.parallel: - print("running parallel on", self.ncpus, "processes") - try: - success, buff = self.run_parallel( - exe, - ) - except Exception as exc: - msg = sfmt.format("MODFLOW 6 run", self.name) - print(msg) - print(exc) - success = False - else: - try: - success, buff = flopy.run_model( - exe, - nam, - model_ws=self.simpath, - silent=False, - report=True, - ) - msg = sfmt.format("MODFLOW 6 run", self.name) - if success: - print(msg) - else: - print(msg) - except: - msg = sfmt.format("MODFLOW 6 run", self.name) - print(msg) - success = False - - # set failure based on success and require_failure setting - if self.require_failure is None: - msg = "MODFLOW 6 model did not terminate normally" - if success: - failure = False - else: - failure = True - else: - if self.require_failure: - msg = "MODFLOW 6 model should have failed" - if not success: - failure = False - else: - failure = True - else: - msg = "MODFLOW 6 model should not have failed" - if success: - failure = False - else: - failure = True - - # print end of mfsim.lst to the screen - if failure and self.is_CI: - fpth = os.path.join(self.simpath, "mfsim.lst") - msg = self._get_mfsim_listing(fpth) + msg - - # test for failure - assert not failure, msg - - self.nam_cmp = None - if success: - if self.action is not None: - if self.action.lower() == "compare": - msg = sfmt.format("Comparison files", self.name) - print(msg) - else: - cpth = os.path.join(self.simpath, self.action) - key = self.action.lower().replace(".cmp", "") - exe = str(self.targets[key].absolute()) - msg = sfmt.format("comparison executable", exe) - print(msg) - if ( - "mf6" in key - or "libmf6" in key - or "mf6_regression" in key - ): - nam = None - else: - npth = get_namefiles(cpth)[0] - nam = os.path.basename(npth) - self.nam_cmp = nam - try: - if self.api_func is None: - success_cmp, buff = flopy.run_model( - exe, - nam, - model_ws=cpth, - silent=False, - report=True, - ) - else: - success_cmp, buff = self.api_func( - exe, self.idxsim, model_ws=cpth - ) - msg = sfmt.format( - "Comparison run", self.name + "/" + key - ) - print(msg) - - # print end of mfsim.lst to the screen - if "mf6" in key: - if not success and self.is_CI: - fpth = os.path.join(cpth, "mfsim.lst") - print(self._get_mfsim_listing(fpth)) - - except: - success_cmp = False - msg = sfmt.format( - "Comparison run", self.name + "/" + key - ) - print(msg) - - assert success_cmp, "Unsuccessful comparison run" - - return - - def run_parallel(self, exe): - normal_msg="normal termination" - success = False - nr_success = 0 - buff = [] - - mpiexec_cmd = ["mpiexec", "--oversubscribe", "-np", str(self.ncpus), exe, "-p"] - proc = Popen(mpiexec_cmd, stdout=PIPE, stderr=STDOUT, cwd=self.simpath) - - while True: - line = proc.stdout.readline().decode("utf-8") - if line == "" and proc.poll() is not None: - break - if line: - # success is when the success message appears - # in every process of the parallel simulation - if normal_msg in line.lower(): - nr_success = nr_success + 1 - if nr_success == self.ncpus: - success = True - line = line.rstrip("\r\n") - print(line) - buff.append(line) - else: - break - - return success, buff - - - def compare(self): - """ - Compare the model results - - """ - self.success = True - - # evaluate if comparison should be made - if not self.make_comparison: - return - - msgall = "" - msg = sfmt.format("Comparison test", self.name) - print(msg) - - if self.action is not None: - cpth = os.path.join(self.simpath, self.action) - files_cmp = None - if self.action.lower() == "compare": - files_cmp = [] - files = os.listdir(cpth) - for file in files: - files_cmp.append(file) - elif "mf6" in self.action: - fpth = os.path.join(cpth, "mfsim.nam") - cinp, self.coutp = get_mf6_files(fpth) - - head_extensions = ( - "hds", - "hed", - "bhd", - "ahd", - "bin", - ) - if "mf6_regression" in self.action: - success, msgall = self._compare_heads( - msgall, - extensions=head_extensions, - ) - if not success: - self.success = False - # non-regression runs - for new features - else: - files1 = [] - files2 = [] - exfiles = [] - ipos = 0 - for file1 in self.outp: - ext = os.path.splitext(file1)[1][1:] - - if ext.lower() in head_extensions: - - # simulation file - pth = os.path.join(self.simpath, file1) - files1.append(pth) - - # look for an exclusion file - pth = os.path.join(self.simpath, file1 + ".ex") - if os.path.isfile(pth): - exfiles.append(pth) - else: - exfiles.append(None) - - # Check to see if there is a corresponding compare file - if files_cmp is not None: - - if file1 + ".cmp" in files_cmp: - # compare file - idx = files_cmp.index(file1 + ".cmp") - pth = os.path.join(cpth, files_cmp[idx]) - files2.append(pth) - txt = sfmt.format( - f"Comparison file {ipos + 1}", - os.path.basename(pth), - ) - print(txt) - else: - if self.coutp is not None: - for file2 in self.coutp: - ext = os.path.splitext(file2)[1][1:] - - if ext.lower() in head_extensions: - # simulation file - pth = os.path.join(cpth, file2) - files2.append(pth) - - else: - files2.append(None) - - if self.nam_cmp is None: - pth = None - else: - pth = os.path.join(cpth, self.nam_cmp) - - for ipos in range(len(files1)): - file1 = files1[ipos] - ext = os.path.splitext(file1)[1][1:].lower() - outfile = os.path.splitext(os.path.basename(file1))[0] - outfile = os.path.join( - self.simpath, outfile + "." + ext + ".cmp.out" - ) - if files2 is None: - file2 = None - else: - file2 = files2[ipos] - - # set exfile - exfile = None - if file2 is None: - if len(exfiles) > 0: - exfile = exfiles[ipos] - if exfile is not None: - txt = sfmt.format( - f"Exclusion file {ipos + 1}", - os.path.basename(exfile), - ) - print(txt) - - # make comparison - success_tst = compare_heads( - None, - pth, - precision="double", - text=extdict[ext], - outfile=outfile, - files1=file1, - files2=file2, - htol=self.htol, - difftol=True, - # Change to true to have list of all nodes exceeding htol - verbose=self.cmp_verbose, - exfile=exfile, - ) - msg = sfmt.format( - f"{extdict[ext]} comparison {ipos + 1}", - self.name, - ) - print(msg) - - if not success_tst: - self.success = False - msgall += msg + " ... FAILED\n" - - # compare concentrations - if "mf6_regression" in self.action: - success, msgall = self._compare_concentrations(msgall) - if not success: - self.success = False - - # compare cbc files - if "mf6_regression" in self.action: - cbc_extensions = ( - "cbc", - "bud", - ) - success, msgall = self._compare_budgets( - msgall, extensions=cbc_extensions - ) - if not success: - self.success = False - - assert self.success, msgall - return - - def _get_mfsim_listing(self, lst_pth): - """Get the tail of the mfsim.lst listing file""" - msg = "" - ilen = 100 - with open(lst_pth) as fp: - lines = fp.read().splitlines() - msg = "\n" + 79 * "-" + "\n" - if len(lines) > ilen: - i0 = -100 - else: - i0 = 0 - for line in lines[i0:]: - if len(line) > 0: - msg += f"{line}\n" - msg += 79 * "-" + "\n\n" - return msg - - def _get_dvclose(self, dir_pth): - """Get outer_dvclose value from MODFLOW 6 ims file""" - dvclose = None - files = os.listdir(dir_pth) - for file_name in files: - pth = os.path.join(dir_pth, file_name) - if os.path.isfile(pth): - if file_name.lower().endswith(".ims"): - with open(pth) as f: - lines = f.read().splitlines() - for line in lines: - if "outer_dvclose" in line.lower(): - v = float(line.split()[1]) - if dvclose is None: - dvclose = v - else: - if v > dvclose: - dvclose = v - break - - return dvclose - - def _get_rclose(self, dir_pth): - """Get inner_rclose value from MODFLOW 6 ims file""" - rclose = None - files = os.listdir(dir_pth) - for file_name in files: - pth = os.path.join(dir_pth, file_name) - if os.path.isfile(pth): - if file_name.lower().endswith(".ims"): - with open(pth) as f: - lines = f.read().splitlines() - for line in lines: - if "inner_rclose" in line.lower(): - v = float(line.split()[1]) - if rclose is None: - rclose = v - else: - if v > rclose: - rclose = v - break - - return rclose - - def _regression_files(self, extensions): - if isinstance(extensions, str): - extensions = [extensions] - files = os.listdir(self.simpath) - files0 = [] - files1 = [] - for file_name in files: - fpth0 = os.path.join(self.simpath, file_name) - if os.path.isfile(fpth0): - for extension in extensions: - if file_name.lower().endswith(extension): - files0.append(fpth0) - fpth1 = os.path.join( - self.simpath, "mf6_regression", file_name - ) - files1.append(fpth1) - break - return files0, files1 - - def _compare_heads(self, msgall, extensions="hds"): - if isinstance(extensions, str): - extensions = [extensions] - success = True - files0, files1 = self._regression_files(extensions) - extension = "hds" - ipos = 0 - for idx, (fpth0, fpth1) in enumerate(zip(files0, files1)): - outfile = os.path.splitext(os.path.basename(fpth0))[0] - outfile = os.path.join( - self.simpath, outfile + f".{extension}.cmp.out" - ) - success_tst = compare_heads( - None, - None, - precision="double", - htol=self.htol, - text=extdict[extension], - outfile=outfile, - files1=fpth0, - files2=fpth1, - verbose=self.cmp_verbose, - ) - msg = sfmt.format( - f"{extdict[extension]} comparison {ipos + 1}", - f"{self.name} ({os.path.basename(fpth0)})", - ) - ipos += 1 - print(msg) - - if not success_tst: - success = False - msgall += msg + " ... FAILED\n" - - return success, msgall - - def _compare_concentrations(self, msgall, extensions="ucn"): - if isinstance(extensions, str): - extensions = [extensions] - success = True - files0, files1 = self._regression_files(extensions) - extension = "ucn" - ipos = 0 - for idx, (fpth0, fpth1) in enumerate(zip(files0, files1)): - outfile = os.path.splitext(os.path.basename(fpth0))[0] - outfile = os.path.join( - self.simpath, outfile + f".{extension}.cmp.out" - ) - success_tst = compare_heads( - None, - None, - precision="double", - htol=self.htol, - text=extdict[extension], - outfile=outfile, - files1=fpth0, - files2=fpth1, - verbose=self.cmp_verbose, - ) - msg = sfmt.format( - f"{extdict[extension]} comparison {ipos + 1}", - f"{self.name} ({os.path.basename(fpth0)})", - ) - ipos += 1 - print(msg) - - if not success_tst: - success = False - msgall += msg + " ... FAILED\n" - - return success, msgall - - def _compare_budgets(self, msgall, extensions="cbc"): - if isinstance(extensions, str): - extensions = [extensions] - success = True - files0, files1 = self._regression_files(extensions) - extension = "cbc" - ipos = 0 - for idx, (fpth0, fpth1) in enumerate(zip(files0, files1)): - if os.stat(fpth0).st_size * os.stat(fpth0).st_size == 0: - continue - outfile = os.path.splitext(os.path.basename(fpth0))[0] - outfile = os.path.join( - self.simpath, outfile + f".{extension}.cmp.out" - ) - fcmp = open(outfile, "w") - - # open the files - cbc0 = flopy.utils.CellBudgetFile( - fpth0, precision="double", verbose=self.cmp_verbose - ) - cbc1 = flopy.utils.CellBudgetFile( - fpth1, precision="double", verbose=self.cmp_verbose - ) - - # build list of cbc data to retrieve - avail0 = cbc0.get_unique_record_names() - avail1 = cbc1.get_unique_record_names() - avail0 = [t.decode().strip() for t in avail0] - avail1 = [t.decode().strip() for t in avail1] - - # initialize list for storing totals for each budget term terms - cbc_keys0 = [] - cbc_keys1 = [] - for t in avail0: - t1 = t - if t not in avail1: - # check if RCHA or EVTA is available and use that instead - # should be able to remove this once v6.3.0 is released - if t[:-1] in avail1: - t1 = t[:-1] - else: - raise Exception(f"Could not find {t} in {fpth1}") - cbc_keys0.append(t) - cbc_keys1.append(t1) - - # get list of times and kstpkper - kk = cbc0.get_kstpkper() - times = cbc0.get_times() - - # process data - success_tst = True - for key, key1 in zip(cbc_keys0, cbc_keys1): - for idx, (k, t) in enumerate(zip(kk, times)): - v0 = cbc0.get_data(kstpkper=k, text=key)[0] - v1 = cbc1.get_data(kstpkper=k, text=key1)[0] - if v0.dtype.names is not None: - v0 = v0["q"] - v1 = v1["q"] - # skip empty vectors - if v0.size < 1: - continue - vmin = self.rclose - if vmin < 1e-6: - vmin = 1e-6 - vmin_tol = 5.0 * vmin - idx = (abs(v0) > vmin) & (abs(v1) > vmin) - diff = np.zeros(v0.shape, dtype=v0.dtype) - diff[idx] = abs(v0[idx] - v1[idx]) - diffmax = diff.max() - indices = np.where(diff == diffmax)[0] - if diffmax > vmin_tol: - success_tst = False - msg = ( - f"{os.path.basename(fpth0)} - " - + f"{key:16s} " - + f"difference ({diffmax:10.4g}) " - + f"> {vmin_tol:10.4g} " - + f"at {indices.size} nodes " - + f" [first location ({indices[0] + 1})] " - + f"at time {t} " - ) - fcmp.write(f"{msg}\n") - if self.cmp_verbose: - print(msg) - - msg = sfmt.format( - f"{extdict[extension]} comparison {ipos + 1}", - f"{self.name} ({os.path.basename(fpth0)})", - ) - ipos += 1 - print(msg) - - fcmp.close() - - if not success_tst: - success = False - msgall += msg + " ... FAILED\n" - - return success, msgall - - -def api_return(success, model_ws): - """ - parse libmf6 stdout shared object file - """ - fpth = os.path.join(model_ws, "mfsim.stdout") - return success, open(fpth).readlines() diff --git a/autotest/test_cli.py b/autotest/test_cli.py index aa9185ceb46..6cbf1bb2e0c 100644 --- a/autotest/test_cli.py +++ b/autotest/test_cli.py @@ -1,29 +1,21 @@ -import re +import platform import subprocess from conftest import project_root_path bin_path = project_root_path / "bin" - - -def split_nonnumeric(s): - match = re.compile("[^0-9]").search(s) - return [s[:match.start()], s[match.start():]] if match else s +ext = ".exe" if platform.system() == "Windows" else "" +exe = f"mf6{ext}" def test_cli_version(): output = " ".join( - subprocess.check_output([str(bin_path / "mf6"), "-v"]).decode().split() + subprocess.check_output([str(bin_path / exe), "-v"]).decode().split() ) print(output) - assert output.startswith("mf6:") - - version = ( - output.lower().split(' ')[1] - ) + assert output.startswith(f"{exe}:"), f"found: {output}" + version = output.lower().split(" ")[1] print(version) v_split = version.split(".") - assert len(v_split) == 3 - assert all(s.isdigit() for s in v_split[:2]) - sol = split_nonnumeric(v_split[2]) - assert sol[0].isdigit() + assert len(v_split) >= 2 + assert all(s[-1].isdigit() for s in v_split[:2]) diff --git a/autotest/test_examples.py b/autotest/test_examples.py new file mode 100644 index 00000000000..5262f6ed7cf --- /dev/null +++ b/autotest/test_examples.py @@ -0,0 +1,60 @@ +import pytest + +from framework import TestFramework + +# skip nested models +# ex-gwf-csub-p02c has subdirs like 'es-001', 'hb-100' +# all others just have 2 folders 'mf6gwf' and 'mf6gwt' +excluded_models = [ + "ex-gwf-csub-p02c", + "ex-gwt-hecht-mendez-b", + "ex-gwt-hecht-mendez-c", + "ex-gwt-keating", + "ex-gwt-moc3d-p01a", + "ex-gwt-moc3d-p01b", + "ex-gwt-moc3d-p01c", + "ex-gwt-moc3d-p01d", + "ex-gwt-moc3d-p02", + "ex-gwt-moc3d-p02tg", + "ex-gwt-mt3dms-p02a", + "ex-gwt-mt3dms-p02b", + "ex-gwt-mt3dms-p02c", + "ex-gwt-mt3dms-p02d", + "ex-gwt-mt3dms-p02e", + "ex-gwt-mt3dms-p02f", + "ex-gwt-mt3dsupp631", + "ex-gwt-mt3dsupp632a", + "ex-gwt-mt3dsupp632b", + "ex-gwt-mt3dsupp632c", + "ex-gwt-mt3dsupp82", + "ex-gwt-prudic2004t2", +] + + +@pytest.mark.large +@pytest.mark.repo +@pytest.mark.regression +@pytest.mark.slow +def test_scenario( + # https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#example-scenarios + function_tmpdir, + example_scenario, + targets, +): + name, namefiles = example_scenario + if name in excluded_models: + pytest.skip(f"Skipping: {name} (excluded)") + + model_paths = [nf.parent for nf in namefiles] + for model_path in model_paths: + model_name = f"{name}_{model_path.name}" + workspace = function_tmpdir / model_name + test = TestFramework( + name=model_name, + workspace=model_path, + targets=targets, + compare="mf6_regression", + verbose=False, + ) + test.setup(model_path, workspace) + test.run() diff --git a/autotest/test_gwf.py b/autotest/test_gwf.py deleted file mode 100644 index 59e0d18f6ac..00000000000 --- a/autotest/test_gwf.py +++ /dev/null @@ -1,27 +0,0 @@ -from modflow_devtools.executables import Executables -from pytest_cases import parametrize_with_cases -from simulation import TestSimulation -from test_gwf_maw04 import GwfMaw04Cases -from test_gwf_maw_cases import GwfMawCases - - -@parametrize_with_cases("case", cases=[GwfMawCases, GwfMaw04Cases]) -def test_gwf_models(case, targets: Executables): - data, sim, cmp, exfunc = case - sim.write_simulation() - if cmp: - cmp.write_simulation() - - test = TestSimulation( - name=data.name, - exe_dict=targets, - exfunc=exfunc, - idxsim=0, # TODO: remove parameter from TestSimulation - mf6_regression=True, - require_failure=data.xfail, - make_comparison=data.compare, - ) - - test.set_model(sim.simulation_data.mfpath.get_sim_path(), testModel=False) - test.run() - test.compare() diff --git a/autotest/test_gwf_ats01.py b/autotest/test_gwf_ats01.py index 167ce57ba35..a2becae2240 100644 --- a/autotest/test_gwf_ats01.py +++ b/autotest/test_gwf_ats01.py @@ -1,6 +1,5 @@ """ Test adaptive time step module - """ import os @@ -8,10 +7,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_ats01a"] +cases = ["gwf_ats01a"] nlay, nrow, ncol = 1, 1, 2 # set dt0, dtmin, dtmax, dtadj, dtfailadj @@ -22,7 +21,7 @@ dtfailadj = 5.0 -def build_model(idx, dir): +def build_models(idx, test): perlen = [10] nper = len(perlen) nstp = [1] @@ -41,10 +40,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -175,11 +174,9 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - +def check_output(idx, test): # This will fail if budget numbers cannot be read - fpth = os.path.join(sim.simpath, f"{sim.name}.lst") + fpth = os.path.join(test.workspace, f"{test.name}.lst") mflist = flopy.utils.Mf6ListBudget(fpth) names = mflist.get_record_names() inc = mflist.get_incremental() @@ -189,7 +186,7 @@ def eval_flow(sim): assert v == 10.0, f"Last time should be 10. Found {v}" # ensure obs results changing monotonically - fpth = os.path.join(sim.simpath, sim.name + ".obs.csv") + fpth = os.path.join(test.workspace, test.name + ".obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -205,17 +202,13 @@ def eval_flow(sim): assert v == 10.0, f"Last time should be 10. Found {v}" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - workspace = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, workspace) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - workspace, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ats02.py b/autotest/test_gwf_ats02.py index 7b41db9cfdc..7e03230de24 100644 --- a/autotest/test_gwf_ats02.py +++ b/autotest/test_gwf_ats02.py @@ -1,7 +1,6 @@ """ Test adaptive time step module with a one-d vertical column in which cells dry and then rewet based on a ghb in the bottom cell. - """ import os @@ -9,10 +8,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_ats02a"] +cases = ["gwf_ats02a"] nlay, nrow, ncol = 5, 1, 1 botm = [80.0, 60.0, 40.0, 20.0, 0.0] @@ -24,7 +23,7 @@ dtfailadj = 5.0 -def build_model(idx, dir): +def build_models(idx, test): perlen = [10, 10] nper = len(perlen) nstp = [5, 5] @@ -42,10 +41,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -172,11 +171,11 @@ def build_model(idx, dir): return sim, None -def make_plot(sim): +def make_plot(test): print("making plots...") - ws = sim.simpath + ws = test.workspace - fname = sim.name + ".hds" + fname = test.name + ".hds" fname = os.path.join(ws, fname) hobj = flopy.utils.HeadFile(fname, precision="double") head = hobj.get_alldata()[:, :, 0, 0] @@ -206,11 +205,9 @@ def make_plot(sim): plt.show() -def eval_flow(sim): - print("evaluating flow...") - +def check_output(idx, test): # This will fail if budget numbers cannot be read - fpth = os.path.join(sim.simpath, f"{sim.name}.lst") + fpth = os.path.join(test.workspace, f"{test.name}.lst") mflist = flopy.utils.Mf6ListBudget(fpth) names = mflist.get_record_names() inc = mflist.get_incremental() @@ -220,7 +217,7 @@ def eval_flow(sim): assert v == 20.0, f"Last time should be 20. Found {v}" # ensure obs results changing monotonically - fpth = os.path.join(sim.simpath, sim.name + ".obs.csv") + fpth = os.path.join(test.workspace, test.name + ".obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -231,16 +228,13 @@ def eval_flow(sim): ), "layer 1 should be dry for this period" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ats03.py b/autotest/test_gwf_ats03.py index b36908ef866..7685321011f 100644 --- a/autotest/test_gwf_ats03.py +++ b/autotest/test_gwf_ats03.py @@ -7,7 +7,6 @@ time zero and drops to 50.0 at time 100. So the constant head values, which are observed and written to and obs output file must fall on a line between (0, 100) and (100, 50), which is ensured by this test. - """ import os @@ -15,14 +14,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_ats03a"] +cases = ["gwf_ats03a"] nlay, nrow, ncol = 1, 1, 10 -def build_model(idx, dir): +def build_models(idx, test): perlen = [100.0] nper = len(perlen) nstp = [1] @@ -41,10 +40,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -191,11 +190,9 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - +def check_output(idx, test): # ensure obs2 (a constant head time series) drops linearly from 100 to 50 - fpth = os.path.join(sim.simpath, sim.name + ".obs.csv") + fpth = os.path.join(test.workspace, test.name + ".obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -207,16 +204,13 @@ def eval_flow(sim): assert np.allclose(answer, result), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ats_lak01.py b/autotest/test_gwf_ats_lak01.py index 5f2381c08f3..90d9a0ad55d 100644 --- a/autotest/test_gwf_ats_lak01.py +++ b/autotest/test_gwf_ats_lak01.py @@ -1,16 +1,18 @@ -# Same as test_gwf_lak01 except it uses ATS. Test works by trying a -# large time step that does not converge. ATS must then retry using -# a smaller time step. +""" +Same as test_gwf_lak01 except it uses ATS. Test works by trying a +large time step that does not converge. ATS must then retry using +a smaller time step. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_ats_lak_01a"] +cases = ["gwf_ats_lak_01a"] gwf = None @@ -21,7 +23,7 @@ def get_idomain(nlay, nrow, ncol, lakend): return idomain -def build_model(idx, dir): +def build_models(idx, test): lx = 300.0 lz = 45.0 nlay = 45 @@ -48,10 +50,10 @@ def build_model(idx, dir): nouter, ninner = 250, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -152,7 +154,7 @@ def build_model(idx, dir): irch[i, j] = k + 1 nlakeconn = len(lake_vconnect) - # pak_data = [lakeno, strt, nlakeconn] + # pak_data = [ifno, strt, nlakeconn] initial_stage = 0.1 pak_data = [(0, initial_stage, nlakeconn)] @@ -257,7 +259,7 @@ def make_plot_xsect(sim, headall, stageall): # ax.set_ylim(-10, 5) fname = "fig-xsect.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(sim.workspace, fname) plt.savefig(fname, bbox_inches="tight") @@ -274,7 +276,7 @@ def make_plot(sim, times, headall, stageall): ax.plot(times, h, "bo-", label="max head") fname = "fig-timeseries.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(sim.workspace, fname) plt.savefig(fname, bbox_inches="tight") @@ -288,19 +290,17 @@ def get_kij_from_node(node, nrow, ncol): return k, i, j -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - fname = sim.name + ".lak.bin" - fname = os.path.join(sim.simpath, fname) + fname = test.name + ".lak.bin" + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="STAGE") times = bobj.get_times() stage = bobj.get_alldata() - fname = sim.name + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = test.name + ".cbc" + fname = os.path.join(test.workspace, fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) times = bobj.get_times() idomain = gwf.dis.idomain.array @@ -308,7 +308,6 @@ def eval_results(sim): all_passed = True for itime, t in enumerate(times): - print(f"processing totim {t}") stage_current = stage[itime].flatten() print(f"lake stage = {stage_current}") @@ -343,8 +342,8 @@ def eval_results(sim): print(msg) assert all_passed, "found recharge applied to cell beneath active lake" - fname = sim.name + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = test.name + ".hds" + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata() @@ -410,16 +409,13 @@ def eval_results(sim): @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_auxvars.py b/autotest/test_gwf_auxvars.py index 412b53a8385..d80123906a4 100644 --- a/autotest/test_gwf_auxvars.py +++ b/autotest/test_gwf_auxvars.py @@ -1,18 +1,17 @@ import os -import sys import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["aux01"] +from framework import DNODATA, TestFramework + +cases = ["aux01"] auxvar1 = 101.0 auxvar2 = 102.0 -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 10, 10 nper = 3 perlen = [1.0, 1.0, 1.0] @@ -30,10 +29,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -176,15 +175,15 @@ def build_model(idx, dir): ) # sfr.remove() - # [] [] + # [] [] packagedata = [ [0, 100.0, 1, auxvar1, auxvar2, "lake1"], [1, 100.0, 1, auxvar1, auxvar2, "lake2"], ] - # + # connectiondata = [ - [0, 0, (0, 1, 1), "vertical", "none", 0.0, 0.0, 0.0, 0.0], - [1, 0, (0, 2, 2), "vertical", "none", 0.0, 0.0, 0.0, 0.0], + [0, 0, (0, 1, 1), "vertical", DNODATA, 0.0, 0.0, 0.0, 0.0], + [1, 0, (0, 2, 2), "vertical", DNODATA, 0.0, 0.0, 0.0, 0.0], ] lak = flopy.mf6.ModflowGwflak( gwf, @@ -202,14 +201,14 @@ def build_model(idx, dir): ) # lak.remove() - # [] + # [] packagedata = [ [0, (0, nrow - 1, 5), 1, -1, 0.1, 0.01, 0.01, 0.1, 0.01, 3.5, "uz1"], [1, (0, nrow - 1, 6), 1, -1, 0.1, 0.01, 0.01, 0.1, 0.01, 3.5, "uz1"], [2, (0, nrow - 1, 7), 1, -1, 0.1, 0.01, 0.01, 0.1, 0.01, 3.5, "uz1"], [3, (0, nrow - 1, 8), 1, -1, 0.1, 0.01, 0.01, 0.1, 0.01, 3.5, "uz1"], ] - # [] + # [] perioddata = [] for p in packagedata: perioddata.append( @@ -244,11 +243,9 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # maw budget aux variables - fpth = os.path.join(sim.simpath, "aux01.maw.bud") + fpth = os.path.join(test.workspace, "aux01.maw.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="auxiliary") for r in records: @@ -256,7 +253,7 @@ def eval_model(sim): assert np.allclose(r["AUX2"], auxvar2) # sfr budget aux variables - fpth = os.path.join(sim.simpath, "aux01.sfr.bud") + fpth = os.path.join(test.workspace, "aux01.sfr.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="auxiliary") for r in records: @@ -264,7 +261,7 @@ def eval_model(sim): assert np.allclose(r["AUX2"], auxvar2) # lak budget aux variables - fpth = os.path.join(sim.simpath, "aux01.maw.bud") + fpth = os.path.join(test.workspace, "aux01.maw.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="auxiliary") for r in records: @@ -272,7 +269,7 @@ def eval_model(sim): assert np.allclose(r["AUX2"], auxvar2) # uzf budget aux variables - fpth = os.path.join(sim.simpath, "aux01.uzf.bud") + fpth = os.path.join(test.workspace, "aux01.uzf.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="auxiliary") for r in records: @@ -280,7 +277,7 @@ def eval_model(sim): assert np.allclose(r["AUX2"], auxvar2) # gwf budget maw aux variables - fpth = os.path.join(sim.simpath, "aux01.cbc") + fpth = os.path.join(test.workspace, "aux01.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="maw") for r in records: @@ -300,16 +297,13 @@ def eval_model(sim): assert np.allclose(r["AUX2"], auxvar2) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_auxvars02.py b/autotest/test_gwf_auxvars02.py index c9ef34ee4d5..b7c82acf1a0 100644 --- a/autotest/test_gwf_auxvars02.py +++ b/autotest/test_gwf_auxvars02.py @@ -1,16 +1,15 @@ import os -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["aux02"] +cases = ["aux02"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 10, 10 nper = 3 perlen = [1.0, 1.0, 1.0] @@ -28,10 +27,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -107,11 +106,9 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # maw budget aux variables - fpth = os.path.join(sim.simpath, "aux02.bud") + fpth = os.path.join(test.workspace, "aux02.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="CHD") for r in records: @@ -120,16 +117,13 @@ def eval_model(sim): assert np.allclose(r[aname], a) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_boundname01.py b/autotest/test_gwf_boundname01.py index 8a5ac6050cb..e10fdc54fa1 100644 --- a/autotest/test_gwf_boundname01.py +++ b/autotest/test_gwf_boundname01.py @@ -3,26 +3,21 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "bndname01", ] -def build_model(idx, exdir): - - sim = get_model(idx, exdir) - - ws = os.path.join(exdir, "mf6") - mc = get_model(idx, ws) - +def build_models(idx, test): + sim = get_model(idx, test.workspace) + mc = get_model(idx, os.path.join(test.workspace, "mf6")) return sim, mc def get_model(idx, ws): - nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -51,7 +46,7 @@ def get_model(idx, ws): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( @@ -144,7 +139,7 @@ def get_model(idx, ws): def replace_quotes(idx, exdir): ws = os.path.join(exdir, "mf6") - gwfname = f"gwf_{ex[idx]}" + gwfname = f"gwf_{cases[idx]}" extensions = (".chd", ".chd.obs") for ext in extensions: fpth = os.path.join(ws, f"{gwfname}{ext}") @@ -155,14 +150,12 @@ def replace_quotes(idx, exdir): f.write(line.replace("'", '"').replace('face"s', "face's")) -def eval_obs(sim): - print("evaluating observations results..." f"({sim.name})") - - fpth = os.path.join(sim.simpath, f"gwf_{sim.name}.chd.obs.csv") +def check_output(idx, test): + fpth = os.path.join(test.workspace, f"gwf_{test.name}.chd.obs.csv") obs0 = np.genfromtxt(fpth, delimiter=",", names=True) names0 = obs0.dtype.names - fpth = os.path.join(sim.simpath, "mf6", f"gwf_{sim.name}.chd.obs.csv") + fpth = os.path.join(test.workspace, "mf6", f"gwf_{test.name}.chd.obs.csv") obs1 = np.genfromtxt(fpth, delimiter=",", names=True) names1 = obs1.dtype.names @@ -170,14 +163,13 @@ def eval_obs(sim): assert np.array_equal(obs0, obs1), "observations are not identical" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation(name=name, exe_dict=targets, idxsim=0), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_buy_lak01.py b/autotest/test_gwf_buy_lak01.py index 7a12bb2cffa..8641c87d8b7 100644 --- a/autotest/test_gwf_buy_lak01.py +++ b/autotest/test_gwf_buy_lak01.py @@ -1,28 +1,30 @@ -# Test the buoyancy package and the variable density flows between the lake -# and the gwf model. This model has 4 layers and a lake incised within it. -# The model is transient and has heads in the aquifer higher than the initial -# stage in the lake. As the model runs, the lake and aquifer equalize and -# should end up at the same level. The test ensures that the initial and -# final water volumes in the entire system are the same. There are three -# different cases: -# 1. No buoyancy package -# 2. Buoyancy package with lake and aquifer density = 1000. -# 3. Buoyancy package with lake and aquifer density = 1024.5 +""" +Test the buoyancy package and the variable density flows between the lake +and the gwf model. This model has 4 layers and a lake incised within it. +The model is transient and has heads in the aquifer higher than the initial +stage in the lake. As the model runs, the lake and aquifer equalize and +should end up at the same level. The test ensures that the initial and +final water volumes in the entire system are the same. There are three +different cases: + 1. No buoyancy package + 2. Buoyancy package with lake and aquifer density = 1000. + 3. Buoyancy package with lake and aquifer density = 1024.5 +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["buy_lak_01a"] # , 'buy_lak_01b', 'buy_lak_01c'] +cases = ["buy_lak_01a"] # , 'buy_lak_01b', 'buy_lak_01c'] buy_on_list = [False] # , True, True] concbuylist = [0.0] # , 0., 35.] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 4.0 nlay = 4 @@ -49,10 +51,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -130,14 +132,14 @@ def build_model(idx, dir): ) nlakeconn = 11 # note: number of connections for this lake - # pak_data = [lakeno, strt, nlakeconn, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, dense, boundname] pak_data = [(0, 2.25, nlakeconn, lake_dense)] connlen = delr / 2.0 connwidth = delc bedleak = "None" con_data = [ - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) (0, 0, (0, 0, 0), "HORIZONTAL", bedleak, 10, 10, connlen, connwidth), (0, 1, (1, 0, 1), "VERTICAL", bedleak, 10, 10, connlen, connwidth), (0, 2, (1, 0, 1), "HORIZONTAL", bedleak, 10, 10, connlen, connwidth), @@ -208,20 +210,18 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - gwfname = "gwf_" + sim.name + gwfname = "gwf_" + test.name fname = gwfname + ".lak.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="STAGE") stage = bobj.get_alldata().flatten() # print(stage) fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_data() @@ -252,16 +252,13 @@ def eval_results(sim): # assert False -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_buy_lak02.py b/autotest/test_gwf_buy_lak02.py index 514f3348da5..204cc382363 100644 --- a/autotest/test_gwf_buy_lak02.py +++ b/autotest/test_gwf_buy_lak02.py @@ -1,90 +1,285 @@ +""" +Test the buoyancy package and the variable density flows between the lake +and the gwf model. This model has 4 layers and a lake incised within it. +The model is transient and has heads in the aquifer higher than the initial +stage in the lake. As the model runs, the lake and aquifer equalize and +should end up at the same level. The test ensures that the initial and +final water volumes in the entire system are the same. This test is different +from the previous test in that transport is active. There are four +different cases: + 1. lak and aquifer have concentration of 0. + 2. lak and aquifer have concentration of 35. + 3. lak has concentration of 0., aquifer is 35. + 4. lak has concentration of 35., aquifer is 0. +""" + import os -from typing import NamedTuple import flopy import numpy as np +import pytest + from framework import TestFramework -from pytest_cases import parametrize, parametrize_with_cases -from simulation import TestSimulation - - -class GwfBuyLakCases: - """ - Test the buoyancy package and the variable density flows between the lake - and the gwf model. This model has 4 layers and a lake incised within it. - The model is transient and has heads in the aquifer higher than the initial - stage in the lake. As the model runs, the lake and aquifer equalize and - should end up at the same level. The test ensures that the initial and - final water volumes in the entire system are the same. This test is different - from the previous test in that transport is active. There are four - different cases: - 1. lak and aquifer have concentration of 0. - 2. lak and aquifer have concentration of 35. - 3. lak has concentration of 0., aquifer is 35. - 4. lak has concentration of 35., aquifer is 0. - """ - - class Data(NamedTuple): - name: str - gwt_conc: float - lak_conc: float - - @parametrize( - data=[ - Data(name="a", gwt_conc=0, lak_conc=0), - Data(name="b", gwt_conc=35, lak_conc=35), - Data(name="c", gwt_conc=35, lak_conc=0), - Data(name="d", gwt_conc=0, lak_conc=35), - ] + +simname = "gwfbuylak02" +cases = [ + f"{simname}a", + f"{simname}b", + f"{simname}c", + f"{simname}d", +] +gwt_conc = [0, 35, 35, 0] +lak_conc = [0, 35, 0, 35] + + +def build_models(idx, test): + name = cases[idx] + + lx = 7.0 + lz = 4.0 + nlay = 4 + nrow = 1 + ncol = 7 + nper = 1 + delc = 1.0 + delr = lx / ncol + delz = lz / nlay + top = 4.0 + botm = [3.0, 2.0, 1.0, 0.0] + + perlen = [50.0] + nstp = [50] + tsmult = [1.0] + + Kh = 1.0 + Kv = 1.0 + + tdis_rc = [] + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + + nouter, ninner = 700, 300 + hclose, rclose, relax = 1e-8, 1e-6, 0.97 + + # build MODFLOW 6 files + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=test.workspace, + ) + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc ) - def case_generator(self, data, function_tmpdir): - lx = 7.0 - lz = 4.0 - nlay = 4 - nrow = 1 - ncol = 7 - nper = 1 - delc = 1.0 - delr = lx / ncol - delz = lz / nlay - top = 4.0 - botm = [3.0, 2.0, 1.0, 0.0] - - perlen = [50.0] - nstp = [50] - tsmult = [1.0] - - Kh = 1.0 - Kv = 1.0 - - tdis_rc = [] - for i in range(nper): - tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - - nouter, ninner = 700, 300 - hclose, rclose, relax = 1e-8, 1e-6, 0.97 - - # build MODFLOW 6 files - sim = flopy.mf6.MFSimulation( - sim_name=data.name, - version="mf6", - exe_name="mf6", - sim_ws=str(function_tmpdir), - ) - # create tdis package - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=nper, perioddata=tdis_rc - ) - # create gwf model - gwfname = "gwf_" + data.name - gwtname = "gwt_" + data.name + # create gwf model + gwfname = "gwf_" + name + gwtname = "gwt_" + name + + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname, newtonoptions="NEWTON") + + imsgwf = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=f"{rclose} strict", + linear_acceleration="BICGSTAB", + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + filename=f"{gwfname}.ims", + ) - gwf = flopy.mf6.ModflowGwf( - sim, modelname=gwfname, newtonoptions="NEWTON" - ) + idomain = np.full((nlay, nrow, ncol), 1) + idomain[0, 0, 1:6] = 0 + idomain[1, 0, 2:5] = 0 + idomain[2, 0, 3:4] = 0 + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=idomain, + ) + + # initial conditions + strt = np.zeros((nlay, nrow, ncol), dtype=float) + strt[0, 0, :] = 3.5 + strt[1, 0, :] = 3.0 + strt[1, 0, 1:6] = 2.5 + strt[2, 0, :] = 2.0 + strt[3, 0, :] = 1.0 + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + xt3doptions=False, + save_flows=True, + save_specific_discharge=True, + icelltype=1, + k=Kh, + k33=Kv, + ) + + sto = flopy.mf6.ModflowGwfsto(gwf, sy=0.3, ss=0.0, iconvert=1) + + buy_on = True + if buy_on: + pd = [(0, 0.7, 0.0, gwtname, "CONCENTRATION")] + buy = flopy.mf6.ModflowGwfbuy(gwf, denseref=1000.0, packagedata=pd) + + nlakeconn = 11 # note: number of connections for this lake + # pak_data = [ifno, strt, nlakeconn, testauxvar, concentration, boundname] + pak_data = [(0, 2.25, nlakeconn, 0.0, 0.0)] + + connlen = delr / 2.0 + connwidth = delc + bedleak = "None" + con_data = [ + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + ( + 0, + 0, + (0, 0, 0), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + (0, 1, (1, 0, 1), "VERTICAL", bedleak, 10, 10, connlen, connwidth), + ( + 0, + 2, + (1, 0, 1), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + (0, 3, (2, 0, 2), "VERTICAL", bedleak, 10, 10, connlen, connwidth), + ( + 0, + 4, + (2, 0, 2), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + (0, 5, (3, 0, 3), "VERTICAL", bedleak, 10, 10, connlen, connwidth), + ( + 0, + 6, + (2, 0, 4), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + (0, 7, (2, 0, 4), "VERTICAL", bedleak, 10, 10, connlen, connwidth), + ( + 0, + 8, + (1, 0, 5), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + (0, 9, (1, 0, 5), "VERTICAL", bedleak, 10, 10, connlen, connwidth), + ( + 0, + 10, + (0, 0, 6), + "HORIZONTAL", + bedleak, + 10, + 10, + connlen, + connwidth, + ), + ] + + # period data + p_data = [ + (0, "STATUS", "ACTIVE"), + ] + + # note: for specifying lake number, use fortran indexing! + fname = f"{gwfname}.lak.obs.csv" + lak_obs = { + fname: [ + ("lakestage", "stage", 1), + ("lakevolume", "volume", 1), + ("lak1", "lak", 1, 1), + ("lak2", "lak", 1, 2), + ("lak3", "lak", 1, 3), + ("lak4", "lak", 1, 4), + ("lak5", "lak", 1, 5), + ("lak6", "lak", 1, 6), + ("lak7", "lak", 1, 7), + ("lak8", "lak", 1, 8), + ("lak9", "lak", 1, 9), + ("lak10", "lak", 1, 10), + ("lak11", "lak", 1, 11), + ], + "digits": 10, + } + + lak = flopy.mf6.modflow.ModflowGwflak( + gwf, + save_flows=True, + print_input=True, + print_flows=True, + print_stage=True, + stage_filerecord=f"{gwfname}.lak.bin", + budget_filerecord=f"{gwfname}.lak.bud", + nlakes=len(pak_data), + ntables=0, + packagedata=pak_data, + pname="LAK-1", + connectiondata=con_data, + perioddata=p_data, + observations=lak_obs, + auxiliary=["TESTAUXVAR", "CONCENTRATION"], + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwfname}.cbc", + head_filerecord=f"{gwfname}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + # create gwt model + transport = True + if transport: + gwt = flopy.mf6.ModflowGwt(sim, modelname=gwtname) - imsgwf = flopy.mf6.ModflowIms( + imsgwt = flopy.mf6.ModflowIms( sim, print_option="ALL", outer_dvclose=hclose, @@ -97,15 +292,12 @@ def case_generator(self, data, function_tmpdir): scaling_method="NONE", reordering_method="NONE", relaxation_factor=relax, - filename=f"{gwfname}.ims", + filename=f"{gwtname}.ims", ) + sim.register_ims_package(imsgwt, [gwt.name]) - idomain = np.full((nlay, nrow, ncol), 1) - idomain[0, 0, 1:6] = 0 - idomain[1, 0, 2:5] = 0 - idomain[2, 0, 3:4] = 0 - dis = flopy.mf6.ModflowGwfdis( - gwf, + dis = flopy.mf6.ModflowGwtdis( + gwt, nlay=nlay, nrow=nrow, ncol=ncol, @@ -117,363 +309,150 @@ def case_generator(self, data, function_tmpdir): ) # initial conditions - strt = np.zeros((nlay, nrow, ncol), dtype=float) - strt[0, 0, :] = 3.5 - strt[1, 0, :] = 3.0 - strt[1, 0, 1:6] = 2.5 - strt[2, 0, :] = 2.0 - strt[3, 0, :] = 1.0 - ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) - - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, - xt3doptions=False, - save_flows=True, - save_specific_discharge=True, - icelltype=1, - k=Kh, - k33=Kv, - ) + ic = flopy.mf6.ModflowGwtic(gwt, strt=gwt_conc[idx]) - sto = flopy.mf6.ModflowGwfsto(gwf, sy=0.3, ss=0.0, iconvert=1) - - buy_on = True - if buy_on: - pd = [(0, 0.7, 0.0, gwtname, "CONCENTRATION")] - buy = flopy.mf6.ModflowGwfbuy(gwf, denseref=1000.0, packagedata=pd) - - nlakeconn = 11 # note: number of connections for this lake - # pak_data = [lakeno, strt, nlakeconn, testauxvar, concentration, boundname] - pak_data = [(0, 2.25, nlakeconn, 0.0, 0.0)] - - connlen = delr / 2.0 - connwidth = delc - bedleak = "None" - con_data = [ - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) - ( - 0, - 0, - (0, 0, 0), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - (0, 1, (1, 0, 1), "VERTICAL", bedleak, 10, 10, connlen, connwidth), - ( - 0, - 2, - (1, 0, 1), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - (0, 3, (2, 0, 2), "VERTICAL", bedleak, 10, 10, connlen, connwidth), - ( - 0, - 4, - (2, 0, 2), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - (0, 5, (3, 0, 3), "VERTICAL", bedleak, 10, 10, connlen, connwidth), - ( - 0, - 6, - (2, 0, 4), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - (0, 7, (2, 0, 4), "VERTICAL", bedleak, 10, 10, connlen, connwidth), - ( - 0, - 8, - (1, 0, 5), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - (0, 9, (1, 0, 5), "VERTICAL", bedleak, 10, 10, connlen, connwidth), - ( - 0, - 10, - (0, 0, 6), - "HORIZONTAL", - bedleak, - 10, - 10, - connlen, - connwidth, - ), - ] + # advection + adv = flopy.mf6.ModflowGwtadv(gwt, scheme="UPSTREAM") - # period data - p_data = [ - (0, "STATUS", "ACTIVE"), - ] + # storage + porosity = 0.30 + sto = flopy.mf6.ModflowGwtmst(gwt, porosity=porosity) - # note: for specifying lake number, use fortran indexing! - fname = f"{gwfname}.lak.obs.csv" - lak_obs = { - fname: [ - ("lakestage", "stage", 1), - ("lakevolume", "volume", 1), - ("lak1", "lak", 1, 1), - ("lak2", "lak", 1, 2), - ("lak3", "lak", 1, 3), - ("lak4", "lak", 1, 4), - ("lak5", "lak", 1, 5), - ("lak6", "lak", 1, 6), - ("lak7", "lak", 1, 7), - ("lak8", "lak", 1, 8), - ("lak9", "lak", 1, 9), - ("lak10", "lak", 1, 10), - ("lak11", "lak", 1, 11), - ], - "digits": 10, - } + # sources + sourcerecarray = [ + (), + ] + ssm = flopy.mf6.ModflowGwtssm(gwt, sources=sourcerecarray) - lak = flopy.mf6.modflow.ModflowGwflak( - gwf, + lktpackagedata = [ + (0, lak_conc[idx], 99.0, 999.0, "mylake"), + ] + lkt = flopy.mf6.modflow.ModflowGwtlkt( + gwt, + boundnames=True, save_flows=True, print_input=True, print_flows=True, - print_stage=True, - stage_filerecord=f"{gwfname}.lak.bin", - budget_filerecord=f"{gwfname}.lak.bud", - nlakes=len(pak_data), - ntables=0, - packagedata=pak_data, - pname="LAK-1", - connectiondata=con_data, - perioddata=p_data, - observations=lak_obs, - auxiliary=["TESTAUXVAR", "CONCENTRATION"], + print_concentration=True, + concentration_filerecord=gwtname + ".lkt.bin", + budget_filerecord="gwtlak1.bud", + packagedata=lktpackagedata, + pname="LKT-1", + flow_package_name="LAK-1", + flow_package_auxiliary_name="CONCENTRATION", + auxiliary=["aux1", "aux2"], ) - # output control - oc = flopy.mf6.ModflowGwfoc( - gwf, - budget_filerecord=f"{gwfname}.cbc", - head_filerecord=f"{gwfname}.hds", - headprintrecord=[ + oc = flopy.mf6.ModflowGwtoc( + gwt, + budget_filerecord=f"{gwtname}.cbc", + concentration_filerecord=f"{gwtname}.ucn", + concentrationprintrecord=[ ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") ], - saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + saverecord=[("CONCENTRATION", "ALL")], + printrecord=[("CONCENTRATION", "ALL"), ("BUDGET", "ALL")], ) - # create gwt model - transport = True - if transport: - gwt = flopy.mf6.ModflowGwt(sim, modelname=gwtname) - - imsgwt = flopy.mf6.ModflowIms( - sim, - print_option="ALL", - outer_dvclose=hclose, - outer_maximum=nouter, - under_relaxation="NONE", - inner_maximum=ninner, - inner_dvclose=hclose, - rcloserecord=f"{rclose} strict", - linear_acceleration="BICGSTAB", - scaling_method="NONE", - reordering_method="NONE", - relaxation_factor=relax, - filename=f"{gwtname}.ims", - ) - sim.register_ims_package(imsgwt, [gwt.name]) - - dis = flopy.mf6.ModflowGwtdis( - gwt, - nlay=nlay, - nrow=nrow, - ncol=ncol, - delr=delr, - delc=delc, - top=top, - botm=botm, - idomain=idomain, - ) - - # initial conditions - strt = data.gwt_conc - ic = flopy.mf6.ModflowGwtic(gwt, strt=strt) - - # advection - adv = flopy.mf6.ModflowGwtadv(gwt, scheme="UPSTREAM") - - # storage - porosity = 0.30 - sto = flopy.mf6.ModflowGwtmst(gwt, porosity=porosity) - - # sources - sourcerecarray = [ - (), - ] - ssm = flopy.mf6.ModflowGwtssm(gwt, sources=sourcerecarray) - - lak_conc = data.lak_conc - lktpackagedata = [ - (0, lak_conc, 99.0, 999.0, "mylake"), - ] - lkt = flopy.mf6.modflow.ModflowGwtlkt( - gwt, - boundnames=True, - save_flows=True, - print_input=True, - print_flows=True, - print_concentration=True, - concentration_filerecord=gwtname + ".lkt.bin", - budget_filerecord="gwtlak1.bud", - packagedata=lktpackagedata, - pname="LKT-1", - flow_package_name="LAK-1", - flow_package_auxiliary_name="CONCENTRATION", - auxiliary=["aux1", "aux2"], - ) - # output control - oc = flopy.mf6.ModflowGwtoc( - gwt, - budget_filerecord=f"{gwtname}.cbc", - concentration_filerecord=f"{gwtname}.ucn", - concentrationprintrecord=[ - ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") - ], - saverecord=[("CONCENTRATION", "ALL")], - printrecord=[("CONCENTRATION", "ALL"), ("BUDGET", "ALL")], - ) - - fmi = flopy.mf6.ModflowGwtfmi(gwt, flow_imbalance_correction=True) - - # GWF GWT exchange - gwfgwt = flopy.mf6.ModflowGwfgwt( - sim, - exgtype="GWF6-GWT6", - exgmnamea=gwfname, - exgmnameb=gwtname, - filename=f"{data.name}.gwfgwt", - ) - - return data, sim, None, self.eval_results - - def eval_results(self, sim, data): - print("evaluating results...") - - # calculate volume of water and make sure it is conserved - gwfname = "gwf_" + data.name - gwtname = "gwt_" + data.name - fname = gwfname + ".lak.bin" - fname = os.path.join(sim.simpath, fname) - assert os.path.isfile(fname) - bobj = flopy.utils.HeadFile(fname, text="STAGE") - stage = bobj.get_alldata().flatten() - # print(stage) - - fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) - assert os.path.isfile(fname) - hobj = flopy.utils.HeadFile(fname) - head = hobj.get_data() - # print(head) - - fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) - assert os.path.isfile(fname) - cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") - conc = cobj.get_data() - - fname = gwtname + ".lkt.bin" - fname = os.path.join(sim.simpath, fname) - assert os.path.isfile(fname) - cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") - clak = cobj.get_data().flatten() - - # calculate initial water volume - v0 = 3.5 * 2 # outermost columns - v0 += 2.5 * 2 # next innermost columns - v0 += 2.0 * 2 # next innermost columns - v0 += 1.0 * 1 # middle column - v0 = v0 * 0.3 # specific yield - - m0 = v0 * data.gwt_conc - vl0 = (2.25 - 2.0) * 2 + (2.25 - 1.0) - m0 += vl0 * data.lak_conc - v0 += vl0 - print(f"initial volume of water in model = {v0}") - print(f"initial mass of solute in model = {m0}") - - # calculate ending water volume in model - head = np.where(head > 1e10, -1e10, head) - botm = [3, 2, 1, 0] - top = [4, 3, 2, 1] - nlay, nrow, ncol = head.shape - v = 0 - m = 0.0 - for k in range(nlay): - for i in range(nrow): - for j in range(ncol): - h = min(head[k, i, j], top[k]) - dz = h - botm[k] - vcell = max(dz, 0.0) * 0.3 - v += vcell - m += vcell * conc[k, i, j] - - s = stage[-1] - vl = (s - 2.0) * 2 + (s - 1.0) - v = v + vl - m += vl * clak[0] - print(f"final volume of water in model = {v}") - print(f"final mass of solute in model = {m}") - - # check to make sure starting water volume same as equalized final volume - errmsg = f"initial and final water volume not equal: {v0} {v}" - assert np.allclose(v0, v), errmsg - - # check to make sure starting starting solute mass same as equalized solute mass - errmsg = f"initial and final solute mass not equal: {m0} {m}" - assert np.allclose(m0, m), errmsg - - # todo: add a better check of the lake concentrations - - -@parametrize_with_cases( - "case", - cases=[ - GwfBuyLakCases, - ], -) -def test_mf6model(case, targets): - data, sim, cmp, evl = case - sim.write_simulation() - if cmp: - cmp.write_simulation() - - simulation = TestSimulation( - name=data.name, exe_dict=targets, exfunc=evl, idxsim=0 - ) - simulation.set_model( - sim.simulation_data.mfpath.get_sim_path(), testModel=False + fmi = flopy.mf6.ModflowGwtfmi(gwt, flow_imbalance_correction=True) + + # GWF GWT exchange + gwfgwt = flopy.mf6.ModflowGwfgwt( + sim, + exgtype="GWF6-GWT6", + exgmnamea=gwfname, + exgmnameb=gwtname, + filename=f"{name}.gwfgwt", + ) + + return sim + + +def check_output(idx, test): + # calculate volume of water and make sure it is conserved + gwfname = "gwf_" + test.name + gwtname = "gwt_" + test.name + fname = gwfname + ".lak.bin" + fname = os.path.join(test.workspace, fname) + assert os.path.isfile(fname) + bobj = flopy.utils.HeadFile(fname, text="STAGE") + stage = bobj.get_alldata().flatten() + # print(stage) + + fname = gwfname + ".hds" + fname = os.path.join(test.workspace, fname) + assert os.path.isfile(fname) + hobj = flopy.utils.HeadFile(fname) + head = hobj.get_data() + # print(head) + + fname = gwtname + ".ucn" + fname = os.path.join(test.workspace, fname) + assert os.path.isfile(fname) + cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") + conc = cobj.get_data() + + fname = gwtname + ".lkt.bin" + fname = os.path.join(test.workspace, fname) + assert os.path.isfile(fname) + cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") + clak = cobj.get_data().flatten() + + # calculate initial water volume + v0 = 3.5 * 2 # outermost columns + v0 += 2.5 * 2 # next innermost columns + v0 += 2.0 * 2 # next innermost columns + v0 += 1.0 * 1 # middle column + v0 = v0 * 0.3 # specific yield + + m0 = v0 * gwt_conc[idx] + vl0 = (2.25 - 2.0) * 2 + (2.25 - 1.0) + m0 += vl0 * lak_conc[idx] + v0 += vl0 + print(f"initial volume of water in model = {v0}") + print(f"initial mass of solute in model = {m0}") + + # calculate ending water volume in model + head = np.where(head > 1e10, -1e10, head) + botm = [3, 2, 1, 0] + top = [4, 3, 2, 1] + nlay, nrow, ncol = head.shape + v = 0 + m = 0.0 + for k in range(nlay): + for i in range(nrow): + for j in range(ncol): + h = min(head[k, i, j], top[k]) + dz = h - botm[k] + vcell = max(dz, 0.0) * 0.3 + v += vcell + m += vcell * conc[k, i, j] + + s = stage[-1] + vl = (s - 2.0) * 2 + (s - 1.0) + v = v + vl + m += vl * clak[0] + print(f"final volume of water in model = {v}") + print(f"final mass of solute in model = {m}") + + # check to make sure starting water volume same as equalized final volume + errmsg = f"initial and final water volume not equal: {v0} {v}" + assert np.allclose(v0, v), errmsg + + # check to make sure starting starting solute mass same as equalized solute mass + errmsg = f"initial and final solute mass not equal: {m0} {m}" + assert np.allclose(m0, m), errmsg + + # todo: add a better check of the lake concentrations + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, targets, function_tmpdir): + framework = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) - simulation.run() - simulation.compare() - evl(simulation, data) + framework.run() diff --git a/autotest/test_gwf_buy_maw01.py b/autotest/test_gwf_buy_maw01.py index 09e96b37579..8def29a12ae 100644 --- a/autotest/test_gwf_buy_maw01.py +++ b/autotest/test_gwf_buy_maw01.py @@ -1,29 +1,30 @@ -# Test the buoyancy package and the variable density flows between maw -# and the gwf model. This model has 4 layers with a single maw. -# The model is transient and has heads in the aquifer higher than the initial -# stage in the well. As the model runs, the well and aquifer equalize and -# should end up at the same level. The test ensures that the initial and -# final water volumes in the entire system are the same. There are three -# different cases: -# 1. No buoyancy package -# 2. Buoyancy package with maw and aquifer density = 1000. -# 3. Buoyancy package with maw and aquifer density = 1024.5 +""" +Test the buoyancy package and the variable density flows between maw +and the gwf model. This model has 4 layers with a single maw. +The model is transient and has heads in the aquifer higher than the initial +stage in the well. As the model runs, the well and aquifer equalize and +should end up at the same level. The test ensures that the initial and +final water volumes in the entire system are the same. There are three +different cases: + 1. No buoyancy package + 2. Buoyancy package with maw and aquifer density = 1000. + 3. Buoyancy package with maw and aquifer density = 1024.5 +""" import os -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["buy_maw_01a"] # , 'buy_maw_01b', 'buy_maw_01c'] +cases = ["buy_maw_01a"] # , 'buy_maw_01b', 'buy_maw_01c'] buy_on_list = [False] # , True, True] concbuylist = [0.0] # , 0., 35.] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 4.0 nlay = 4 @@ -50,10 +51,10 @@ def build_model(idx, dir): nouter, ninner = 700, 10 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -128,16 +129,16 @@ def build_model(idx, dir): mawstrt = 3.5 mawcondeqn = "THIEM" mawngwfnodes = nlay - # + # mawpackagedata = [ [0, mawradius, mawbottom, mawstrt, mawcondeqn, mawngwfnodes, mawdense] ] - # + # mawconnectiondata = [ [0, icon, (icon, 0, 0), top, mawbottom, -999.0, -999.0] for icon in range(nlay) ] - # + # mawperioddata = [[0, "STATUS", "ACTIVE"]] maw = flopy.mf6.ModflowGwfmaw( gwf, @@ -185,19 +186,17 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - gwfname = "gwf_" + sim.name + gwfname = "gwf_" + test.name fname = gwfname + ".maw.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="HEAD") stage = bobj.get_alldata().flatten() fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata() @@ -214,7 +213,6 @@ def eval_results(sim): # calculate current volume of water in well and aquifer and compare with # initial volume for kstp, mawstage in enumerate(stage): - vgwf = 0 for k in range(nlay): for j in range(ncol): @@ -229,13 +227,13 @@ def eval_results(sim): # compare the maw-gwf flows in maw budget file with the gwf-maw flows in # gwf budget file. Values should be the same but reversed in sign fname = gwfname + ".maw.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mbud = flopy.utils.CellBudgetFile(fname, precision="double") maw_gwf = mbud.get_data(text="GWF") fname = gwfname + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gbud = flopy.utils.CellBudgetFile(fname, precision="double") gwf_maw = gbud.get_data(text="MAW") @@ -251,16 +249,13 @@ def eval_results(sim): assert np.allclose(qmaw, -qgwf), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_buy_sfr01.py b/autotest/test_gwf_buy_sfr01.py index 24f9bb12122..cf49f0d198b 100644 --- a/autotest/test_gwf_buy_sfr01.py +++ b/autotest/test_gwf_buy_sfr01.py @@ -1,19 +1,20 @@ -# Simple one-layer model with sfr on top. Purpose is to test buy package in a -# one-d sfr network. +""" +Simple one-layer model with sfr on top. Purpose is to test buy package in a +one-d sfr network. +""" import os -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["buy_sfr_01"] +cases = ["buy_sfr_01"] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -44,10 +45,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -372,16 +373,14 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # assign names - gwtname = "gwt_" + sim.name - gwfname = "gwf_" + sim.name + gwtname = "gwt_" + test.name + gwfname = "gwf_" + test.name # load the sft concentrations and make sure all values are correct fname = gwtname + ".sft.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") csftall = cobj.get_alldata() @@ -391,21 +390,21 @@ def eval_results(sim): # load the aquifer concentrations fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") cgwfall = cobj.get_alldata() cgwf = cgwfall[-2].flatten() # load the aquifer heads fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) hobj = flopy.utils.HeadFile(fname, text="HEAD") headall = hobj.get_alldata() head = headall[-1].flatten() # load the sfr budget file and get sfr/gwf flows fname = gwfname + ".sfr.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) qsfrgwfsimall = bobj.get_data(text="GWF") @@ -415,7 +414,7 @@ def eval_results(sim): # load the sfr budget and check to make sure that concentrations are set # correctly from sft concentrations fname = gwfname + ".sfr.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) b = bobj.get_data(text="AUXILIARY") @@ -427,7 +426,7 @@ def eval_results(sim): # load the sfr stage file # load the aquifer concentrations and make sure all values are correct fname = gwfname + ".sfr.stg" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) stgobj = flopy.utils.HeadFile(fname, text="STAGE") stageall = stgobj.get_alldata() stage = stageall[-1] @@ -457,13 +456,13 @@ def eval_results(sim): ), f"reach {n} flow {qcalc} not equal {qsim}" -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_chd01.py b/autotest/test_gwf_chd01.py index 0dabc3ac06d..0ee33dab664 100644 --- a/autotest/test_gwf_chd01.py +++ b/autotest/test_gwf_chd01.py @@ -3,15 +3,15 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "chd01", ] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -34,10 +34,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -118,12 +118,10 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_data().flatten() @@ -134,13 +132,13 @@ def eval_model(sim): ), "simulated head do not match with known solution." -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_chd02.py b/autotest/test_gwf_chd02.py index 019a00917d4..af30d11a1b1 100644 --- a/autotest/test_gwf_chd02.py +++ b/autotest/test_gwf_chd02.py @@ -4,18 +4,18 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "chd02", ] -def build_model(idx, workspace): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] nlay, nrow, ncol = 1, 1, 10 - sim = flopy.mf6.MFSimulation(sim_ws=workspace, sim_name=name) + sim = flopy.mf6.MFSimulation(sim_ws=test.workspace, sim_name=name) flopy.mf6.ModflowTdis(sim) flopy.mf6.ModflowIms(sim, complexity="simple") gwf = flopy.mf6.ModflowGwf(sim, modelname=name, print_input=True) @@ -38,8 +38,8 @@ def build_model(idx, workspace): strt=10.0, ) chd_data = [ - (0, 0, 0, 10.0, 1.0, 100.), - (0, 0, ncol - 1, 5.0, 0.0, 100.), + (0, 0, 0, 10.0, 1.0, 100.0), + (0, 0, ncol - 1, 5.0, 0.0, 100.0), ] chd_data = { 0: { @@ -63,12 +63,10 @@ def build_model(idx, workspace): return sim, None -def eval_model(sim): - print("evaluating model...") - - name = sim.name +def check_output(idx, test): + name = test.name - fpth = os.path.join(sim.simpath, f"{name}.hds") + fpth = os.path.join(test.workspace, f"{name}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_data().flatten() @@ -92,13 +90,13 @@ def eval_model(sim): ), "simulated head does not match with known solution." -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_db01_nr.py b/autotest/test_gwf_csub_db01_nr.py index 58b16e09d05..7f96b7707c0 100644 --- a/autotest/test_gwf_csub_db01_nr.py +++ b/autotest/test_gwf_csub_db01_nr.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ( +cases = ( "csub_db01a", "csub_db01b", "csub_db01c", @@ -59,10 +59,10 @@ nlay, nrow, ncol = 2, 1, 2 nper = 3 tsp0 = 1.0 -perlen = [tsp0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [200 for i in range(nper - 1)] -tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [tsp0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [200 for _ in range(nper - 1)] +tsmult = [1.0] + [1.0 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] delr, delc = 1000.0, 1000.0 top = 0.0 botm = [-10.0, -20.0] @@ -81,8 +81,8 @@ hclose, rclose, relax = 1e-9, 1e-3, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -106,12 +106,12 @@ H0 = 0.0 -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] newton = newtons[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -323,18 +323,16 @@ def build_model(idx, dir): return sim, None -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -346,11 +344,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -363,13 +361,13 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) for idx, key in enumerate(bud_lst): @@ -379,48 +377,41 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol, - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol, ) + test.run() diff --git a/autotest/test_gwf_csub_dbgeo01.py b/autotest/test_gwf_csub_dbgeo01.py index c899557c3a8..2f49d4299ac 100644 --- a/autotest/test_gwf_csub_dbgeo01.py +++ b/autotest/test_gwf_csub_dbgeo01.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_dbgeo01a"] +cases = ["csub_dbgeo01a"] ndcell = [19] strt = [0.0] chdh = [0] @@ -130,13 +130,13 @@ # temporal discretization nper = 1 -perlen = [1000.0 for i in range(nper)] -nstp = [100 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [1000.0 for _ in range(nper)] +nstp = [100 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) hnoflo = 1e30 hdry = -1e30 @@ -190,7 +190,7 @@ def calc_stress(sgm0, sgs0, h, bt): return geo, es -def build_model(idx, dir): +def build_models(idx, test): c6 = [] for j in range(0, ncol, 2): c6.append([(0, 0, j), chdh[idx]]) @@ -199,10 +199,10 @@ def build_model(idx, dir): geo, es = calc_stress(sgm, sgs, strt[idx], botm) sub6 = [[0, (0, 0, 1), "delay", -1.0, thick, 1.0, cc, cr, theta, kv, 1.0]] - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -312,11 +312,9 @@ def build_model(idx, dir): return sim, mc -def eval_sub(sim): - print("evaluating subsidence...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -333,36 +331,37 @@ def eval_sub(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc0[i]:15g}" - line += f" {tc['TCOMP'][i]:15g}" - line += f" {tc0[i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc0[i]:15g}" + line += f" {tc['TCOMP'][i]:15g}" + line += f" {tc0[i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation(name=name, exe_dict=targets, exfunc=eval_sub, idxsim=0), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_distypes.py b/autotest/test_gwf_csub_distypes.py new file mode 100644 index 00000000000..dd29974a020 --- /dev/null +++ b/autotest/test_gwf_csub_distypes.py @@ -0,0 +1,435 @@ +import pathlib as pl + +import flopy +import numpy as np +import pytest +from flopy.utils.gridgen import Gridgen + +from conftest import try_get_target +from framework import TestFramework + +cases = ["csub_dis", "csub_disv", "csub_disu", "csub_disu01", "csub_disu02"] +ex_dict = {name: None for name in cases} +ex_dict["csub_disu01"] = 0 +ex_dict["csub_disu02"] = 2 +paktest = "csub" + +# temporal discretization +nper = 2 +perlen = [1.0, 100.0] +nstp = [1, 10] +tsmult = [1.0] * nper +tdis_rc = [] +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + +# base spatial discretization +nlay, nrow, ncol = 3, 9, 9 +refinement_level = 2 +nrow_refined, ncol_refined = nrow * refinement_level, ncol * refinement_level +shape3d = (nlay, nrow, ncol) +shape3d_refined = (nlay, nrow_refined, ncol_refined) +shape2d = (nrow, ncol) +shape2d_refined = (nrow_refined, ncol_refined) +size3d = nlay * nrow * ncol +size3d_refined = nlay * nrow_refined * ncol_refined +size2d = nrow * ncol +size2d_refined = nrow_refined * ncol_refined + +delr = delc = 1000.0 +top = 0.0 +bot = -100.0 +dz = (top - bot) / nlay +botm = [top - k * dz for k in range(1, nlay + 1)] +z_node = [z + 0.5 * dz for z in botm] + +delr_refined = delr / refinement_level +delc_refined = delc / refinement_level + +hk = [1.0, 0.001, 1.0] +sy = [0.25, 0.45, 0.25] +ss = [5e-5, 5e-4, 5e-5] + +well_coordinates = ( + np.array([(4.25, 4.25), (4.25, 4.75), (4.75, 4.75), (4.75, 4.25)]) * delr +) +wellq = -1000.0 + +nouter, ninner = 100, 300 +dvclose, rclose, relax = 1e-6, 0.01, 0.97 + +# subwt data +cc = 0.25 +cr = 0.25 +void = 0.82 +theta = void / (1.0 + void) +kv = 999.0 +sgm = 1.7 +sgs = 2.0 + +beta = 0.0 +# beta = 4.65120000e-10 +gammaw = 9806.65000000 + + +def get_interbed(modelgrid): + grid_type = modelgrid.grid_type + ia = [] + x0, x1, y0, y1 = modelgrid.extent + for k in range(1, nlay, 1): + cellid = modelgrid.intersect(x0 + 0.1, y1 - 0.1, z=z_node[k]) + ia.append(get_node_number(modelgrid, cellid)) + + package_data = [] + ifno = 0 + ini_stress = 0.0 + + nodes = [node for node in range(ia[0], ia[1])] + if grid_type == "structured": + cellids = modelgrid.get_lrc(nodes) + elif grid_type == "vertex": + cellids = modelgrid.get_lni(nodes) + else: + cellids = [(node,) for node in nodes] + + for cellid in cellids: + rnb = 1.0 + vk = 999.0 + package_data.append( + ( + ifno, + cellid, # will need to be detuplaized with *cellid - does not work for dis + "nodelay", + ini_stress, + modelgrid.cell_thickness[cellid], + rnb, + ss[1], + ss[1] * 1000.0, + theta, + vk, + top, + ) + ) + ifno += 1 + return package_data + + +def build_dis(gwf): + return flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + ) + + +def get_gridgen_ws(ws): + gridgen_ws = ws / "gridgen" + gridgen_ws.mkdir(parents=True, exist_ok=True) + return gridgen_ws + + +def build_temp_gwf(ws): + gridgen_ws = get_gridgen_ws(ws) + gridgen_sim = flopy.mf6.MFSimulation( + sim_name="gridgen", sim_ws=gridgen_ws, exe_name="mf6" + ) + gridgen_gwf = flopy.mf6.ModflowGwf(gridgen_sim, modelname="gridgen") + return gridgen_gwf + + +def build_disv(ws, gwf, gridgen): + temp_gwf = build_temp_gwf(ws) + dis = build_dis(temp_gwf) + g = Gridgen( + temp_gwf.modelgrid, + model_ws=get_gridgen_ws(ws), + exe_name=gridgen, + ) + g.build() + gridprops = g.get_gridprops_disv() + return flopy.mf6.ModflowGwfdisv(gwf, **gridprops) + + +def build_disu(ws, gwf, refinement_layer, gridgen): + temp_gwf = build_temp_gwf(ws) + dis = build_dis(temp_gwf) + g = Gridgen( + temp_gwf.modelgrid, + model_ws=get_gridgen_ws(ws), + exe_name=gridgen, + ) + if refinement_layer is not None: + x0, x1, y0, y1 = temp_gwf.modelgrid.extent + polys = [[[(x0, y0), (x1, y0), (x1, y1), (x0, y1), (x0, y0)]]] + g.add_refinement_features( + polys, + "polygon", + 1, + layers=[refinement_layer], + ) + g.build() + gridprops = g.get_gridprops_disu6() + return flopy.mf6.ModflowGwfdisu(gwf, **gridprops) + + +def get_node_number(modelgrid, cellid): + if modelgrid.grid_type == "unstructured": + node = cellid + elif modelgrid.grid_type == "vertex": + node = modelgrid.ncpl * cellid[0] + cellid[1] + else: + node = ( + modelgrid.nrow * modelgrid.ncol * cellid[0] + + modelgrid.ncol * cellid[1] + + cellid[2] + ) + return node + + +def build_3d_array(modelgrid, values, dtype=float): + if isinstance(values, dtype): + arr = np.full(modelgrid.nnodes, values, dtype=dtype) + else: + arr = np.zeros(modelgrid.nnodes, dtype=dtype) + ia = [] + x0, x1, y0, y1 = modelgrid.extent + for k in range(nlay): + cellid = modelgrid.intersect(x0 + 0.1, y1 - 0.1, z=z_node[k]) + ia.append(get_node_number(modelgrid, cellid)) + ia.append(modelgrid.nnodes + 1) + for k in range(nlay): + arr[ia[k] : ia[k + 1]] = values[k] + return arr.reshape(modelgrid.shape) + + +def build_well_data(modelgrid): + well_spd = [] + for x, y in well_coordinates: + cellid = modelgrid.intersect(x, y, z=z_node[-1]) + if isinstance(cellid, tuple): + well_spd.append((*cellid, wellq)) + else: + well_spd.append((cellid, wellq)) + return {1: well_spd} + + +def build_models(idx, test): + gridgen = try_get_target(test.targets, "gridgen") + return build_mf6(idx, test.workspace, gridgen), None + + +# build MODFLOW 6 files +def build_mf6(idx, ws, gridgen): + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, + ) + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=nper, + perioddata=tdis_rc, + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=dvclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=dvclose, + rcloserecord=rclose, + linear_acceleration="CG", + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=name, + print_input=True, + save_flows=True, + ) + + if "disv" in name: + dis = build_disv(ws, gwf, gridgen) + elif "disu" in name: + dis = build_disu(ws, gwf, ex_dict[name], gridgen) + else: + dis = build_dis(gwf) + + # initial conditions + ic = flopy.mf6.ModflowGwfic( + gwf, + strt=top, + ) + + k11 = build_3d_array(gwf.modelgrid, hk) + icelltype = build_3d_array(gwf.modelgrid, [1, 0, 0], dtype=int) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + icelltype=icelltype, + k=k11, + k33=k11, + ) + + # storage + sy_arr = build_3d_array(gwf.modelgrid, sy) + sto = flopy.mf6.ModflowGwfsto( + gwf, + iconvert=icelltype, + ss=0.0, + sy=sy_arr, + transient={0: True}, + ) + + # well + wel = flopy.mf6.ModflowGwfwel( + gwf, + stress_period_data=build_well_data(gwf.modelgrid), + save_flows=False, + ) + + # csub + cg_ske_cr = build_3d_array(gwf.modelgrid, ss) + packagedata = get_interbed(gwf.modelgrid) + + csub = flopy.mf6.ModflowGwfcsub( + gwf, + zdisplacement_filerecord=f"{name}.csub.zdis.bin", + compaction_filerecord=f"{name}.csub.comp.bin", + ninterbeds=len(packagedata), + sgs=sgs, + sgm=sgm, + beta=beta, + gammaw=gammaw, + cg_ske_cr=cg_ske_cr, + cg_theta=theta, + packagedata=packagedata, + ) + # orecarray = {} + # orecarray["csub_obs.csv"] = [ + # ("wc01", "compaction-cell", (1, 5, 8)), + # ("wc02", "compaction-cell", (3, 6, 11)), + # ] + # csub_obs_package = csub.obs.initialize( + # filename=opth, digits=10, print_input=True, continuous=orecarray + # ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + return sim + + +def check_output(idx, test): + name = cases[idx] + ws = pl.Path(test.workspace) + test = flopy.mf6.MFSimulation.load(sim_name=name, sim_ws=ws) + gwf = test.get_model() + x0, x1, y0, y1 = gwf.modelgrid.extent + + comp_obj = flopy.utils.HeadFile( + ws / f"{name}.csub.comp.bin", + text="CSUB-COMPACTION", + precision="double", + ) + zdis_obj = flopy.utils.HeadFile( + ws / f"{name}.csub.zdis.bin", + text="CSUB-ZDISPLACE", + precision="double", + ) + + layer_refinement = ex_dict[name] + + # create reusable mapping dictionary so it can be used for all time step + # with refined disu grids - which do not have naturally ordered node + # numbers in refined layers + map_dict = {} + if layer_refinement is not None: + z = z_node[layer_refinement] + icnt = 0 + for i in range(nrow_refined): + y = y1 - delc_refined * (i + 0.5) + for j in range(ncol_refined): + x = x0 + delr_refined * (j + 0.5) + node = gwf.modelgrid.intersect(x, y, z=z) + map_dict[icnt] = {"node": node, "cellid": (i, j)} + icnt += 1 + + for totim in comp_obj.get_times(): + if layer_refinement is None: + comp = comp_obj.get_data(totim=totim).flatten().reshape(shape3d) + zdis = zdis_obj.get_data(totim=totim).flatten().reshape(shape3d) + else: + comp1d = comp_obj.get_data(totim=totim).squeeze() + zdis1d = zdis_obj.get_data(totim=totim).squeeze() + ia = [0] + for k in range(nlay): + if k == layer_refinement: + ia.append(ia[k] + size2d_refined) + else: + ia.append(ia[k] + size2d) + + comp = np.zeros(shape3d, dtype=float) + zdis = np.zeros(shape3d, dtype=float) + for k in range(nlay): + ia0 = ia[k] + ia1 = ia[k + 1] + comp_slice = comp1d[ia0:ia1].copy() + zdis_slice = zdis1d[ia0:ia1].copy() + if k == layer_refinement: + comp_temp = np.zeros(shape2d_refined, dtype=float) + zdis_temp = np.zeros(shape2d_refined, dtype=float) + for value in map_dict.values(): + comp_temp[value["cellid"]] = comp1d[value["node"]] + zdis_temp[value["cellid"]] = zdis1d[value["node"]] + comp[k] = comp_temp.reshape( + nrow_refined // 2, 2, ncol_refined // 2, 2 + ).mean(axis=(1, -1)) + zdis[k] = zdis_temp.reshape( + nrow_refined // 2, 2, ncol_refined // 2, 2 + ).mean(axis=(1, -1)) + else: + comp[k] = comp_slice.reshape(shape2d) + zdis[k] = zdis_slice.reshape(shape2d) + + comp = comp.sum(axis=0) + zdis = zdis[0] + assert np.allclose(comp, zdis), ( + "sum of compaction is not equal to the " + + f"z-displacement at time {totim}" + ) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + ) + test.run() diff --git a/autotest/test_gwf_csub_inelastic.py b/autotest/test_gwf_csub_inelastic.py index 9d4e40575b7..dd5546092f2 100644 --- a/autotest/test_gwf_csub_inelastic.py +++ b/autotest/test_gwf_csub_inelastic.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation paktest = "csub" budtol = 1e-2 -ex = ["csub_de01a"] +cases = ["csub_de01a"] # static model data # spatial discretization @@ -75,7 +75,7 @@ def build_mf6(idx, ws, update=None): - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -185,16 +185,10 @@ def build_mf6(idx, ws, update=None): return sim -def build_model(idx, dir): - name = ex[idx] - ws = dir - - # build MODFLOW 6 files - sim = build_mf6(idx, ws) - - ws = os.path.join(dir, "mf6") - mc = build_mf6(idx, ws, update=True) - +def build_models(idx, test): + name = cases[idx] + sim = build_mf6(idx, test.workspace) + mc = build_mf6(idx, os.path.join(test.workspace, "mf6"), update=True) return sim, mc @@ -208,13 +202,11 @@ def calc_void(theta): return theta / (1.0 - theta) -def eval_void(sim): - print("evaluating void ratio...") - - fpth = os.path.join(sim.simpath, "csub_obs.csv") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "csub_obs.csv") cd = np.genfromtxt(fpth, delimiter=",", names=True) - fpth = os.path.join(sim.simpath, "mf6", "csub_obs.csv") + fpth = os.path.join(test.workspace, "mf6", "csub_obs.csv") cd2 = np.genfromtxt(fpth, delimiter=",", names=True) v = calc_comp2void(cd["COMP"]) @@ -228,42 +220,38 @@ def eval_void(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'VOID':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{cd['time'][i]:15g}" - line += f" {v[i]:15g}" - line += f" {v[i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'VOID':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{cd['time'][i]:15g}" + line += f" {v[i]:15g}" + line += f" {v[i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_void, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_ndb01_nr.py b/autotest/test_gwf_csub_ndb01_nr.py index 0360ca612ea..8923da61787 100644 --- a/autotest/test_gwf_csub_ndb01_nr.py +++ b/autotest/test_gwf_csub_ndb01_nr.py @@ -3,11 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from modflow_devtools.misc import is_in_ci -from simulation import TestSimulation -ex = ( +cases = ( "csub_ndb01a", "csub_ndb01b", "csub_ndb01c", @@ -60,10 +59,10 @@ nlay, nrow, ncol = 2, 1, 2 nper = 3 tsp0 = 1.0 -perlen = [tsp0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [200 for i in range(nper - 1)] -tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [tsp0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [200 for _ in range(nper - 1)] +tsmult = [1.0] + [1.0 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] delr, delc = 1000.0, 1000.0 top = 0.0 botm = [-10.0, -20.0] @@ -82,8 +81,8 @@ hclose, rclose, relax = 1e-9, 1e-3, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -107,12 +106,12 @@ H0 = 0.0 -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] newton = newtons[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -296,18 +295,16 @@ def build_model(idx, dir): return sim, None -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -319,11 +316,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -336,64 +333,57 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol, - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol, ) + test.run() diff --git a/autotest/test_gwf_csub_sk01.py b/autotest/test_gwf_csub_sk01.py index ed222a07720..9d993088617 100644 --- a/autotest/test_gwf_csub_sk01.py +++ b/autotest/test_gwf_csub_sk01.py @@ -1,488 +1,461 @@ import os -from typing import List, NamedTuple import flopy import numpy as np +import pytest + from framework import TestFramework -from pytest_cases import parametrize, parametrize_with_cases -from simulation import TestSimulation - - -class GwfCsubSkCases: - dtol: float = 1e-3 - budtol: float = 0.01 - bud_lst: List[str] = [ - "CSUB-CGELASTIC_IN", - "CSUB-CGELASTIC_OUT", - "CSUB-WATERCOMP_IN", - "CSUB-WATERCOMP_OUT", + +simname = "gwfcsubsk01" +cases = [f"{simname}a", f"{simname}b", f"{simname}c"] +dtol = 1e-3 +budtol = 0.01 +bud_lst = [ + "CSUB-CGELASTIC_IN", + "CSUB-CGELASTIC_OUT", + "CSUB-WATERCOMP_IN", + "CSUB-WATERCOMP_OUT", +] +cvopt = [None, None, None] +constantcv = [True, True, True] +ndelaybeds = [0, 0, 0] +top = [0, 0, 15] +newton = [False, True, True] +htol = [None, None, 0.3] + + +def build_models(idx, test): + sim = get_model(idx, test.workspace) + cmp = get_model(idx, test.workspace / "mf6_regression") + return sim, cmp + + +def get_model(idx, workspace): + name = cases[idx] + newtonoptions = None + imsla = "CG" + if newton[idx]: + newtonoptions = "NEWTON" + imsla = "BICGSTAB" + + # static model data + nlay, nrow, ncol = 3, 10, 10 + nper = 31 + perlen = [1.0] + [365.2500000 for i in range(nper - 1)] + nstp = [1] + [6 for i in range(nper - 1)] + tsmult = [1.0] + [1.3 for i in range(nper - 1)] + steady = [True] + [False for i in range(nper - 1)] + delr, delc = 1000.0, 2000.0 + botm = [-100, -150.0, -350.0] + zthick = [top[idx] - botm[0], botm[0] - botm[1], botm[1] - botm[2]] + strt = 100.0 + hnoflo = 1e30 + hdry = -1e30 + + # calculate hk + hk1fact = 1.0 / zthick[1] + hk1 = np.ones((nrow, ncol), dtype=float) * 0.5 * hk1fact + hk1[0, :] = 1000.0 * hk1fact + hk1[-1, :] = 1000.0 * hk1fact + hk1[:, 0] = 1000.0 * hk1fact + hk1[:, -1] = 1000.0 * hk1fact + hk = [20.0, hk1, 5.0] + + # calculate vka + vka = [1e6, 7.5e-5, 1e6] + + # set rest of npf variables + laytyp = [1, 0, 0] + laytypu = [4, 0, 0] + sy = 0.0 # [0.1, 0., 0.] + + nouter, ninner = 500, 300 + hclose, rclose, relax = 1e-9, 1e-6, 1.0 + + tdis_rc = [] + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + + # all cells are active + ib = 1 + + # chd data + c = [] + c6 = [] + ccol = [3, 4, 5, 6] + for j in ccol: + c.append([0, nrow - 1, j, strt, strt]) + c6.append([(0, nrow - 1, j), strt]) + cd = {0: c} + cd6 = {0: c6} + maxchd = len(cd[0]) + + # pumping well data + wr = [0, 0, 0, 0, 1, 1, 2, 2, 3, 3] + wc = [0, 1, 8, 9, 0, 9, 0, 9, 0, 0] + wrp = [2, 2, 3, 3] + wcp = [5, 6, 5, 6] + wq = [-14000.0, -8000.0, -5000.0, -3000.0] + d = [] + d6 = [] + for r, c, q in zip(wrp, wcp, wq): + d.append([2, r, c, q]) + d6.append([(2, r, c), q]) + wd = {1: d} + wd6 = {1: d6} + maxwel = len(wd[1]) + + # recharge data + q = 3000.0 / (delr * delc) + v = np.zeros((nrow, ncol), dtype=float) + for r, c in zip(wr, wc): + v[r, c] = q + rech = {0: v} + + # static ibc and sub data + sgm = 0.0 + sgs = 0.0 + omega = 1.0 + void = 0.82 + theta = void / (1.0 + void) + sw = 4.65120000e-10 * 9806.65000000 * theta + + # no delay bed data + nndb = 3 + lnd = [0, 1, 2] + hc = [botm[-1] for k in range(nlay)] + thicknd0 = [zthick[0], zthick[1], zthick[2]] + ccnd0 = [6e-6, 3e-6, 6e-6] + crnd0 = [6e-6, 3e-6, 6e-6] + sfv = [] + sfe = [] + for k in range(nlay): + sfv.append(ccnd0[k] * thicknd0[k]) + sfe.append(crnd0[k] * thicknd0[k]) + + # sub output data + ds15 = [0, 0, 0, 2052, 0, 0, 0, 0, 0, 0, 0, 0] + ds16 = [ + 0, + nper - 1, + 0, + nstp[-1] - 1, + 0, + 0, + 1, + 1, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 1, ] - class Data(NamedTuple): - name: str - cvopt: str - constantcv: bool - ndelaybeds: int - top: float - newton: bool - htol: float - - @parametrize( - data=[ - Data("a", None, True, 0, 0, False, None), - Data("b", None, True, 0, 0, True, None), - Data("c", None, True, 0, 15, True, 0.3), - ] + # build MODFLOW 6 files + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=str(workspace), + ) + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create iterative model solution + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration=imsla, + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, modelname=name, newtonoptions=newtonoptions + ) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top[idx], + botm=botm, + filename=f"{name}.dis", + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{name}.ic") + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=False, + # dev_modflowusg_upstream_weighted_saturation=True, + icelltype=laytyp, + cvoptions=cvopt[idx], + k=hk, + k33=vka, + ) + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=False, + iconvert=laytyp, + ss=0.0, + sy=sy, + storagecoefficient=True, + steady_state={0: True}, + transient={1: True}, + ) + + # recharge + rch = flopy.mf6.ModflowGwfrcha(gwf, readasarrays=True, recharge=rech) + + # wel file + wel = flopy.mf6.ModflowGwfwel( + gwf, + print_input=True, + print_flows=True, + maxbound=maxwel, + stress_period_data=wd6, + save_flows=False, + ) + + # chd files + chd = flopy.mf6.modflow.mfgwfchd.ModflowGwfchd( + gwf, maxbound=maxchd, stress_period_data=cd6, save_flows=False + ) + # csub files + opth = f"{name}.csub.obs" + csub = flopy.mf6.ModflowGwfcsub( + gwf, + head_based=True, + save_flows=True, + ninterbeds=0, + cg_theta=theta, + cg_ske_cr=crnd0, + packagedata=None, ) - def case_generator(self, function_tmpdir, data): - sim = self.get_model(data, function_tmpdir) - cmp = self.get_model(data, function_tmpdir / "mf6_regression") - return data, sim, cmp, self.eval_case - - def get_model(self, data, function_tmpdir): - name = data.name - newton = data.newton - newtonoptions = None - imsla = "CG" - if newton: - newtonoptions = "NEWTON" - imsla = "BICGSTAB" - - # static model data - nlay, nrow, ncol = 3, 10, 10 - nper = 31 - perlen = [1.0] + [365.2500000 for i in range(nper - 1)] - nstp = [1] + [6 for i in range(nper - 1)] - tsmult = [1.0] + [1.3 for i in range(nper - 1)] - steady = [True] + [False for i in range(nper - 1)] - delr, delc = 1000.0, 2000.0 - top = 0.0 - botm = [-100, -150.0, -350.0] - zthick = [top - botm[0], botm[0] - botm[1], botm[1] - botm[2]] - strt = 100.0 - hnoflo = 1e30 - hdry = -1e30 - - # calculate hk - hk1fact = 1.0 / zthick[1] - hk1 = np.ones((nrow, ncol), dtype=float) * 0.5 * hk1fact - hk1[0, :] = 1000.0 * hk1fact - hk1[-1, :] = 1000.0 * hk1fact - hk1[:, 0] = 1000.0 * hk1fact - hk1[:, -1] = 1000.0 * hk1fact - hk = [20.0, hk1, 5.0] - - # calculate vka - vka = [1e6, 7.5e-5, 1e6] - - # set rest of npf variables - laytyp = [1, 0, 0] - laytypu = [4, 0, 0] - sy = 0.0 # [0.1, 0., 0.] - - nouter, ninner = 500, 300 - hclose, rclose, relax = 1e-9, 1e-6, 1.0 - - tdis_rc = [] - for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) - - # all cells are active - ib = 1 - - # chd data - c = [] - c6 = [] - ccol = [3, 4, 5, 6] - for j in ccol: - c.append([0, nrow - 1, j, strt, strt]) - c6.append([(0, nrow - 1, j), strt]) - cd = {0: c} - cd6 = {0: c6} - maxchd = len(cd[0]) - - # pumping well data - wr = [0, 0, 0, 0, 1, 1, 2, 2, 3, 3] - wc = [0, 1, 8, 9, 0, 9, 0, 9, 0, 0] - wrp = [2, 2, 3, 3] - wcp = [5, 6, 5, 6] - wq = [-14000.0, -8000.0, -5000.0, -3000.0] - d = [] - d6 = [] - for r, c, q in zip(wrp, wcp, wq): - d.append([2, r, c, q]) - d6.append([(2, r, c), q]) - wd = {1: d} - wd6 = {1: d6} - maxwel = len(wd[1]) - - # recharge data - q = 3000.0 / (delr * delc) - v = np.zeros((nrow, ncol), dtype=float) - for r, c in zip(wr, wc): - v[r, c] = q - rech = {0: v} - - # static ibc and sub data - sgm = 0.0 - sgs = 0.0 - omega = 1.0 - void = 0.82 - theta = void / (1.0 + void) - sw = 4.65120000e-10 * 9806.65000000 * theta - - # no delay bed data - nndb = 3 - lnd = [0, 1, 2] - hc = [botm[-1] for k in range(nlay)] - thicknd0 = [zthick[0], zthick[1], zthick[2]] - ccnd0 = [6e-6, 3e-6, 6e-6] - crnd0 = [6e-6, 3e-6, 6e-6] - sfv = [] - sfe = [] - for k in range(nlay): - sfv.append(ccnd0[k] * thicknd0[k]) - sfe.append(crnd0[k] * thicknd0[k]) - - # sub output data - ds15 = [0, 0, 0, 2052, 0, 0, 0, 0, 0, 0, 0, 0] - ds16 = [ - 0, - nper - 1, - 0, - nstp[-1] - 1, - 0, - 0, - 1, - 1, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 1, - ] - - # build MODFLOW 6 files - sim = flopy.mf6.MFSimulation( - sim_name=name, - version="mf6", - exe_name="mf6", - sim_ws=str(function_tmpdir), - ) - # create tdis package - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=nper, perioddata=tdis_rc - ) - - # create iterative model solution - ims = flopy.mf6.ModflowIms( - sim, - print_option="SUMMARY", - outer_dvclose=hclose, - outer_maximum=nouter, - under_relaxation="NONE", - inner_maximum=ninner, - inner_dvclose=hclose, - rcloserecord=rclose, - linear_acceleration=imsla, - scaling_method="NONE", - reordering_method="NONE", - relaxation_factor=relax, - ) - - # create gwf model - gwf = flopy.mf6.ModflowGwf( - sim, modelname=name, newtonoptions=newtonoptions - ) - - dis = flopy.mf6.ModflowGwfdis( - gwf, - nlay=nlay, - nrow=nrow, - ncol=ncol, - delr=delr, - delc=delc, - top=data.top, - botm=botm, - filename=f"{name}.dis", - ) - - # initial conditions - ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{name}.ic") - - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, - save_flows=False, - # dev_modflowusg_upstream_weighted_saturation=True, - icelltype=laytyp, - cvoptions=data.cvopt, - k=hk, - k33=vka, - ) - # storage - sto = flopy.mf6.ModflowGwfsto( - gwf, - save_flows=False, - iconvert=laytyp, - ss=0.0, - sy=sy, - storagecoefficient=True, - steady_state={0: True}, - transient={1: True}, - ) - - # recharge - rch = flopy.mf6.ModflowGwfrcha(gwf, readasarrays=True, recharge=rech) - - # wel file - wel = flopy.mf6.ModflowGwfwel( - gwf, - print_input=True, - print_flows=True, - maxbound=maxwel, - stress_period_data=wd6, - save_flows=False, - ) - - # chd files - chd = flopy.mf6.modflow.mfgwfchd.ModflowGwfchd( - gwf, maxbound=maxchd, stress_period_data=cd6, save_flows=False - ) - # csub files - opth = f"{name}.csub.obs" - csub = flopy.mf6.ModflowGwfcsub( - gwf, - head_based=True, - save_flows=True, - ninterbeds=0, - cg_theta=theta, - cg_ske_cr=crnd0, - packagedata=None, - ) - obspos = [(0, 4, 4), (1, 4, 4), (2, 4, 4)] - obstype = ["compaction-cell", "csub-cell"] - obstag = ["tcomp", "csub"] - obsarr = [] - for iobs, cobs in enumerate(obstype): - for jobs, otup in enumerate(obspos): - otag = f"{obstag[iobs]}{jobs + 1}" - obsarr.append((otag, cobs, otup)) - - obsarr2 = [] - obstype2 = [ - "csub", - "inelastic-csub", - "elastic-csub", - "sk", - "ske", - "thickness", - "theta", - "interbed-compaction", - "inelastic-compaction", - "elastic-compaction", - "delay-flowtop", - "delay-flowbot", - ] - iobs = 0 - for cobs in obstype2: - iobs += 1 - otag = f"obs{iobs:03d}" - obsarr2.append((otag, cobs, (0,))) - - obstype3 = [ - "delay-preconstress", - "delay-head", - "delay-gstress", - "delay-estress", - "delay-compaction", - "delay-thickness", - "delay-theta", - ] - for cobs in obstype3: - iobs += 1 - otag = f"obs{iobs:03d}" - obsarr2.append((otag, cobs, (0,), (0,))) - - obsarr3 = [] - obstype4 = [ - "gstress-cell", - "estress-cell", - "thickness-cell", - "coarse-csub", - "wcomp-csub-cell", - "coarse-compaction", - "coarse-theta", - "coarse-thickness", - "csub-cell", - "ske-cell", - "sk-cell", - "theta-cell", - "compaction-cell", - ] - for cobs in obstype4: - iobs += 1 - otag = f"obs{iobs:03d}" - obsarr3.append((otag, cobs, obspos[-1])) - - orecarray = {} - orecarray["csub_obs.csv"] = obsarr - orecarray["interbed_obs.csv"] = obsarr2 - orecarray["coarse_cell_obs.csv"] = obsarr3 - - csub_obs_package = csub.obs.initialize( - filename=opth, digits=10, print_input=True, continuous=orecarray - ) - - # output control - oc = flopy.mf6.ModflowGwfoc( - gwf, - budget_filerecord=f"{name}.cbc", - head_filerecord=f"{name}.hds", - headprintrecord=[ - ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") - ], - saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - printrecord=[("HEAD", "LAST"), ("BUDGET", "ALL")], - ) - - return sim - - def eval_case(self, sim, data): - print("evaluating compaction...") - - # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") - tc = np.genfromtxt(fpth, names=True, delimiter=",") - - # regression compaction results - cpth = "mf6_regression" - fpth = os.path.join(sim.simpath, cpth, "csub_obs.csv") - tc0 = np.genfromtxt(fpth, names=True, delimiter=",") - - # calculate maximum absolute error - diff = tc["TCOMP3"] - tc0["TCOMP3"] - diffmax = np.abs(diff).max() - msg = f"maximum absolute total-compaction difference ({diffmax}) " - - # write summary - fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" - ) - f = open(fpth, "w") + obspos = [(0, 4, 4), (1, 4, 4), (2, 4, 4)] + obstype = ["compaction-cell", "csub-cell"] + obstag = ["tcomp", "csub"] + obsarr = [] + for iobs, cobs in enumerate(obstype): + for jobs, otup in enumerate(obspos): + otag = f"{obstag[iobs]}{jobs + 1}" + obsarr.append((otag, cobs, otup)) + + obsarr2 = [] + obstype2 = [ + "csub", + "inelastic-csub", + "elastic-csub", + "sk", + "ske", + "thickness", + "theta", + "interbed-compaction", + "inelastic-compaction", + "elastic-compaction", + "delay-flowtop", + "delay-flowbot", + ] + iobs = 0 + for cobs in obstype2: + iobs += 1 + otag = f"obs{iobs:03d}" + obsarr2.append((otag, cobs, (0,))) + + obstype3 = [ + "delay-preconstress", + "delay-head", + "delay-gstress", + "delay-estress", + "delay-compaction", + "delay-thickness", + "delay-theta", + ] + for cobs in obstype3: + iobs += 1 + otag = f"obs{iobs:03d}" + obsarr2.append((otag, cobs, (0,), (0,))) + + obsarr3 = [] + obstype4 = [ + "gstress-cell", + "estress-cell", + "thickness-cell", + "coarse-csub", + "wcomp-csub-cell", + "coarse-compaction", + "coarse-theta", + "coarse-thickness", + "csub-cell", + "ske-cell", + "sk-cell", + "theta-cell", + "compaction-cell", + ] + for cobs in obstype4: + iobs += 1 + otag = f"obs{iobs:03d}" + obsarr3.append((otag, cobs, obspos[-1])) + + orecarray = {} + orecarray["csub_obs.csv"] = obsarr + orecarray["interbed_obs.csv"] = obsarr2 + orecarray["coarse_cell_obs.csv"] = obsarr3 + + csub_obs_package = csub.obs.initialize( + filename=opth, digits=10, print_input=True, continuous=orecarray + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "ALL")], + ) + + return sim + + +def check_output(idx, test): + # MODFLOW 6 total compaction results + fpth = os.path.join(test.workspace, "csub_obs.csv") + tc = np.genfromtxt(fpth, names=True, delimiter=",") + + # regression compaction results + cpth = "mf6_regression" + fpth = os.path.join(test.workspace, cpth, "csub_obs.csv") + tc0 = np.genfromtxt(fpth, names=True, delimiter=",") + + # calculate maximum absolute error + diff = tc["TCOMP3"] - tc0["TCOMP3"] + diffmax = np.abs(diff).max() + msg = f"maximum absolute total-compaction difference ({diffmax}) " + + # write summary + fpth = os.path.join( + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" + ) + with open(fpth, "w") as f: for i in range(diff.shape[0]): line = f"{tc0['time'][i]:10.2g}" line += f"{tc['TCOMP3'][i]:10.2g}" line += f"{tc0['TCOMP3'][i]:10.2g}" line += f"{diff[i]:10.2g}" f.write(line + "\n") - f.close() - - if diffmax > self.dtol: - sim.success = False - msg += f"exceeds {self.dtol}" - assert diffmax < self.dtol, msg - else: - sim.success = True - print(" " + msg) - - # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") - budl = flopy.utils.Mf6ListBudget(fpth) - names = list(self.bud_lst) - d0 = budl.get_budget(names=names)[0] - dtype = d0.dtype - nbud = d0.shape[0] - - # get results from cbc file - cbc_bud = ["CSUB-CGELASTIC", "CSUB-WATERCOMP"] - d = np.recarray(nbud, dtype=dtype) - for key in self.bud_lst: - d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") - cobj = flopy.utils.CellBudgetFile(fpth, precision="double") - kk = cobj.get_kstpkper() - times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): - for text in cbc_bud: - qin = 0.0 - qout = 0.0 - v = cobj.get_data(kstpkper=k, text=text)[0] - for kk in range(v.shape[0]): - for ii in range(v.shape[1]): - for jj in range(v.shape[2]): - vv = v[kk, ii, jj] - if vv < 0.0: - qout -= vv - else: - qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] - d["stress_period"] = k[1] - key = f"{text}_IN" - d[key][idx] = qin - key = f"{text}_OUT" - d[key][idx] = qout - - diff = np.zeros((nbud, len(self.bud_lst)), dtype=float) - for idx, key in enumerate(self.bud_lst): - diff[:, idx] = d0[key] - d[key] - diffmax = np.abs(diff).max() - msg = f"maximum absolute total-budget difference ({diffmax}) " - - # write summary - fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" - ) - f = open(fpth, "w") + + if diffmax > dtol: + test.success = False + msg += f"exceeds {dtol}" + assert diffmax < dtol, msg + else: + test.success = True + print(" " + msg) + + # get results from listing file + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") + budl = flopy.utils.Mf6ListBudget(fpth) + names = list(bud_lst) + d0 = budl.get_budget(names=names)[0] + dtype = d0.dtype + nbud = d0.shape[0] + + # get results from cbc file + cbc_bud = ["CSUB-CGELASTIC", "CSUB-WATERCOMP"] + d = np.recarray(nbud, dtype=dtype) + for key in bud_lst: + d[key] = 0.0 + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") + cobj = flopy.utils.CellBudgetFile(fpth, precision="double") + kk = cobj.get_kstpkper() + times = cobj.get_times() + for i, (k, t) in enumerate(zip(kk, times)): + for text in cbc_bud: + qin = 0.0 + qout = 0.0 + v = cobj.get_data(kstpkper=k, text=text)[0] + for kk in range(v.shape[0]): + for ii in range(v.shape[1]): + for jj in range(v.shape[2]): + vv = v[kk, ii, jj] + if vv < 0.0: + qout -= vv + else: + qin += vv + d["totim"][i] = t + d["time_step"][i] = k[0] + d["stress_period"] = k[1] + key = f"{text}_IN" + d[key][i] = qin + key = f"{text}_OUT" + d[key][i] = qout + + diff = np.zeros((nbud, len(bud_lst)), dtype=float) + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] + diffmax = np.abs(diff).max() + msg = f"maximum absolute total-budget difference ({diffmax}) " + + # write summary + fpth = os.path.join( + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" + ) + with open(fpth, "w") as f: for i in range(diff.shape[0]): if i == 0: line = f"{'TIME':>10s}" - for idx, key in enumerate(self.bud_lst): + for j, key in enumerate(bud_lst): line += f"{key + '_LST':>25s}" line += f"{key + '_CBC':>25s}" line += f"{key + '_DIF':>25s}" f.write(line + "\n") line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(self.bud_lst): + for j, key in enumerate(bud_lst): line += f"{d0[key][i]:25g}" line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" + line += f"{diff[i, j]:25g}" f.write(line + "\n") - f.close() - - if diffmax > self.budtol: - sim.success = False - msg += f"exceeds {self.dtol}" - assert diffmax < self.dtol, msg - else: - sim.success = True - print(" " + msg) - - -@parametrize_with_cases( - "case", - cases=[ - GwfCsubSkCases, - ], -) -def test_mf6model(case, targets): - data, sim, cmp, evl = case - sim.write_simulation() - if cmp: - cmp.write_simulation() - test = TestSimulation( - name=data.name, - exe_dict=targets, - exfunc=evl, - idxsim=0, - mf6_regression=True, + + if diffmax > budtol: + test.success = False + msg += f"exceeds {dtol}" + assert diffmax < dtol, msg + else: + test.success = True + print(" " + msg) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + compare="mf6_regression", ) - test.set_model(sim.simulation_data.mfpath.get_sim_path(), testModel=False) test.run() - test.compare() - evl(test, data) diff --git a/autotest/test_gwf_csub_sk02.py b/autotest/test_gwf_csub_sk02.py index 5ae15cf0b0f..62f546f77e9 100644 --- a/autotest/test_gwf_csub_sk02.py +++ b/autotest/test_gwf_csub_sk02.py @@ -3,20 +3,19 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from modflow_devtools.misc import is_in_ci -from simulation import TestSimulation - -ex = ["csub_sk02a", "csub_sk02b", "csub_sk02c", "csub_sk02d"] -constantcv = [True for idx in range(len(ex))] -cmppths = ["mf6_regression" for idx in range(len(ex))] -tops = [150.0 for idx in range(len(ex))] -newtons = [True for idx in range(len(ex))] + +cases = ["csub_sk02a", "csub_sk02b", "csub_sk02c", "csub_sk02d"] +constantcv = [True for _ in range(len(cases))] +cmppths = ["mf6_regression" for _ in range(len(cases))] +tops = [150.0 for _ in range(len(cases))] +newtons = [True for _ in range(len(cases))] ump = [None, None, True, True] iump = [0, 0, 1, 1] -eslag = [True for idx in range(len(ex))] +eslag = [True for _ in range(len(cases))] icrcc = [0, 1, 0, 1] -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] dtol = 1e-3 bud_lst = [ "CSUB-CGELASTIC_IN", @@ -28,10 +27,10 @@ # static model data nlay, nrow, ncol = 3, 10, 10 nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] delr, delc = 1000.0, 2000.0 top = 150.0 botm = [-100, -150.0, -350.0] @@ -61,8 +60,8 @@ hclose, rclose, relax = 1e-9, 1e-6, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -178,7 +177,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] newton = newtons[idx] newtonoptions = None imsla = "CG" @@ -321,33 +320,28 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - sim = get_model(idx, ws) + sim = get_model(idx, test.workspace) # build comparison files cpth = cmppths[idx] - ws = os.path.join(dir, cpth) + ws = os.path.join(test.workspace, cpth) mc = get_model(idx, ws) - return sim, mc -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # comparision total compaction results - cpth = cmppths[sim.idxsim] - fpth = os.path.join(sim.simpath, cpth, "csub_obs.csv") + cpth = cmppths[idx] + fpth = os.path.join(test.workspace, cpth, "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -360,27 +354,26 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - line = f"{tc0['time'][i]:10.2g}" - line += f"{tc['TCOMP3'][i]:10.2g}" - line += f"{tc0['TCOMP3'][i]:10.2g}" - line += f"{diff[i]:10.2g}" - f.write(line + "\n") - f.close() + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + line = f"{tc0['time'][i]:10.2g}" + line += f"{tc['TCOMP3'][i]:10.2g}" + line += f"{tc0['TCOMP3'][i]:10.2g}" + line += f"{diff[i]:10.2g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -392,11 +385,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -409,13 +402,13 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) for idx, key in enumerate(bud_lst): @@ -425,49 +418,42 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - idxsim=idx, - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_sk03.py b/autotest/test_gwf_csub_sk03.py index f886dba8a4b..a12fca651b0 100644 --- a/autotest/test_gwf_csub_sk03.py +++ b/autotest/test_gwf_csub_sk03.py @@ -4,15 +4,15 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_sk03a"] -constantcv = [True for idx in range(len(ex))] -cmppths = ["mf6_regression" for idx in range(len(ex))] -newtons = [True for idx in range(len(ex))] +cases = ["csub_sk03a"] +constantcv = [True for _ in range(len(cases))] +cmppths = ["mf6_regression" for _ in range(len(cases))] +newtons = [True for _ in range(len(cases))] icrcc = [0, 1, 0, 1] -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] dtol = 1e-3 bud_lst = [ "CSUB-CGELASTIC_IN", @@ -31,14 +31,14 @@ totim = perlen.sum() - perlen[0] nstp = [1, nsec * 2] tsmult = [1.0, 1.00] -steady = [True] + [False for i in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] # spatial discretization ft2m = 1.0 / 3.28081 nlay, nrow, ncol = 3, 21, 20 delr = np.ones(ncol, dtype=float) * 0.5 -for idx in range(1, ncol): - delr[idx] = min(delr[idx - 1] * 1.2, 15.0) +for i in range(1, ncol): + delr[i] = min(delr[i - 1] * 1.2, 15.0) delc = 50.0 top = 0.0 botm = np.array([-40, -70.0, -100.0], dtype=float) * ft2m @@ -61,8 +61,8 @@ hclose, rclose, relax = 1e-9, 1e-6, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -231,7 +231,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] newton = newtons[idx] newtonoptions = None imsla = "CG" @@ -500,32 +500,28 @@ def get_model(idx, ws): # SUB package problem 3 -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - sim = get_model(idx, ws) + sim = get_model(idx, test.workspace) # build comparison files cpth = cmppths[idx] - ws = os.path.join(dir, cpth) + ws = os.path.join(test.workspace, cpth) mc = get_model(idx, ws) return sim, mc -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -537,11 +533,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -554,66 +550,59 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - idxsim=idx, - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_sk04_nr.py b/autotest/test_gwf_csub_sk04_nr.py index edb9f0409e8..8b0e5c748e6 100644 --- a/autotest/test_gwf_csub_sk04_nr.py +++ b/autotest/test_gwf_csub_sk04_nr.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ( +cases = ( "csub_sk04a", "csub_sk04b", "csub_sk04c", @@ -33,10 +33,10 @@ nlay, nrow, ncol = 2, 1, 2 nper = 3 tsp0 = 1.0 -perlen = [tsp0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [200 for i in range(nper - 1)] -tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [tsp0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [200 for _ in range(nper - 1)] +tsmult = [1.0] + [1.0 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] delr, delc = 1000.0, 1000.0 top = 0.0 botm = [-10.0, -20.0] @@ -55,8 +55,8 @@ hclose, rclose, relax = 1e-9, 1e-3, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -77,12 +77,12 @@ crnd0[:, 0, 0] = 0.0 -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] newton = newtons[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -244,18 +244,16 @@ def build_model(idx, dir): return sim, None -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -267,11 +265,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -284,64 +282,57 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol, - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol, ) + test.run() diff --git a/autotest/test_gwf_csub_sub01.py b/autotest/test_gwf_csub_sub01.py index 4327c62e3fb..d0e40fcc99a 100644 --- a/autotest/test_gwf_csub_sub01.py +++ b/autotest/test_gwf_csub_sub01.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["csub_sub01a", "csub_sub01b"] paktest = "csub" budtol = 1e-2 -ex = ["csub_sub01a", "csub_sub01b"] compression_indices = [None, True] -ndcell = [19] * len(ex) +ndcell = [19] * len(cases) # static model data # spatial discretization @@ -23,10 +23,10 @@ # temporal discretization nper = 1 -perlen = [1000.0 for i in range(nper)] -nstp = [100 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [1000.0 for _ in range(nper)] +nstp = [100 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] strt = 0.0 strt6 = 1.0 @@ -41,8 +41,8 @@ hclose, rclose, relax = 1e-6, 1e-6, 0.97 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) ib = 1 @@ -78,7 +78,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws @@ -215,31 +215,27 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - sim = get_model(idx, ws) + sim = get_model(idx, test.workspace) # build MODFLOW-2005 files - ws = os.path.join(dir, "mf6_regression") + ws = os.path.join(test.workspace, "mf6_regression") mc = get_model(idx, ws) return sim, mc -def eval_sub(sim): - print("evaluating subsidence...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # comparison total compaction results - fpth = os.path.join(sim.simpath, "mf6_regression", "csub_obs.csv") + fpth = os.path.join(test.workspace, "mf6_regression", "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -253,40 +249,37 @@ def eval_sub(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc0['time'][i]:15g}" - line += f" {tc['TCOMP'][i]:15g}" - line += f" {tc0['TCOMP'][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc0['time'][i]:15g}" + line += f" {tc['TCOMP'][i]:15g}" + line += f" {tc0['TCOMP'][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) - - return + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -303,7 +296,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -316,7 +309,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -334,64 +327,57 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"diffmax {diffmax} exceeds tolerance {budtol}" assert diffmax < budtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_sub, - idxsim=idx, - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_sub01_adjmat.py b/autotest/test_gwf_csub_sub01_adjmat.py index 694799c26da..c37adcaf16d 100644 --- a/autotest/test_gwf_csub_sub01_adjmat.py +++ b/autotest/test_gwf_csub_sub01_adjmat.py @@ -3,16 +3,15 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["csub_sub01_adj"] paktest = "csub" budtol = 1e-2 - compdir = "mf6" -ex = ["csub_sub01_adj"] compression_indices = [None] -ndcell = [19] * len(ex) +ndcell = [19] * len(cases) # static model data # spatial discretization @@ -25,10 +24,10 @@ # temporal discretization nper = 1 -perlen = [1000.0 for i in range(nper)] -nstp = [100 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [1000.0 for _ in range(nper)] +nstp = [100 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] strt = 0.0 strt6 = 1.0 @@ -43,8 +42,8 @@ hclose, rclose, relax = 1e-12, 1e-6, 0.97 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) ib = 1 @@ -85,18 +84,18 @@ ] -def build_model(idx, dir): - sim = get_model(idx, dir, adjustmat=True) +def build_models(idx, test): + sim = get_model(idx, test.workspace, adjustmat=True) # build MODFLOW-6 with constant material properties - pth = os.path.join(dir, compdir) + pth = os.path.join(test.workspace, compdir) mc = get_model(idx, pth, None) return sim, mc def get_model(idx, dir, adjustmat=False): - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files ws = dir @@ -221,18 +220,16 @@ def calc_theta_thick(comp, thickini=1.0): return poro, b -def eval_sub(sim): - print("evaluating subsidence...") - +def check_output(idx, test): # MODFLOW 6 compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 base compaction results - fpth = os.path.join(sim.simpath, compdir, "csub_obs.csv") + fpth = os.path.join(test.workspace, compdir, "csub_obs.csv") try: tcb = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -246,28 +243,27 @@ def eval_sub(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" - line += f" {tc['TCOMP'][i]:15g}" - line += f" {tcb['TCOMP'][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + line += f" {tc['TCOMP'][i]:15g}" + line += f" {tcb['TCOMP'][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol:15.7g}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # calculate theta and porosity from total interbed compaction @@ -287,11 +283,11 @@ def eval_sub(sim): + f"difference ({diffmax:15.7g}) " ) if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol:15.7g}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # calculate theta and porosity from interbed cell compaction @@ -317,11 +313,11 @@ def eval_sub(sim): + f"({diffmax:15.7g}) " ) if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol:15.7g}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) calci["THICK"] += calc["THICK"] calci["THETA"] += calc["THICK"] * calc["THETA"] @@ -337,21 +333,21 @@ def eval_sub(sim): ) msg += "calculated from individual interbed cell values " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol:15.7g}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -368,7 +364,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -381,7 +377,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -399,57 +395,58 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() dtol = 1e-6 if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation(name=name, exe_dict=targets, exfunc=eval_sub, idxsim=0), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_sub01_elastic.py b/autotest/test_gwf_csub_sub01_elastic.py index 815910827b4..05a59a2045a 100644 --- a/autotest/test_gwf_csub_sub01_elastic.py +++ b/autotest/test_gwf_csub_sub01_elastic.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["csub_sub01_elasa"] cmppth = "mf6" paktest = "csub" dtol = 1e-3 budtol = 1e-2 -ex = ["csub_sub01_elasa"] ndcell = [19] # static model data @@ -24,13 +24,13 @@ # temporal discretization nper = 1 -perlen = [1000.0 for i in range(nper)] -nstp = [100 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [1000.0 for _ in range(nper)] +nstp = [100 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) strt = 0.0 strt6 = 1.0 @@ -90,7 +90,7 @@ def build_mf6(idx, ws, newton=None): - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( @@ -176,28 +176,23 @@ def build_mf6(idx, ws, newton=None): return sim -def build_model(idx, dir): - ws = dir - sim = build_mf6(idx, ws) - - ws = os.path.join(ws, cmppth) +def build_models(idx, test): + sim = build_mf6(idx, test.workspace) + ws = os.path.join(test.workspace, cmppth) mc = build_mf6(idx, ws, newton="NEWTON") - return sim, mc -def eval_sub(sim): - print("evaluating subsidence...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 with newton-raphson - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tci = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -216,42 +211,39 @@ def eval_sub(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - for tag in tc.dtype.names[1:]: - line += f" {f'{tag}_SK':>15s}" - line += f" {f'{tag}_SKIB':>15s}" - line += f" {f'{tag}_DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" for tag in tc.dtype.names[1:]: - line += f" {tc[tag][i]:15g}" - line += f" {tci[tag][i]:15g}" - line += f" {tc[tag][i] - tci[tag][i]:15g}" + line += f" {f'{tag}_SK':>15s}" + line += f" {f'{tag}_SKIB':>15s}" + line += f" {f'{tag}_DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + for tag in tc.dtype.names[1:]: + line += f" {tc[tag][i]:15g}" + line += f" {tci[tag][i]:15g}" + line += f" {tc[tag][i] - tci[tag][i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) - - return + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -268,7 +260,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -281,7 +273,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -299,60 +291,56 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_sub, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_sub01_pch.py b/autotest/test_gwf_csub_sub01_pch.py index b4b12c81e5b..970e665a3c7 100644 --- a/autotest/test_gwf_csub_sub01_pch.py +++ b/autotest/test_gwf_csub_sub01_pch.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["csub_sub01_pch"] paktest = "csub" budtol = 1e-2 compdir = "mf6" -ex = ["csub_sub01_pch"] -ndcell = [19] * len(ex) +ndcell = [19] * len(cases) # static model data # spatial discretization @@ -23,10 +23,10 @@ # temporal discretization nper = 1 -perlen = [1000.0 for i in range(nper)] -nstp = [100 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [1000.0 for _ in range(nper)] +nstp = [100 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] strt = 0.0 strt6 = 1.0 @@ -41,8 +41,8 @@ hclose, rclose, relax = 1e-12, 1e-6, 0.97 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) ib = 1 @@ -69,18 +69,18 @@ thick = [1.0] -def build_model(idx, dir): - sim = get_model(idx, dir, pch=True) +def build_models(idx, test): + sim = get_model(idx, test.workspace, pch=True) # build MODFLOW-6 with constant material properties - pth = os.path.join(dir, compdir) + pth = os.path.join(test.workspace, compdir) mc = get_model(idx, pth) return sim, mc def get_model(idx, dir, pch=None): - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files ws = dir @@ -221,18 +221,16 @@ def get_model(idx, dir, pch=None): return sim -def eval_sub(sim): - print("evaluating subsidence...") - +def check_output(idx, test): # MODFLOW 6 compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 base compaction results - fpth = os.path.join(sim.simpath, compdir, "csub_obs.csv") + fpth = os.path.join(test.workspace, compdir, "csub_obs.csv") try: tcb = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -246,38 +244,37 @@ def eval_sub(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" - line += f" {tc['TCOMP'][i]:15g}" - line += f" {tcb['TCOMP'][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + line += f" {tc['TCOMP'][i]:15g}" + line += f" {tcb['TCOMP'][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol:15.7g}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -294,7 +291,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -307,7 +304,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -325,62 +322,58 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() dtol = 1e-6 if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_sub, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_csub_sub02.py b/autotest/test_gwf_csub_sub02.py index 7596dfc1875..07985c835d5 100644 --- a/autotest/test_gwf_csub_sub02.py +++ b/autotest/test_gwf_csub_sub02.py @@ -2,10 +2,10 @@ import flopy import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "csub_sub02a", "csub_sub02b", "csub_sub02c", @@ -23,10 +23,10 @@ # static model data nlay, nrow, ncol = 1, 1, 1 nper = 10 -perlen = [182.625 for i in range(nper)] -nstp = [10 for i in range(nper)] -tsmult = [1.05 for i in range(nper)] -steady = [False for i in range(nper)] +perlen = [182.625 for _ in range(nper)] +nstp = [10 for _ in range(nper)] +tsmult = [1.05 for _ in range(nper)] +steady = [False for _ in range(nper)] delr, delc = 1000.0, 1000.0 top = -100.0 botm = [-600.0] @@ -41,8 +41,8 @@ hclose, rclose, relax = 1e-6, 1e-6, 0.97 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) ib = 1 @@ -76,7 +76,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] ss = 1.14e-3 sc6 = True if not storagecoeff[idx]: @@ -200,23 +200,20 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - ws = dir - sim = get_model(idx, ws) - - ws = os.path.join(dir, cmppth) +def build_models(idx, test): + sim = get_model(idx, test.workspace) + ws = os.path.join(test.workspace, cmppth) mc = get_model(idx, ws) return sim, mc -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation(name=name, exe_dict=targets, mf6_regression=True), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_sub03.py b/autotest/test_gwf_csub_sub03.py index dbb848c2b3c..cdd41d0b6ea 100644 --- a/autotest/test_gwf_csub_sub03.py +++ b/autotest/test_gwf_csub_sub03.py @@ -3,11 +3,11 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_sub03a", "csub_sub03b"] +cases = ["csub_sub03a", "csub_sub03b"] cmppth = "mf6_regression" cvopt = [None, None, None] constantcv = [True, True] @@ -25,10 +25,10 @@ # static model data nlay, nrow, ncol = 3, 10, 10 nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] delr, delc = 1000.0, 2000.0 top = 0.0 botm = [-100, -150.0, -350.0] @@ -59,8 +59,8 @@ hclose, rclose, relax = 1e-9, 1e-6, 1.0 tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # all cells are active ib = 1 @@ -140,7 +140,7 @@ # SUB package problem 3 def get_model(idx, ws): - name = ex[idx] + name = cases[idx] # ibc packagedata container counter sub6 = [] ibcno = 0 @@ -344,28 +344,25 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - ws = dir - sim = get_model(idx, ws) +def build_models(idx, test): + sim = get_model(idx, test.workspace) - ws = os.path.join(dir, cmppth) + ws = os.path.join(test.workspace, cmppth) mc = get_model(idx, ws) return sim, mc -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # Comparision total compaction results - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -377,15 +374,15 @@ def eval_comp(sim): msg = f"maximum absolute total-compaction difference ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -397,11 +394,11 @@ def eval_comp(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -411,44 +408,39 @@ def eval_comp(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol[idx], + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_subwt01.py b/autotest/test_gwf_csub_subwt01.py index aad1e15e503..a1ff03b8aa7 100644 --- a/autotest/test_gwf_csub_subwt01.py +++ b/autotest/test_gwf_csub_subwt01.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_subwt01a", "csub_subwt01b", "csub_subwt01c", "csub_subwt01d"] +cases = ["csub_subwt01a", "csub_subwt01b", "csub_subwt01c", "csub_subwt01d"] cmppth = "mf6_regression" -htol = [None for n in ex] +htol = [None for _ in cases] dtol = 1e-3 budtol = 1e-2 paktest = "csub" @@ -62,8 +62,8 @@ fluxtol = rclose tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # this used to work # ib = np.zeros((nlay, nrow, ncol), dtype=int) @@ -119,7 +119,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, memory_print_option="all", @@ -238,24 +238,20 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - sim = get_model(idx, ws) + sim = get_model(idx, test.workspace) # build comparision files - ws = os.path.join(dir, cmppth) + ws = os.path.join(test.workspace, cmppth) mc = get_model(idx, ws) return sim, mc -def eval_comp(sim): - - print("evaluating compaction...") +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -263,7 +259,7 @@ def eval_comp(sim): # Comparision total compaction results cpth = cmppth - fpth = os.path.join(sim.simpath, cpth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cpth, "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -277,41 +273,37 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc0['time'][i]:15g}" - line += f" {tc[loctag][i]:15g}" - line += f" {tc0[loctag][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc0['time'][i]:15g}" + line += f" {tc[loctag][i]:15g}" + line += f" {tc0[loctag][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) - - return + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): - print("evaluating cbc and budget...") +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -328,7 +320,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -341,7 +333,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -359,65 +351,59 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol[idx], + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_subwt02.py b/autotest/test_gwf_csub_subwt02.py index bf9068e4172..877e5474d4c 100644 --- a/autotest/test_gwf_csub_subwt02.py +++ b/autotest/test_gwf_csub_subwt02.py @@ -3,11 +3,11 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_subwt02a", "csub_subwt02b", "csub_subwt02c", "csub_subwt02d"] +cases = ["csub_subwt02a", "csub_subwt02b", "csub_subwt02c", "csub_subwt02d"] timeseries = [True, False, True, False] cmppth = "mf6_regression" htol = [None, None, None, None] @@ -183,7 +183,7 @@ # beta = 4.65120000e-10 gammaw = 9806.65000000 sw = beta * gammaw * theta -ss = [sw for k in range(nlay)] +ss = [sw for _ in range(nlay)] swt6 = [] ibcno = 0 @@ -216,7 +216,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws @@ -407,23 +407,21 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(idx, ws) # build comparision files - ws = os.path.join(dir, cmppth) + ws = os.path.join(test.workspace, cmppth) mc = get_model(idx, ws) return sim, mc -def eval_comp(sim): - print("evaluating compaction...") +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -431,7 +429,7 @@ def eval_comp(sim): # comparision total compaction results cpth = cmppth - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -445,7 +443,7 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) f = open(fpth, "w") line = f"{'TOTIM':>15s}" @@ -462,24 +460,23 @@ def eval_comp(sim): f.close() if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) return # compare cbc and lst budgets -def cbc_compare(sim): - print("evaluating cbc and budget...") +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -496,7 +493,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -509,7 +506,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -527,65 +524,59 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - mf6_regression=True, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol[idx], + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_csub_subwt03.py b/autotest/test_gwf_csub_subwt03.py index abe743ca558..14c56e899d3 100644 --- a/autotest/test_gwf_csub_subwt03.py +++ b/autotest/test_gwf_csub_subwt03.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_subwt03a", "csub_subwt03b", "csub_subwt03c", "csub_subwt03d"] -nex = len(ex) +cases = ["csub_subwt03a", "csub_subwt03b", "csub_subwt03c", "csub_subwt03d"] +nex = len(cases) cmppth = "mf6" htol = None # 0.1 dtol = 1e-3 @@ -29,8 +29,8 @@ tsmult = [1.0, 1.0, 1.0] steady = [True, False, False] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization nlay, nrow, ncol = 4, ib0.shape[0], ib0.shape[1] @@ -57,18 +57,18 @@ wnlays = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 3] wnrows = [0, 1, 1, 1, 2, 3, 4, 4, 5, 6, 13, 13, 15, 15, 16, 17, 17, 18, 8, 11] wncols = [7, 4, 7, 11, 3, 11, 2, 12, 13, 1, 1, 13, 2, 12, 12, 3, 11, 6, 9, 6] -wrates0 = [2.2e3 for n in range(18)] + [0.0, 0.0] -wrates1 = [2.2e3 for n in range(18)] + [-7.2e04, -7.2e04] +wrates0 = [2.2e3 for _ in range(18)] + [0.0, 0.0] +wrates1 = [2.2e3 for _ in range(18)] + [-7.2e04, -7.2e04] w0 = [] w1 = [] ws0 = [] ws1 = [] -for idx, (k, i, j) in enumerate(zip(wnlays, wnrows, wncols)): - w0.append((k, i, j, wrates0[idx])) - w1.append((k, i, j, wrates1[idx])) - ws0.append(((k, i, j), wrates0[idx])) - ws1.append(((k, i, j), wrates1[idx])) +for i, (k, i, j) in enumerate(zip(wnlays, wnrows, wncols)): + w0.append((k, i, j, wrates0[i])) + w1.append((k, i, j, wrates1[i])) + ws0.append(((k, i, j), wrates0[i])) + ws1.append(((k, i, j), wrates1[i])) wd = {0: w0, 1: w1, 2: w0} wd6 = {0: ws0, 1: ws1, 2: ws0} @@ -202,11 +202,11 @@ def get_interbed(headbased=False, delay=False): return swt6 -def build_model(idx, dir): - sim = build_mf6(idx, dir) +def build_models(idx, test): + sim = build_mf6(idx, test.workspace) # build mf6 with interbeds - wsc = os.path.join(dir, "mf6") + wsc = os.path.join(test.workspace, "mf6") mc = build_mf6(idx, wsc, interbed=True) return sim, mc @@ -214,8 +214,7 @@ def build_model(idx, dir): # build MODFLOW 6 files def build_mf6(idx, ws, interbed=False): - - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -353,18 +352,16 @@ def build_mf6(idx, ws, interbed=False): return sim -def eval_comp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 without interbeds - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 with interbeds - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tci = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -383,41 +380,39 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - for tag in tc.dtype.names[1:]: - line += f" {f'{tag}_SK':>15s}" - line += f" {f'{tag}_SKIB':>15s}" - line += f" {f'{tag}_DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" for tag in tc.dtype.names[1:]: - line += f" {tc[tag][i]:15g}" - line += f" {tci[tag][i]:15g}" - line += f" {tc[tag][i] - tci[tag][i]:15g}" + line += f" {f'{tag}_SK':>15s}" + line += f" {f'{tag}_SKIB':>15s}" + line += f" {f'{tag}_DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + for tag in tc.dtype.names[1:]: + line += f" {tc[tag][i]:15g}" + line += f" {tci[tag][i]:15g}" + line += f" {tc[tag][i] - tci[tag][i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): - print("evaluating cbc and budget...") +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -434,7 +429,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -447,7 +442,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -465,66 +460,58 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - cmp_verbose=False, - htol=htol, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol, ) + test.run() diff --git a/autotest/test_gwf_csub_wc01.py b/autotest/test_gwf_csub_wc01.py index 1ec2bd2d69f..516bd661fb1 100644 --- a/autotest/test_gwf_csub_wc01.py +++ b/autotest/test_gwf_csub_wc01.py @@ -3,11 +3,11 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_wc01a", "csub_wc02b"] +cases = ["csub_wc01a", "csub_wc02b"] cmppth = "mf6" dtol = 1e-3 budtol = 1e-2 @@ -25,8 +25,8 @@ tsmult = [1.0, 1.0, 1.0] steady = [True, False, False] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization nlay, nrow, ncol = 4, ib0.shape[0], ib0.shape[1] @@ -61,20 +61,20 @@ wnlays = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 3] wnrows = [0, 1, 1, 1, 2, 3, 4, 4, 5, 6, 13, 13, 15, 15, 16, 17, 17, 18, 8, 11] wncols = [7, 4, 7, 11, 3, 11, 2, 12, 13, 1, 1, 13, 2, 12, 12, 3, 11, 6, 9, 6] -wrates0 = [2.2e3 for n in range(18)] + [0.0, 0.0] -wrates1 = [2.2e3 for n in range(18)] + [-7.2e03, -7.2e03] +wrates0 = [2.2e3 for _ in range(18)] + [0.0, 0.0] +wrates1 = [2.2e3 for _ in range(18)] + [-7.2e03, -7.2e03] w0 = [] w1 = [] ws0 = [] ws1 = [] -for idx, (k, i, j) in enumerate(zip(wnlays, wnrows, wncols)): +for i, (k, i, j) in enumerate(zip(wnlays, wnrows, wncols)): if ib0[i, j] < 1: continue - w0.append((k, i, j, wrates0[idx])) - w1.append((k, i, j, wrates1[idx])) - ws0.append(((k, i, j), wrates0[idx])) - ws1.append(((k, i, j), wrates1[idx])) + w0.append((k, i, j, wrates0[i])) + w1.append((k, i, j, wrates1[i])) + ws0.append(((k, i, j), wrates0[i])) + ws1.append(((k, i, j), wrates1[i])) wd = {0: w0, 1: w1, 2: w0} wd6 = {0: ws0, 1: ws1, 2: ws0} print(wd6) @@ -211,11 +211,11 @@ ] -def build_model(idx, dir): - sim = build_mf6(idx, dir) +def build_models(idx, test): + sim = build_mf6(idx, test.workspace) # build mf6 with interbeds - wsc = os.path.join(dir, "mf6") + wsc = os.path.join(test.workspace, "mf6") mc = build_mf6(idx, wsc, interbed=True) return sim, mc @@ -223,8 +223,7 @@ def build_model(idx, dir): # build MODFLOW 6 files def build_mf6(idx, ws, interbed=False): - - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -344,18 +343,16 @@ def build_mf6(idx, ws, interbed=False): return sim -def eval_wcomp(sim): - print("evaluating compaction...") - +def check_output(idx, test): # MODFLOW 6 without interbeds water compressibility - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 with interbeds water compressibility - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tci = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -377,41 +374,39 @@ def eval_wcomp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.wcomp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.wcomp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - for tag in tc.dtype.names[1:]: - line += f" {f'{tag}_SK':>15s}" - line += f" {f'{tag}_SKIB':>15s}" - line += f" {f'{tag}_DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" for tag in tc.dtype.names[1:]: - line += f" {tc[tag][i]:15g}" - line += f" {tci[tag][i]:15g}" - line += f" {tc[tag][i] - tci[tag][i]:15g}" + line += f" {f'{tag}_SK':>15s}" + line += f" {f'{tag}_SKIB':>15s}" + line += f" {f'{tag}_DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + for tag in tc.dtype.names[1:]: + line += f" {tc[tag][i]:15g}" + line += f" {tci[tag][i]:15g}" + line += f" {tc[tag][i] - tci[tag][i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) # compare cbc and lst budgets -def cbc_compare(sim): - print("evaluating cbc and budget...") +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -428,7 +423,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -441,7 +436,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -459,59 +454,57 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation(name=name, exe_dict=targets, exfunc=eval_wcomp), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_csub_wtgeo.py b/autotest/test_gwf_csub_wtgeo.py index 6f691516290..a0f50764e8d 100644 --- a/autotest/test_gwf_csub_wtgeo.py +++ b/autotest/test_gwf_csub_wtgeo.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "csub_wtgeoa", "csub_wtgeob", "csub_wtgeoc", @@ -15,19 +15,19 @@ "csub_wtgeof", "csub_wtgeog", ] -constantcv = [True for idx in range(len(ex))] +constantcv = [True for _ in range(len(cases))] cmppth = "mf6_regression" -compare = [True for idx in range(len(ex))] +compare = [True for _ in range(len(cases))] tops = [0.0, 0.0, 150.0, 0.0, 0.0, 150.0, 150.0] ump = [None, None, True, None, True, None, True] iump = [0, 0, 1, 0, 1, 0, 1] -eslag = [True for idx in range(len(ex) - 2)] + 2 * [False] +eslag = [True for _ in range(len(cases) - 2)] + 2 * [False] # eslag = [True, True, True, False, True, False, False] headformulation = [True, False, False, True, True, False, False] ndc = [None, None, None, 19, 19, 19, 19] delay = [False, False, False, True, True, True, True] # newton = ["", "", "", "", "", None, ""] -newton = ["NEWTON" for idx in range(len(ex))] +newton = ["NEWTON" for _ in range(len(cases))] htol = [None, None, None, 0.2, None, None, None] dtol = 1e-3 @@ -37,13 +37,13 @@ # static model data # temporal discretization nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 3, 10, 10 @@ -161,7 +161,7 @@ def calc_stress(sgm0, sgs0, h, bt): def get_model(idx, ws): - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws @@ -472,25 +472,25 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - sim = get_model(idx, dir) # modflow6 files - mc = get_model(idx, os.path.join(dir, cmppth)) # build comparison files +def build_models(idx, test): + sim = get_model(idx, test.workspace) # modflow6 files + mc = get_model( + idx, os.path.join(test.workspace, cmppth) + ) # build comparison files return sim, mc -def eval_comp(sim): - - if compare[sim.idxsim]: - print("evaluating compaction...") +def check_output(idx, test): + if compare[idx]: # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # comparision total compaction results - fpth = os.path.join(sim.simpath, cmppth, "csub_obs.csv") + fpth = os.path.join(test.workspace, cmppth, "csub_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -503,40 +503,36 @@ def eval_comp(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.comp.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.comp.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'CSUB':>15s}" - line += f" {'MF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc0['time'][i]:15g}" - line += f" {tc['TCOMP3'][i]:15g}" - line += f" {tc0['TCOMP3'][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'CSUB':>15s}" + line += f" {'MF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc0['time'][i]:15g}" + line += f" {tc['TCOMP3'][i]:15g}" + line += f" {tc0['TCOMP3'][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare budgets - cbc_compare(sim) + cbc_compare(test) - return - -def cbc_compare(sim): - print("evaluating cbc and budget...") +def cbc_compare(test): # open cbc file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") # build list of cbc data to retrieve @@ -553,7 +549,7 @@ def cbc_compare(sim): bud_lst.append(f"{t}_OUT") # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -566,7 +562,7 @@ def cbc_compare(sim): # get data from cbc dile kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -584,64 +580,60 @@ def cbc_compare(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize("idx, name", list(enumerate(ex))) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_comp, - htol=htol[idx], - idxsim=idx, - mf6_regression=True, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], + compare="mf6_regression", + verbose=False, ) + test.run() diff --git a/autotest/test_gwf_csub_zdisp01.py b/autotest/test_gwf_csub_zdisp01.py index f6ee90544e8..5b2f6091b3e 100644 --- a/autotest/test_gwf_csub_zdisp01.py +++ b/autotest/test_gwf_csub_zdisp01.py @@ -4,12 +4,12 @@ import numpy as np import pytest from flopy.utils.compare import compare_heads + from framework import TestFramework -from simulation import TestSimulation -ex = ["csub_zdisp01"] +cases = ["csub_zdisp01"] cmppth = "mfnwt" -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] dtol = 1e-3 budtol = 1e-2 bud_lst = [ @@ -30,14 +30,14 @@ # static model data # temporal discretization nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] -# tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] +# tsmult = [1.0] + [1.0 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 3, 20, 20 @@ -192,11 +192,11 @@ # variant SUB package problem 3 -def get_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -328,8 +328,10 @@ def get_model(idx, dir): # build MODFLOW-NWT files cpth = cmppth - ws = os.path.join(dir, cpth) - mc = flopy.modflow.Modflow(name, model_ws=ws, version=cpth) + ws = os.path.join(test.workspace, cpth) + mc = flopy.modflow.Modflow( + name, model_ws=ws, version=cpth, exe_name=test.targets["mfnwt"] + ) dis = flopy.modflow.ModflowDis( mc, nlay=nlay, @@ -393,27 +395,24 @@ def get_model(idx, dir): idroptol=0, ) - sim.write_simulation() - mc.write_input() - return sim, mc -def eval_zdisplacement(sim): - print("evaluating z-displacement...") - +def check_output(idx, test): # MODFLOW 6 total compaction results - fpth = os.path.join(sim.simpath, "csub_obs.csv") + fpth = os.path.join(test.workspace, "csub_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW-2005 total compaction results - fn = f"{os.path.basename(sim.name)}.total_comp.hds" - fpth = os.path.join(sim.simpath, "mfnwt", fn) + fn = f"{os.path.basename(test.name)}.total_comp.hds" + fpth = os.path.join(test.workspace, "mfnwt", fn) try: - sobj = flopy.utils.HeadFile(fpth, text="LAYER COMPACTION") + sobj = flopy.utils.HeadFile( + fpth, text="LAYER COMPACTION", verbose=False + ) tc0 = sobj.get_ts((2, wrp[0], wcp[0])) except: assert False, f'could not load data from "{fpth}"' @@ -424,15 +423,15 @@ def eval_zdisplacement(sim): msg = f"maximum absolute total-compaction difference ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -451,11 +450,11 @@ def eval_zdisplacement(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") - cobj = flopy.utils.CellBudgetFile(fpth, precision="double") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") + cobj = flopy.utils.CellBudgetFile(fpth, precision="double", verbose=False) kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -473,60 +472,59 @@ def eval_zdisplacement(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # compare z-displacement data fpth1 = os.path.join( - sim.simpath, - f"{os.path.basename(sim.name)}.zdisplacement.gridbin", + test.workspace, + f"{os.path.basename(test.name)}.zdisplacement.gridbin", ) - fpth2 = os.path.join(sim.simpath, cmppth, "csub_zdisp01.vert_disp.hds") + fpth2 = os.path.join(test.workspace, cmppth, "csub_zdisp01.vert_disp.hds") text1 = "CSUB-ZDISPLACE" text2 = "Z DISPLACEMENT" fout = os.path.join( - sim.simpath, - f"{os.path.basename(sim.name)}.z-displacement.bin.out", + test.workspace, + f"{os.path.basename(test.name)}.z-displacement.bin.out", ) success_tst = compare_heads( None, @@ -542,28 +540,22 @@ def eval_zdisplacement(sim): ) msg = f"z-displacement comparison success = {success_tst}" if success_tst: - sim.success = True + test.success = True print(msg) else: - sim.success = False + test.success = False assert success_tst, msg @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - sim, mc = get_model(idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_zdisplacement, - htol=htol[idx], - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], ) + test.run() diff --git a/autotest/test_gwf_disu.py b/autotest/test_gwf_disu.py index 85880b95d82..c850d48f390 100644 --- a/autotest/test_gwf_disu.py +++ b/autotest/test_gwf_disu.py @@ -1,13 +1,26 @@ +""" +Test of GWF DISU Package. Use the flopy disu tool to create +a simple regular grid example, but using DISU instead of DIS. +The first case is just a simple test. For the second case, set +one of the cells inactive and test to make sure connectivity +in binary grid file is correct. +""" + import os import flopy import numpy as np +import pytest from flopy.utils.gridutil import get_disu_kwargs +from framework import TestFramework + +cases = ["disu01a", "disu01b"] + -def test_disu_simple(tmpdir, targets): - mf6 = targets["mf6"] - name = "disu01a" +def build_models(idx, test): + name = cases[idx] + ws = test.workspace nlay = 3 nrow = 3 ncol = 3 @@ -15,9 +28,26 @@ def test_disu_simple(tmpdir, targets): delc = 10.0 * np.ones(nrow) top = 0 botm = [-10, -20, -30] - disukwargs = get_disu_kwargs(nlay, nrow, ncol, delr, delc, top, botm) + disukwargs = get_disu_kwargs( + nlay, + nrow, + ncol, + delr, + delc, + top, + botm, + ) + if idx == 1: + # for the second test, set one cell to idomain = 0 + idomain = np.ones((nlay, nrow * ncol), dtype=int) + idomain[0, 1] = 0 + disukwargs["idomain"] = idomain + sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=mf6, sim_ws=str(tmpdir) + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, ) tdis = flopy.mf6.ModflowTdis(sim) gwf = flopy.mf6.ModflowGwf(sim, modelname=name) @@ -25,67 +55,36 @@ def test_disu_simple(tmpdir, targets): disu = flopy.mf6.ModflowGwfdisu(gwf, **disukwargs) ic = flopy.mf6.ModflowGwfic(gwf, strt=0.0) npf = flopy.mf6.ModflowGwfnpf(gwf) - spd = {0: [[(0,), 1.0], [(nrow * ncol - 1,), 0.0]]} + spd = {0: [[(0,), 1.0], [(nrow * ncol - 1), 0.0]]} chd = flopy.mf6.modflow.mfgwfchd.ModflowGwfchd(gwf, stress_period_data=spd) - sim.write_simulation() - sim.run_simulation() + return sim, None -def test_disu_idomain_simple(tmpdir, targets): - mf6 = targets["mf6"] - name = "disu01b" - nlay = 3 - nrow = 3 - ncol = 3 - delr = 10.0 * np.ones(ncol) - delc = 10.0 * np.ones(nrow) - top = 0 - botm = [-10, -20, -30] - idomain = np.ones(nlay * nrow * ncol, dtype=int) - idomain[1] = 0 - disukwargs = get_disu_kwargs(nlay, nrow, ncol, delr, delc, top, botm) - disukwargs["idomain"] = idomain - sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=mf6, sim_ws=str(tmpdir) - ) - tdis = flopy.mf6.ModflowTdis(sim) - gwf = flopy.mf6.ModflowGwf(sim, modelname=name, save_flows=True) - ims = flopy.mf6.ModflowIms(sim, print_option="SUMMARY") - disu = flopy.mf6.ModflowGwfdisu(gwf, **disukwargs) - ic = flopy.mf6.ModflowGwfic(gwf, strt=0.0) - npf = flopy.mf6.ModflowGwfnpf(gwf) - spd = {0: [[(0,), 1.0], [(nrow * ncol - 1,), 0.0]]} - chd = flopy.mf6.modflow.ModflowGwfchd(gwf, stress_period_data=spd) - oc = flopy.mf6.modflow.ModflowGwfoc( - gwf, - budget_filerecord=f"{name}.bud", - head_filerecord=f"{name}.hds", - saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], - ) - sim.write_simulation() - sim.run_simulation() +def check_output(idx, test): + name = test.name - # check binary grid file - fname = os.path.join(str(tmpdir), name + ".disu.grb") + fname = os.path.join(test.workspace, name + ".disu.grb") grbobj = flopy.mf6.utils.MfGrdFile(fname) nodes = grbobj._datadict["NODES"] ia = grbobj._datadict["IA"] ja = grbobj._datadict["JA"] - assert nodes == disukwargs["nodes"] - assert np.array_equal(ia[0:4], np.array([1, 4, 4, 7])) - assert np.array_equal(ja[:6], np.array([1, 4, 10, 3, 6, 12])) - assert ia[-1] == 127 - assert ia.shape[0] == 28, "ia should have size of 28" - assert ja.shape[0] == 126, "ja should have size of 126" - # load head array and ensure nodata value in second cell - fname = os.path.join(str(tmpdir), name + ".hds") - hdsobj = flopy.utils.HeadFile(fname) - head = hdsobj.get_alldata().flatten() - assert head[1] == 1.0e30 + if idx == 1: + assert np.array_equal(ia[0:4], np.array([1, 4, 4, 7])) + assert np.array_equal(ja[:6], np.array([1, 4, 10, 3, 6, 12])) + assert ia[-1] == 127 + assert ia.shape[0] == 28, "ia should have size of 28" + assert ja.shape[0] == 126, "ja should have size of 126" - # load flowja to make sure it is the right size - fname = os.path.join(str(tmpdir), name + ".bud") - budobj = flopy.utils.CellBudgetFile(fname, precision="double") - flowja = budobj.get_data(text="FLOW-JA-FACE")[0].flatten() - assert flowja.shape[0] == 126 + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + ) + test.run() diff --git a/autotest/test_gwf_disv.py b/autotest/test_gwf_disv.py new file mode 100644 index 00000000000..31b08cba952 --- /dev/null +++ b/autotest/test_gwf_disv.py @@ -0,0 +1,96 @@ +""" +Test of GWF DISV Package. Use the flopy disv tool to create +a simple regular grid example, but using DISV instead of DIS. +Use a large offset for x and y vertices to ensure that the area +calculation in MODFLOW 6 is correct. For the second case, set +one of the cells inactive and test to make sure connectivity +in binary grid file is correct. +""" + +import os + +import flopy +import numpy as np +import pytest +from flopy.utils.gridutil import get_disv_kwargs + +from framework import TestFramework + +cases = ["disv01a", "disv01b"] + + +def build_models(idx, test): + name = cases[idx] + ws = test.workspace + nlay = 3 + nrow = 3 + ncol = 3 + delr = 10.0 + delc = 10.0 + top = 0 + botm = [-10, -20, -30] + xoff = 100000000.0 + yoff = 100000000.0 + disvkwargs = get_disv_kwargs( + nlay, + nrow, + ncol, + delr, + delc, + top, + botm, + xoff, + yoff, + ) + if idx == 1: + # for the second test, set one cell to idomain = 0 + idomain = np.ones((nlay, nrow * ncol), dtype=int) + idomain[0, 1] = 0 + disvkwargs["idomain"] = idomain + + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, + ) + tdis = flopy.mf6.ModflowTdis(sim) + gwf = flopy.mf6.ModflowGwf(sim, modelname=name) + ims = flopy.mf6.ModflowIms(sim, print_option="SUMMARY") + disv = flopy.mf6.ModflowGwfdisv(gwf, **disvkwargs) + ic = flopy.mf6.ModflowGwfic(gwf, strt=0.0) + npf = flopy.mf6.ModflowGwfnpf(gwf) + spd = {0: [[(0, 0), 1.0], [(0, nrow * ncol - 1), 0.0]]} + chd = flopy.mf6.modflow.mfgwfchd.ModflowGwfchd(gwf, stress_period_data=spd) + return sim, None + + +def check_output(idx, test): + name = test.name + + fname = os.path.join(test.workspace, name + ".disv.grb") + grbobj = flopy.mf6.utils.MfGrdFile(fname) + ncpl = grbobj._datadict["NCPL"] + ia = grbobj._datadict["IA"] + ja = grbobj._datadict["JA"] + + if idx == 1: + # assert ncpl == disvkwargs["ncpl"] + assert np.array_equal(ia[0:4], np.array([1, 4, 4, 7])) + assert np.array_equal(ja[:6], np.array([1, 4, 10, 3, 6, 12])) + assert ia[-1] == 127 + assert ia.shape[0] == 28, "ia should have size of 28" + assert ja.shape[0] == 126, "ja should have size of 126" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + ) + test.run() diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index cf89372267d..e681c041df1 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest A test of DISV with UZF. Originally created due to a possible bug in the ASCII output file generated by UZF. Uses quadrilateral cells. The cells are created from a numpy grid with cells that are 1m x 1m. Althought a DISV @@ -14,97 +13,37 @@ import flopy.utils.cvfdutil import numpy as np import pytest +from flopy.utils.gridutil import get_disv_kwargs + from framework import TestFramework -from simulation import TestSimulation -ex = ["disv_with_uzf"] +cases = ["disv_with_uzf"] nlay = 5 +nrow = 10 +ncol = 10 +ncpl = nrow * ncol +delr = 1.0 +delc = 1.0 nper = 5 perlen = [10] * 5 nstp = [5] * 5 tsmult = len(perlen) * [1.0] +top = 25.0 botm = [20.0, 15.0, 10.0, 5.0, 0.0] strt = 20 nouter, ninner = 100, 300 hclose, rclose, relax = 1e-9, 1e-3, 0.97 -ghb_ids = [] - - -def create_disv_mesh(): - # Create a grid of verts - nx, ny = (11, 11) - x = np.linspace(0, 10, nx) - y = np.linspace(0, 10, ny) - xv, yv = np.meshgrid(x, y) - yv = np.flipud(yv) - - verts = [] - vid = 0 - vert_lkup = {} - for i in yv[:, 0]: - for j in xv[0, :]: - vert_lkup.update({(float(j), float(i)): vid}) - verts.append([int(vid), float(j), float(i)]) - vid += 1 - - ivert = [] - ivid = 0 - xyverts = [] - xc, yc = [], [] # for storing the cell center location - for i in yv[:-1, 0]: - for j in xv[0, :-1]: - xlst, ylst = [], [] - vid_lst = [] - # Start with upper-left corner and go clockwise - for ct in [0, 1, 2, 3]: - if ct == 0: - iadj = 0.0 - jadj = 0.0 - elif ct == 1: - iadj = 0.0 - jadj = 1.0 - elif ct == 2: - iadj = -1.0 - jadj = 1.0 - elif ct == 3: - iadj = -1.0 - jadj = 0.0 - - vid = vert_lkup[(float(j + jadj), float(i + iadj))] - vid_lst.append(vid) - - xlst.append(float(j + jadj)) - ylst.append(float(i + iadj)) - - xc.append(np.mean(xlst)) - yc.append(np.mean(ylst)) - xyverts.append(list(zip(xlst, ylst))) - - rec = [ivid] + vid_lst - ivert.append(rec) - - # if ivert part of right boundary, store id - if j == 9.0: - ghb_ids.append(ivid) - - ivid += 1 - - # finally, create a cell2d record - cell2d = [] - for ix, iv in enumerate(ivert): - xvt, yvt = np.array(xyverts[ix]).T - if flopy.utils.geometry.is_clockwise(xvt, yvt): - rec = [iv[0], xc[ix], yc[ix], len(iv[1:])] + iv[1:] - else: - iiv = iv[1:][::-1] - rec = [iv[0], xc[ix], yc[ix], len(iiv)] + iiv - - cell2d.append(rec) - - return verts, cell2d - -verts, cell2d = create_disv_mesh() +# use flopy util to get disv arguments +disvkwargs = get_disv_kwargs( + nlay, + nrow, + ncol, + delr, + delc, + top, + botm, +) # Work up UZF data iuzno = 0 @@ -117,7 +56,7 @@ def create_disv_mesh(): eps = 3.5 for k in np.arange(nlay): - for i in np.arange(0, len(cell2d), 1): + for i in np.arange(0, ncpl, 1): if k == 0: landflg = 1 surfdp = 0.25 @@ -128,7 +67,7 @@ def create_disv_mesh(): if k == nlay - 1: ivertcon = -1 else: - ivertcon = iuzno + len(cell2d) + ivertcon = iuzno + ncpl bndnm = "uzf" + "{0:03d}".format(int(i + 1)) uzf_pkdat.append( @@ -160,7 +99,7 @@ def create_disv_mesh(): spd = [] iuzno = 0 for k in np.arange(nlay): - for i in np.arange(0, len(cell2d), 1): + for i in np.arange(0, ncpl, 1): if k == 0: if t == 0: finf = 0.15 @@ -180,6 +119,7 @@ def create_disv_mesh(): # Work up the GHB boundary +ghb_ids = [(ncol - 1) + i * ncol for i in range(nrow)] ghb_spd = [] cond = 1e4 for k in np.arange(3, 5, 1): @@ -187,12 +127,11 @@ def create_disv_mesh(): ghb_spd.append([(k, i), 14.0, cond]) -def build_model(idx, dir): - - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -230,18 +169,8 @@ def build_model(idx, dir): ) sim.register_ims_package(ims, [gwf.name]) - ncpl = len(cell2d) - nvert = len(verts) - disv = flopy.mf6.ModflowGwfdisv( - gwf, - nlay=nlay, - ncpl=ncpl, - nvert=nvert, - top=25.0, - botm=botm, - vertices=verts, - cell2d=cell2d, - ) + # disv + disv = flopy.mf6.ModflowGwfdisv(gwf, **disvkwargs) # initial conditions ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) @@ -313,17 +242,15 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # Next, get the binary printed heads - fpth = os.path.join(sim.simpath, sim.name + ".hds") + fpth = os.path.join(test.workspace, test.name + ".hds") hobj = flopy.utils.HeadFile(fpth, precision="double") hds = hobj.get_alldata() hds = hds.reshape((np.sum(nstp), 5, 10, 10)) # Get the MF6 cell-by-cell fluxes - bpth = os.path.join(sim.simpath, sim.name + ".cbc") + bpth = os.path.join(test.workspace, test.name + ".cbc") bobj = flopy.utils.CellBudgetFile(bpth, precision="double") bobj.get_unique_record_names() # ' STO-SS' @@ -341,7 +268,7 @@ def eval_model(sim): gwet = gwetv.reshape((np.sum(nstp), 5, 10, 10)) # Also retrieve the binary UZET output - uzpth = os.path.join(sim.simpath, sim.name + ".uzf.bud") + uzpth = os.path.join(test.workspace, test.name + ".uzf.bud") uzobj = flopy.utils.CellBudgetFile(uzpth, precision="double") uzobj.get_unique_record_names() # b' FLOW-JA-FACE', @@ -389,7 +316,7 @@ def eval_model(sim): for rw in np.arange(arr.shape[0]): fullrw = arr[rw] for cl in np.arange(len(fullrw) - 1): - assert abs(fullrw[cl]) >= abs(fullrw[cl + 1]), ( + assert abs(fullrw[cl]) + 0.01 >= abs(fullrw[cl + 1]), ( "gwet not decreasing to the right as expected. Stress Period: " + str(tm + 1) + "; Row: " @@ -423,7 +350,7 @@ def eval_model(sim): for rw in np.arange(arr.shape[0]): fullrw = arr[rw] for cl in np.arange(len(fullrw) - 1): - assert abs(fullrw[cl]) <= abs(fullrw[cl + 1]), ( + assert abs(fullrw[cl]) <= abs(fullrw[cl + 1]) + 0.01, ( "gwet not decreasing to the right as expected. Stress Period: " + str(tm + 1) + "; Row: " @@ -454,13 +381,13 @@ def eval_model(sim): @pytest.mark.slow -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_drn_ddrn01.py b/autotest/test_gwf_drn_ddrn01.py index 7814053e45c..881a2c74622 100644 --- a/autotest/test_gwf_drn_ddrn01.py +++ b/autotest/test_gwf_drn_ddrn01.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["drn_ddrn01a", "drn_ddrn01b"] paktest = "drn" budtol = 1e-2 -ex = ["drn_ddrn01a", "drn_ddrn01b"] ddir = "data" newton = [False, True] @@ -46,10 +46,10 @@ def initial_conditions(): return np.sqrt(h0**2 + x * (h1**2 - h0**2) / (xlen - delr)) -def get_model(idxsim, ws, name): +def get_model(idx, ws, name): strt = initial_conditions() hdsfile = f"{name}.hds" - if newton[idxsim]: + if newton[idx]: newtonoptions = "NEWTON" else: newtonoptions = None @@ -111,28 +111,26 @@ def get_model(idxsim, ws, name): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(idx, ws, name) return sim, None -def eval_disch(sim): - print("evaluating drain discharge...") - +def check_output(idx, test): # MODFLOW 6 drain discharge results - fpth = os.path.join(sim.simpath, "drn_obs.csv") + fpth = os.path.join(test.workspace, "drn_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 head results - fpth = os.path.join(sim.simpath, "head_obs.csv") + fpth = os.path.join(test.workspace, "head_obs.csv") try: th0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -140,7 +138,7 @@ def eval_disch(sim): # calculate the drain flux analytically xdiff = th0["H1_1_100"] - delev - f = drain_smoothing(xdiff, ddrn, newton=newton[sim.idxsim]) + f = drain_smoothing(xdiff, ddrn, newton=newton[idx]) tc0 = f * dcond * (delev - th0["H1_1_100"]) # calculate maximum absolute error @@ -151,32 +149,29 @@ def eval_disch(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.disc.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.disc.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'DRN':>15s}" - line += f" {'UZF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc['time'][i]:15g}" - line += f" {tc['D1_1_100'][i]:15g}" - line += f" {tc0[i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'DRN':>15s}" + line += f" {'UZF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc['time'][i]:15g}" + line += f" {tc['D1_1_100'][i]:15g}" + line += f" {tc0[i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) - return - def drain_smoothing(xdiff, xrange, newton=False): sat = xdiff / xrange @@ -191,16 +186,13 @@ def drain_smoothing(xdiff, xrange, newton=False): return f -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_disch, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_drn_ddrn02.py b/autotest/test_gwf_drn_ddrn02.py index 6f4cca16c45..f69068b235f 100644 --- a/autotest/test_gwf_drn_ddrn02.py +++ b/autotest/test_gwf_drn_ddrn02.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["drn_ddrn02a"] paktest = "drn" budtol = 1e-2 -ex = ["drn_ddrn02a"] # static model data # spatial discretization @@ -108,32 +108,30 @@ def get_model(ws, name, uzf=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with UZF package - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, uzf=True) return sim, mc -def eval_disch(sim): - print("evaluating drain discharge and uzf discharge to land surface...") - +def check_output(idx, test): # MODFLOW 6 drain discharge results - fpth = os.path.join(sim.simpath, "drn_obs.csv") + fpth = os.path.join(test.workspace, "drn_obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' # MODFLOW 6 uzf discharge results - fpth = os.path.join(sim.simpath, "mf6", "uzf_obs.csv") + fpth = os.path.join(test.workspace, "mf6", "uzf_obs.csv") try: tc0 = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -147,44 +145,37 @@ def eval_disch(sim): # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.disc.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.disc.cmp.out" ) - f = open(fpth, "w") - line = f"{'TOTIM':>15s}" - line += f" {'DRN':>15s}" - line += f" {'UZF':>15s}" - line += f" {'DIFF':>15s}" - f.write(line + "\n") - for i in range(diff.shape[0]): - line = f"{tc0['time'][i]:15g}" - line += f" {tc['D1_1_1'][i]:15g}" - line += f" {tc0['D1_1_1'][i]:15g}" - line += f" {diff[i]:15g}" + with open(fpth, "w") as f: + line = f"{'TOTIM':>15s}" + line += f" {'DRN':>15s}" + line += f" {'UZF':>15s}" + line += f" {'DIFF':>15s}" f.write(line + "\n") - f.close() + for i in range(diff.shape[0]): + line = f"{tc0['time'][i]:15g}" + line += f" {tc['D1_1_1'][i]:15g}" + line += f" {tc0['D1_1_1'][i]:15g}" + line += f" {diff[i]:15g}" + f.write(line + "\n") if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=str(function_tmpdir), - exe_dict=targets, - exfunc=eval_disch, - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_errors.py b/autotest/test_gwf_errors.py index c7ba06ea3b2..2d23c2fd31b 100644 --- a/autotest/test_gwf_errors.py +++ b/autotest/test_gwf_errors.py @@ -1,9 +1,7 @@ """ -MODFLOW 6 Autotest Test to make sure that mf6 is failing with the correct error messages. This test script is set up to be extensible so that simple models can be created very easily and tested with different options to succeed or fail correctly. - """ import subprocess @@ -110,7 +108,7 @@ def get_minimal_gwf_simulation( def test_simple_model_success(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] # test a simple model to make sure it runs and terminates correctly sim = get_minimal_gwf_simulation(str(function_tmpdir), mf6) @@ -124,7 +122,7 @@ def test_simple_model_success(function_tmpdir, targets): def test_empty_folder(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] with pytest.raises(RuntimeError): # make sure mf6 fails when there is no simulation name file err_str = "mf6: mfsim.nam is not present in working directory." @@ -132,7 +130,7 @@ def test_empty_folder(function_tmpdir, targets): def test_sim_errors(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] with pytest.raises(RuntimeError): # verify that the correct number of errors are reported @@ -149,7 +147,7 @@ def test_sim_errors(function_tmpdir, targets): def test_sim_maxerrors(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] with pytest.raises(RuntimeError): # verify that the maxerrors keyword gives the correct error output @@ -176,7 +174,7 @@ def test_sim_maxerrors(function_tmpdir, targets): def test_disu_errors(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] with pytest.raises(RuntimeError): disukwargs = get_disu_kwargs( @@ -204,7 +202,7 @@ def test_disu_errors(function_tmpdir, targets): def test_solver_fail(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] with pytest.raises(RuntimeError): # test failed to converge @@ -221,7 +219,7 @@ def test_solver_fail(function_tmpdir, targets): def test_fail_continue_success(function_tmpdir, targets): - mf6 = targets.mf6 + mf6 = targets["mf6"] # test continue but failed to converge tdiskwargs = {"nper": 1, "perioddata": [(10.0, 10, 1.0)]} diff --git a/autotest/test_gwf_evt01.py b/autotest/test_gwf_evt01.py index d90d6ccfed5..33b4ca458c2 100644 --- a/autotest/test_gwf_evt01.py +++ b/autotest/test_gwf_evt01.py @@ -3,14 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["evt01"] +from framework import TestFramework +cases = ["evt01"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 3 chdheads = list(np.linspace(1, 100)) nper = len(chdheads) @@ -28,10 +27,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -153,14 +152,12 @@ def etfunc(h, qmax, surf, exdp, petm, pxdp, petm0=1.0): return q, hcof, rhs -def eval_model(sim): - print("evaluating model...") - - fpth = os.path.join(sim.simpath, "evt01.cbc") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "evt01.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="evt") - fpth = os.path.join(sim.simpath, "evt01.hds") + fpth = os.path.join(test.workspace, "evt01.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") heads = hobj.get_alldata() @@ -177,16 +174,13 @@ def eval_model(sim): assert np.allclose(sim_evt_rate, cal_evt_rate), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_evt02.py b/autotest/test_gwf_evt02.py index ad1191eb7cc..a8b6adebfbb 100644 --- a/autotest/test_gwf_evt02.py +++ b/autotest/test_gwf_evt02.py @@ -3,14 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["evt02"] +from framework import TestFramework +cases = ["evt02"] -def build_model(idx, dir, exe): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 3 chdheads = list(np.linspace(1, 100)) nper = len(chdheads) @@ -28,12 +27,12 @@ def build_model(idx, dir, exe): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -151,25 +150,19 @@ def etfunc(h, qmax, surf, exdp, petm, pxdp, petm0=1.0): return q, hcof, rhs -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # The nature of the bug is that the model crashes with nseg=1 - fpth = os.path.join(sim.simpath, "evt02.cbc") + fpth = os.path.join(test.workspace, "evt02.cbc") assert os.path.isfile(fpth), "model did not run with nseg=1 in EVT input" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - mf6 = targets["mf6"] - test.build(lambda i, w: build_model(i, w, mf6), idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_exgmvr01.py b/autotest/test_gwf_exgmvr01.py new file mode 100644 index 00000000000..131a7c72af0 --- /dev/null +++ b/autotest/test_gwf_exgmvr01.py @@ -0,0 +1,309 @@ +""" +Based on sft01 gwf model, but split into two gwf models test gwf-gwf and +mvr. The single model is run as the regression model + +The final split model look like: + + flow1 flow2 + sfr 1 2 3 4 5 6 7 gwfgwf-mvr => 1 2 3 4 5 6 7 + ------------- ------------- + gwf 1 2 3 4 5 6 7 gwfgwf => 1 2 3 4 5 6 7 +""" + + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["gwf_exgmvr01"] + +# properties for single model combination +lx = 14.0 +lz = 1.0 +nlay = 1 +nrow = 1 +ncol = 14 +nper = 1 +delc = 1.0 +delr = lx / ncol +delz = lz / nlay +top = 0.0 +botm = [top - (k + 1) * delz for k in range(nlay)] +Kh = 20.0 +Kv = 20.0 + + +def build_simulation(idx, sim_ws, sim_type="single"): + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + sim_ws=sim_ws, + ) + + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=nper, + ) + + # Flow solver + ims = flopy.mf6.ModflowIms( + sim, + complexity="simple", + print_option="ALL", + outer_dvclose=1e-6, + inner_dvclose=1e-6, + ) + + if sim_type == "single": + gwf_types = ("single",) + else: + gwf_types = ("left", "right") + for gwf_type in gwf_types: + gwf = build_gwf(sim, gwf_type=gwf_type) + + if sim_type != "single": + build_exchanges(sim) + + return sim + + +def build_gwf(sim, gwf_type="single"): + if gwf_type == "single": + nc = ncol + else: + nc = int(ncol / 2) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=gwf_type, + save_flows=True, + ) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=nc, + delr=delr, + delc=delc, + top=top, + botm=botm, + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=0.0) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=True, + icelltype=0, + k=Kh, + k33=Kv, + ) + + # add chd to right edge + if gwf_type in ("single", "right"): + chdlist = [ + [(0, 0, nc - 1), 0.0], + ] + chd = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdlist, + pname="chd_right", + ) + + # inject water into left edge + if gwf_type in ("single", "left"): + wellist = [ + [(0, 0, 0), 1.0], + ] + wel = flopy.mf6.ModflowGwfwel( + gwf, + stress_period_data=wellist, + pname="well_left", + ) + + # pak_data = [ [] []] + rlen = delr + rwid = delc + rgrd = 1.0 + rtp = 0.0 + rbth = 0.1 + rhk = 0.01 + rman = 1.0 + ustrf = 1.0 + ndv = 0 + pak_data = [] + for irno in range(nc): + ncon = 2 + if irno in [0, nc - 1]: + ncon = 1 + cellid = (0, 0, irno) + t = ( + irno, + cellid, + rlen, + rwid, + rgrd, + rtp, + rbth, + rhk, + rman, + ncon, + ustrf, + ndv, + ) + pak_data.append(t) + + con_data = [] + for irno in range(nc): + if irno == 0: + t = (irno, -(irno + 1)) + elif irno == nc - 1: + t = (irno, irno - 1) + else: + t = (irno, irno - 1, -(irno + 1)) + con_data.append(t) + + if gwf_type in ("single", "left"): + p_data = [ + (0, "INFLOW", 1.0), + ] + else: + p_data = None + + if gwf_type != "single": + mover = True + else: + mover = None + + sfr = flopy.mf6.modflow.ModflowGwfsfr( + gwf, + save_flows=True, + print_input=True, + print_flows=True, + print_stage=True, + mover=mover, + stage_filerecord=f"{gwf_type}.sfr.stg", + budget_filerecord=f"{gwf_type}.sfr.bud", + nreaches=nc, + packagedata=pak_data, + connectiondata=con_data, + perioddata=p_data, + pname=f"sfr_{gwf_type}", + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwf_type}.cbc", + head_filerecord=f"{gwf_type}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("BUDGET", "LAST")], + ) + + return gwf + + +def build_exchanges(sim): + # add a gwf-gwf exchange + gwfgwf_data = [ + ( + (0, 0, int(ncol / 2) - 1), + (0, 0, 0), + 1, + delr / 2.0, + delr / 2.0, + delc, + 0.0, + delr, + ) + ] + + # GWF-GWF + mvr_filerecord = "left-right.exg.mvr" + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(gwfgwf_data), + exgmnamea="left", + exgmnameb="right", + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + dev_interfacemodel_on=False, + filename="left-right.exg", + ) + + # simulation GWF-GWF Mover + maxmvr, maxpackages = 1, 2 + mvrpack_sim = [["left", "sfr_left"], ["right", "sfr_right"]] + mvrspd = [ + [ + "left", + "sfr_left", + int(ncol / 2) - 1, + "right", + "sfr_right", + 0, + "FACTOR", + 1.00, + ] + ] + + gwfgwf.mvr.initialize( + modelnames=True, + maxmvr=maxmvr, + print_flows=True, + maxpackages=maxpackages, + packages=mvrpack_sim, + perioddata=mvrspd, + filename=mvr_filerecord, + ) + + +def build_models(idx, test): + sim_ws = test.workspace / "mf6" + sim_base = build_simulation(idx, sim_ws) + sim = build_simulation(idx, test.workspace, sim_type="split") + return sim, sim_base + + +def check_output(idx, test): + # base simulations stage + ws = test.workspace + fpth = ws / "mf6/single.sfr.stg" + single_stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + single_stage = single_stage_obj.get_data().squeeze() + + stage = single_stage.copy() + + i1 = int(ncol / 2) + fpth = ws / "left.sfr.stg" + stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + v = stage_obj.get_data().squeeze() + stage[:i1] = v[:] + + fpth = ws / "right.sfr.stg" + stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + v = stage_obj.get_data().squeeze() + stage[i1:] = v[:] + + assert np.allclose(single_stage, stage), "sfr stages are not equal" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + ) + test.run() diff --git a/autotest/test_gwf_exgmvr02.py b/autotest/test_gwf_exgmvr02.py new file mode 100644 index 00000000000..30ea52f079c --- /dev/null +++ b/autotest/test_gwf_exgmvr02.py @@ -0,0 +1,355 @@ +""" +Test the exchange mover functionality to work both ways, +also in parallel. Use the following setup of two connected +DIS models with a stream flow crossing the boundary twice: + + + left: right: + . . . . . . . . . . 1 + sfr_in => x x x x x x x x x x 2 + . . . . . gwfgwf . . . . x 3 +sfr_out <= x x x x x x x x x x 4 + . . . . . . . . . . 5 + 1 2 3 4 5 6 7 8 9 10 + +The "single" model is also constructed as a reference. +""" + + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["gwf_exgmvr02"] + +nper = 1 + +lx = 10.0 +ly = 5.0 +lz = 1.0 +nlay = 1 +nrow = 5 +ncol = 10 +ncol_split = int(ncol / 2) +nper = 1 +delc = ly / nrow +delr = lx / ncol +delz = lz / nlay +top = 0.0 +botm = [top - (k + 1) * delz for k in range(nlay)] +Kh = 20.0 +Kv = 20.0 + + +def make_sfr_data(sfr_cells, ireach_offset=0): + """generate package and connection data for a string of connected cells""" + + pak_data = [] + con_data = [] + + rlen = delr + rwid = delc + rgrd = 1.0 + rtp = 0.0 + rbth = 0.1 + rhk = 0.01 + rman = 1.0 + ustrf = 1.0 + ndv = 0 + nc = len(sfr_cells) + for ridx, cellid in enumerate(sfr_cells): + irno = ridx + ireach_offset + ncon = 2 + if ridx in [0, nc - 1]: + ncon = 1 + t = ( + irno, + cellid, + rlen, + rwid, + rgrd, + rtp, + rbth, + rhk, + rman, + ncon, + ustrf, + ndv, + ) + pak_data.append(t) + + if ridx == 0: # first one only connected to the next + c = (irno, -(irno + 1)) + elif ridx == nc - 1: # last one only connected to the prev + c = (irno, irno - 1) + else: # connect upstream and downstream + c = (irno, irno - 1, -(irno + 1)) + con_data.append(c) + + return pak_data, con_data + + +def build_gwf(sim, gwf_type="single"): + if gwf_type == "single": + nc = ncol + else: # left or right + nc = int(ncol / 2) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=gwf_type, + save_flows=True, + ) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=nc, + delr=delr, + delc=delc, + top=top, + botm=botm, + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=0.0) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=True, + icelltype=0, + k=Kh, + k33=Kv, + ) + + # add chd to right edge + if gwf_type in ("single", "right"): + chdlist = [[(0, irow, nc - 1), 0.0] for irow in range(nrow)] + chd = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdlist, + pname="chd_right", + ) + + left_sfr1 = [(0, 1, icol) for icol in range(ncol_split)] + left_sfr2 = [(0, 3, icol - 1) for icol in range(ncol_split, 0, -1)] + + right_sfr = [(0, 1, icol) for icol in range(ncol_split)] + right_sfr.append((0, 2, ncol_split - 1)) + right_sfr.extend([(0, 3, icol - 1) for icol in range(ncol_split, 0, -1)]) + + # shift for single model: + for t in right_sfr: + print(t) + right_sfr_single = [(t[0], t[1], t[2] + ncol_split) for t in right_sfr] + + package_data = [] + if gwf_type == "single": + left_sfr1.extend(right_sfr_single) + left_sfr1.extend(left_sfr2) + package_data, conn_data = make_sfr_data(left_sfr1) + elif gwf_type == "left": + # these two are not connected + package_data, conn_data = make_sfr_data(left_sfr1) + package_data2, conn_data2 = make_sfr_data( + left_sfr2, ireach_offset=len(package_data) + ) + package_data.extend(package_data2) + conn_data.extend(conn_data2) + elif gwf_type == "right": + package_data, conn_data = make_sfr_data(right_sfr) + + nreaches = len(package_data) + + if gwf_type in ("single", "left"): + period_data = [ + (0, "INFLOW", 100.0), + ] + else: + period_data = None + + if gwf_type != "single": + mover = True + else: + mover = None + + sfr = flopy.mf6.modflow.ModflowGwfsfr( + gwf, + save_flows=True, + print_input=True, + print_flows=True, + print_stage=True, + mover=mover, + stage_filerecord=f"{gwf_type}.sfr.stg", + budget_filerecord=f"{gwf_type}.sfr.bud", + nreaches=nreaches, + packagedata=package_data, + connectiondata=conn_data, + perioddata=period_data, + pname=f"sfr_{gwf_type}", + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwf_type}.cbc", + head_filerecord=f"{gwf_type}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("BUDGET", "LAST")], + ) + + return gwf + + +def build_exchanges(sim): + # add a gwf-gwf exchange + gwfgwf_data = [ + ( + (0, irow, ncol_split - 1), + (0, irow, 0), + 1, + delr / 2.0, + delr / 2.0, + delc, + 0.0, + delr, + ) + for irow in range(nrow) + ] + + # GWF-GWF + mvr_filerecord = "left-right.exg.mvr" + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(gwfgwf_data), + exgmnamea="left", + exgmnameb="right", + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + dev_interfacemodel_on=False, + filename="left-right.exg", + ) + + # simulation GWF-GWF Mover + maxmvr, maxpackages = 2, 2 + mvrpack_sim = [["left", "sfr_left"], ["right", "sfr_right"]] + mvrspd = [ + # connect left to right + [ + "left", + "sfr_left", + ncol_split - 1, + "right", + "sfr_right", + 0, + "FACTOR", + 1.00, + ], + # connect right to left + [ + "right", + "sfr_right", + 2 * ncol_split, + "left", + "sfr_left", + ncol_split, + "FACTOR", + 1.00, + ], + ] + + gwfgwf.mvr.initialize( + modelnames=True, + maxmvr=maxmvr, + print_flows=True, + maxpackages=maxpackages, + packages=mvrpack_sim, + perioddata=mvrspd, + filename=mvr_filerecord, + ) + + +def build_simulation(idx, sim_ws, sim_type="single"): + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + sim_ws=sim_ws, + ) + + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=nper, + ) + + # Flow solver + ims = flopy.mf6.ModflowIms( + sim, + complexity="simple", + print_option="ALL", + outer_dvclose=1e-6, + inner_dvclose=1e-6, + ) + + if sim_type == "single": + gwf_types = ("single",) + else: + gwf_types = ("left", "right") + for gwf_type in gwf_types: + gwf = build_gwf(sim, gwf_type=gwf_type) + + if sim_type != "single": + build_exchanges(sim) + + return sim + + +def build_models(idx, test): + sim_ws = test.workspace / "mf6" + sim_base = build_simulation(idx, sim_ws) + sim = build_simulation(idx, test.workspace, sim_type="split") + return sim, sim_base + + +def check_output(idx, test): + # base simulations stage + ws = test.workspace + fpth = ws / "mf6/single.sfr.stg" + single_stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + single_stage = single_stage_obj.get_data().squeeze() + + fpth = ws / "left.sfr.stg" + stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + v = stage_obj.get_data().squeeze() + assert np.allclose( + single_stage[0:ncol_split], v[0:ncol_split] + ), "sfr left (segment I) stages are not equal" + assert np.allclose( + single_stage[3 * ncol_split + 1 :], v[ncol_split:] + ), "sfr left (segment II) stages are not equal" + + fpth = ws / "right.sfr.stg" + stage_obj = flopy.utils.HeadFile(fpth, text="STAGE") + v = stage_obj.get_data().squeeze() + assert np.allclose( + single_stage[ncol_split : 3 * ncol_split + 1], v + ), "sfr right stages are not equal" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + ) + test.run() diff --git a/autotest/test_gwf_henry_nr.py b/autotest/test_gwf_henry_nr.py index c072f3f2b58..a0d3f65a0fe 100644 --- a/autotest/test_gwf_henry_nr.py +++ b/autotest/test_gwf_henry_nr.py @@ -1,18 +1,19 @@ -# This is the Henry, Newton-Raphson problem described by Langevin et al (2020) -# with a 20 by 40 grid instead of the 40 by 80 grid described in the paper. -# There is freshwater inflow on the left and a sloping sea boundary on the -# right with moves up and down according to a simple sine function. GHBs -# and DRNs alternate and move up and down along the boundary to represent -# the effects of tides on the aquifer. +""" +The Henry, Newton-Raphson problem described by Langevin et al (2020) +with a 20x40 grid instead of the 40x80 grid described in the paper. +There is freshwater inflow on the left. A sloping sea boundary on the +right moves up and down according to a simple sine function. GHBs and +DRNs alternate and move up and down along the boundary to represent +the effects of tides on the aquifer. +""" import flopy import numpy as np import pytest -from conftest import should_compare + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_henrynr01"] +cases = ["gwf_henrynr01"] # global model variables nlay = 20 @@ -65,9 +66,9 @@ def sinfunc(a, b, c, d, x): return a * np.sin(b * (x - c)) + d -def build_model(idx, dir, exe): - ws = dir - name = ex[idx] +def build_models(idx, test): + ws = test.workspace + name = cases[idx] nrow = 1 delr = lx / ncol @@ -89,7 +90,7 @@ def build_model(idx, dir, exe): # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) sim.name_file.continue_ = False @@ -231,26 +232,16 @@ def build_model(idx, dir, exe): return sim, None -# - No need to change any code below @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): name = "gwf-henry-nr" - comparisons = {name: ("6.2.1",)} - mf6 = targets["mf6"] - test = TestFramework() - test.build(lambda i, w: build_model(i, w, mf6), idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - idxsim=idx, - mf6_regression=True, - cmp_verbose=False, - make_comparison=should_compare(name, comparisons, targets), - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + compare="mf6_regression", + verbose=False, ) + test.run() diff --git a/autotest/test_gwf_ifmod_buy.py b/autotest/test_gwf_ifmod_buy.py index 428b025c230..0f0bfa5df4d 100644 --- a/autotest/test_gwf_ifmod_buy.py +++ b/autotest/test_gwf_ifmod_buy.py @@ -1,34 +1,36 @@ +""" +General test for the interface model approach. +It compares the result of a single reference model +to the equivalent case where the domain is decomposed +and joined by a GWF-GWF exchange. + + 'refmodel' 'leftmodel' 'rightmodel' + + 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +We assert equality on the head values and the (components of) +specific discharges. All models are part of the same solution +for convenience. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# General test for the interface model approach. -# It compares the result of a single reference model -# to the equivalent case where the domain is decomposed -# and joined by a GWF-GWF exchange. -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -# -# We assert equality on the head values and the (components of) -# specific discharges. All models are part of the same solution -# for convenience. Finally, the budget error is checked. - -ex = ["ifmod_buy01"] + +cases = ["ifmod_buy01"] # some global convenience...: # model names @@ -84,7 +86,7 @@ def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -179,7 +181,6 @@ def get_model(idx, dir): def add_refmodel(sim): - gwf = flopy.mf6.ModflowGwf(sim, modelname=mname_ref, save_flows=True) dis = flopy.mf6.ModflowGwfdis( @@ -231,7 +232,6 @@ def add_refmodel(sim): def add_leftmodel(sim): - left_chd = [[(0, irow, 0), h_left] for irow in range(nrow)] chd_spd_left = {0: left_chd} @@ -273,7 +273,6 @@ def add_leftmodel(sim): def add_rightmodel(sim): - right_chd = [[(0, irow, ncol_right - 1), h_right] for irow in range(nrow)] chd_spd_right = {0: right_chd} @@ -317,7 +316,6 @@ def add_rightmodel(sim): def add_gwfexchange(sim): - angldegx = 0.0 cdist = delr gwfgwf_data = [ @@ -346,7 +344,6 @@ def add_gwfexchange(sim): def add_gwtrefmodel(sim): - gwt = flopy.mf6.ModflowGwt(sim, modelname=mname_gwtref) dis = flopy.mf6.ModflowGwtdis( @@ -393,7 +390,6 @@ def add_gwtrefmodel(sim): def add_gwtleftmodel(sim): - gwt = flopy.mf6.ModflowGwt(sim, modelname=mname_gwtleft) dis = flopy.mf6.ModflowGwtdis( @@ -440,7 +436,6 @@ def add_gwtleftmodel(sim): def add_gwtrightmodel(sim): - gwt = flopy.mf6.ModflowGwt(sim, modelname=mname_gwtright) dis = flopy.mf6.ModflowGwtdis( @@ -489,7 +484,6 @@ def add_gwtrightmodel(sim): def add_gwtexchange(sim): - angldegx = 0.0 cdist = delr gwtgwt_data = [ @@ -518,8 +512,8 @@ def add_gwtexchange(sim): ) -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None @@ -543,27 +537,27 @@ def qxqyqz(fname, nlay, nrow, ncol): return qx, qy, qz -def compare_to_ref(sim): +def check_output(idx, test): print("comparing heads and spec. discharge to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) heads = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_ref}.cbc") + fpth = os.path.join(test.workspace, f"{mname_ref}.cbc") nlay, nrow, ncol = heads.shape qxb, qyb, qzb = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds = flopy.utils.HeadFile(fpth) heads_left = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_left}.cbc") + fpth = os.path.join(test.workspace, f"{mname_left}.cbc") nlay, nrow, ncol = heads_left.shape qxb_left, qyb_left, qzb_left = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds = flopy.utils.HeadFile(fpth) heads_right = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_right}.cbc") + fpth = os.path.join(test.workspace, f"{mname_right}.cbc") nlay, nrow, ncol = heads_right.shape qxb_right, qyb_right, qzb_right = qxqyqz(fpth, nlay, nrow, ncol) @@ -634,7 +628,7 @@ def compare_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -645,17 +639,14 @@ def compare_to_ref(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - str(function_tmpdir), - ) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_ifmod_idomain.py b/autotest/test_gwf_ifmod_idomain.py index 4f89039dd14..8f5ac4c18d0 100644 --- a/autotest/test_gwf_ifmod_idomain.py +++ b/autotest/test_gwf_ifmod_idomain.py @@ -1,28 +1,30 @@ +""" +General test for the interface model approach. +It compares the result of a single reference model +to the equivalent case where the domain is decomposed +and joined by a GWF-GWF exchange. + +In this case we test the use of idomain at the interface + + 'refmodel' 'leftmodel' 'rightmodel' + + layer 1: 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 1 + layer 2: 1 1 1 1 1 1 1 1 1 1 VS 1 1 1 1 1 + 1 1 1 1 1 + layer 3: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +We assert equality on the head values. All models are part of a single +solution for convenience. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# General test for the interface model approach. -# It compares the result of a single reference model -# to the equivalent case where the domain is decomposed -# and joined by a GWF-GWF exchange. -# -# In this case we test the use of idomain at the interface -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# layer 1: 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 1 -# layer 2: 1 1 1 1 1 1 1 1 1 1 VS 1 1 1 1 1 + 1 1 1 1 1 -# layer 3: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -# -# We assert equality on the head values. All models are part of a single -# solution for convenience. Finally, the budget error is checked. - -ex = ["ifmod_ibound"] + +cases = ["ifmod_ibound"] # some global convenience...: # model names @@ -73,7 +75,7 @@ h_right = 75.0 # initial head -h_start = 0.0 +h_start = 0.0 # head boundaries @@ -103,7 +105,7 @@ def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -272,11 +274,7 @@ def add_rightmodel(sim): ) ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) npf = flopy.mf6.ModflowGwfnpf( - gwf, - save_specific_discharge=True, - save_flows=True, - icelltype=0, - k=hk + gwf, save_specific_discharge=True, save_flows=True, icelltype=0, k=hk ) chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd_right) oc = flopy.mf6.ModflowGwfoc( @@ -312,8 +310,8 @@ def add_gwfexchange(sim): ] for ilay in range(nlay) for irow in range(nrow) - if idomain_left[ilay, irow, ncol_left - 1] > 0 and - idomain_right[ilay, irow, 0] > 0 + if idomain_left[ilay, irow, ncol_left - 1] > 0 + and idomain_right[ilay, irow, 0] > 0 ] gwfgwf = flopy.mf6.ModflowGwfgwf( sim, @@ -327,31 +325,31 @@ def add_gwfexchange(sim): ) -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def compare_to_ref(sim): +def check_output(idx, test): print("comparing heads to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds_l = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds_r = flopy.utils.HeadFile(fpth) times = hds.get_times() for t in times: heads = hds.get_data(totim=t) - heads_left = hds_l.get_data(totim=t) + heads_left = hds_l.get_data(totim=t) heads_right = hds_r.get_data(totim=t) heads_2models = np.append(heads_left, heads_right, axis=2) # check idomain was used - assert heads[0, 0, 4] == 1.0e+30, "idomain was set to 0 for this cell" - assert heads[0, 0, 5] == 1.0e+30, "idomain was set to 0 for this cell" + assert heads[0, 0, 4] == 1.0e30, "idomain was set to 0 for this cell" + assert heads[0, 0, 5] == 1.0e30, "idomain was set to 0 for this cell" # compare heads maxdiff = np.amax(abs(heads - heads_2models)) @@ -364,7 +362,7 @@ def compare_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -375,17 +373,14 @@ def compare_to_ref(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ifmod_mult_exg.py b/autotest/test_gwf_ifmod_mult_exg.py index dc179b804db..c5593f0b75e 100644 --- a/autotest/test_gwf_ifmod_mult_exg.py +++ b/autotest/test_gwf_ifmod_mult_exg.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the interface model approach for multiple (2) exchanges between the same two models. One exchange has XT3D and the other one doesn't. @@ -19,18 +18,18 @@ will have the XT3D calculation enabled. TODO: (how) will this affect accuracy? - """ + import os import flopy import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation -ex = ["ifmod_mult_exg"] +cases = ["ifmod_mult_exg"] name_parent = "parent" name_child = "child" g_delr = 10.0 @@ -41,7 +40,7 @@ def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -256,25 +255,25 @@ def get_model(idx, dir): return sim -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def eval_heads(sim): - fpth = os.path.join(sim.simpath, f"{name_parent}.hds") +def check_output(idx, test): + fpth = os.path.join(test.workspace, f"{name_parent}.hds") hds = flopy.utils.HeadFile(fpth) heads = hds.get_data() - fpth = os.path.join(sim.simpath, f"{name_child}.hds") + fpth = os.path.join(test.workspace, f"{name_child}.hds") hds_c = flopy.utils.HeadFile(fpth) heads_c = hds_c.get_data() - fpth = os.path.join(sim.simpath, f"{name_parent}.dis.grb") + fpth = os.path.join(test.workspace, f"{name_parent}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) mg = grb.modelgrid - fpth = os.path.join(sim.simpath, f"{name_child}.dis.grb") + fpth = os.path.join(test.workspace, f"{name_child}.dis.grb") grb_c = flopy.mf6.utils.MfGrdFile(fpth) mg_c = grb_c.modelgrid @@ -330,17 +329,14 @@ def exact(x): # assert maxdiff_child_south > maxdiff_child_north -@pytest.mark.parametrize( - "name", - ex, -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_heads, idxsim=0 - ), - str(function_tmpdir), +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_ifmod_newton.py b/autotest/test_gwf_ifmod_newton.py index abfc8e2a3c8..9ae844132e5 100644 --- a/autotest/test_gwf_ifmod_newton.py +++ b/autotest/test_gwf_ifmod_newton.py @@ -1,34 +1,36 @@ +""" +General test for the interface model approach. +It compares the result of a single reference model +to the equivalent case where the domain is decomposed +and joined by a GWF-GWF exchange. + +In this case we test newton option, which is also enabled in +the interface model and should give identical results. + +period 1: The first stress period we start almost dry and have the + model fill up. +period 2: The BC on the left is lowered such that a part of the top + layer is drained. + + 'refmodel' 'leftmodel' 'rightmodel' + + layer 1: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 + layer 2: 1 . . . . . . . 1 VS 1 . . . . 1 + 1 . . 1 + layer 3: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 + +We assert equality on the head values. All models are part of the same +solution for convenience. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# General test for the interface model approach. -# It compares the result of a single reference model -# to the equivalent case where the domain is decomposed -# and joined by a GWF-GWF exchange. -# -# In this case we test newton option, which is also enabled in -# the interface model and should give identical results. -# -# period 1: The first stress period we start almost dry and have the -# model fill up. -# period 2: The BC on the left is lowered such that a part of the top -# layer is drained. -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# layer 1: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 -# layer 2: 1 . . . . . . . 1 VS 1 . . . . 1 + 1 . . 1 -# layer 3: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 -# -# We assert equality on the head values. All models are part of the same -# solution for convenience. Finally, the budget error is checked. - -ex = ["ifmod_newton01"] + +cases = ["ifmod_newton01"] # some global convenience...: # model names @@ -109,8 +111,8 @@ chd_spd_right[1] = rchd_right -def get_model(idx, dir): - name = ex[idx] +def get_model(idx, ws): + name = cases[idx] # parameters and spd # tdis @@ -123,7 +125,7 @@ def get_model(idx, dir): hclose, rclose, relax = hclose_check, 1e-3, 0.97 sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) tdis = flopy.mf6.ModflowTdis( @@ -175,8 +177,9 @@ def add_refmodel(sim): global chd_spd global tops - gwf = flopy.mf6.ModflowGwf(sim, modelname=mname_ref, newtonoptions="NEWTON", - save_flows=True) + gwf = flopy.mf6.ModflowGwf( + sim, modelname=mname_ref, newtonoptions="NEWTON", save_flows=True + ) dis = flopy.mf6.ModflowGwfdis( gwf, @@ -226,8 +229,9 @@ def add_leftmodel(sim): global h_left global chd_spd_left - gwf = flopy.mf6.ModflowGwf(sim, modelname=mname_left, newtonoptions="NEWTON", - save_flows=True) + gwf = flopy.mf6.ModflowGwf( + sim, modelname=mname_left, newtonoptions="NEWTON", save_flows=True + ) dis = flopy.mf6.ModflowGwfdis( gwf, nlay=nlay, @@ -268,8 +272,9 @@ def add_rightmodel(sim): global shift_x, shift_y global chd_spd_right - gwf = flopy.mf6.ModflowGwf(sim, modelname=mname_right, newtonoptions="NEWTON", - save_flows=True) + gwf = flopy.mf6.ModflowGwf( + sim, modelname=mname_right, newtonoptions="NEWTON", save_flows=True + ) dis = flopy.mf6.ModflowGwfdis( gwf, nlay=nlay, @@ -336,19 +341,19 @@ def add_gwfexchange(sim): ) -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def compare_to_ref(sim): +def check_output(idx, test): print("comparing heads to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds_l = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds_r = flopy.utils.HeadFile(fpth) times = hds.get_times() @@ -369,7 +374,7 @@ def compare_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -380,17 +385,14 @@ def compare_to_ref(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_ifmod_rewet.py b/autotest/test_gwf_ifmod_rewet.py index feb98489108..42562768c17 100644 --- a/autotest/test_gwf_ifmod_rewet.py +++ b/autotest/test_gwf_ifmod_rewet.py @@ -1,36 +1,38 @@ +""" +General test for the interface model approach. +It compares the result of a single reference model +to the equivalent case where the domain is decomposed +and joined by a GWF-GWF exchange. + +In this case we test rewetting, which is also enabled in +the interface model and should give identical results. + +period 1: The first stress period we start almost dry and have the + model fill up. +period 2: The BC on the left is lowered such that a part of the top + layer dries. To test the interface, the value is chosen such + that the boundary cell on the left is DRY and the one on the + right isn't. + + 'refmodel' 'leftmodel' 'rightmodel' + + layer 1: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 + layer 2: 1 . . . . . . . 1 VS 1 . . . . 1 + 1 . . 1 + layer 3: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 + +We assert equality on the head values. All models are part of the same +solution for convenience. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# General test for the interface model approach. -# It compares the result of a single reference model -# to the equivalent case where the domain is decomposed -# and joined by a GWF-GWF exchange. -# -# In this case we test rewetting, which is also enabled in -# the interface model and should give identical results. -# -# period 1: The first stress period we start almost dry and have the -# model fill up. -# period 2: The BC on the left is lowered such that a part of the top -# layer dries. To test the interface, the value is chosen such -# that the boundary cell on the left is DRY and the one on the -# right isn't. -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# layer 1: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 -# layer 2: 1 . . . . . . . 1 VS 1 . . . . 1 + 1 . . 1 -# layer 3: 1 . . . . . . . 1 1 . . . . 1 1 . . 1 -# -# We assert equality on the head values. All models are part of the same -# solution for convenience. Finally, the budget error is checked. - -ex = ["ifmod_rewet01"] + +cases = ["ifmod_rewet01"] # some global convenience...: # model names @@ -116,7 +118,7 @@ def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -348,25 +350,25 @@ def add_gwfexchange(sim): ) -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def compare_to_ref(sim): +def check_output(idx, test): print("comparing heads to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds_l = flopy.utils.HeadFile(fpth) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds_r = flopy.utils.HeadFile(fpth) times = hds.get_times() - for iper, t in enumerate(times): + for iper, t in enumerate(times): heads = hds.get_data(totim=t) - heads_left = hds_l.get_data(totim=t) + heads_left = hds_l.get_data(totim=t) heads_right = hds_r.get_data(totim=t) heads_2models = np.append(heads_left, heads_right, axis=2) @@ -374,9 +376,13 @@ def compare_to_ref(sim): # dry in period 2, but the cells in the right model should remain # active. This tests the interface model for dealing with drying # and wetting, and handling inactive cells, explicitly - if (iper == 1): - assert np.all(heads_left[0,0,:] == -1.0e+30), "left model, top layer should be DRY in period 2" - assert np.all(heads_right[0,0,:] > -1.0e+30), "right model, top layer should be WET in period 2" + if iper == 1: + assert np.all( + heads_left[0, 0, :] == -1.0e30 + ), "left model, top layer should be DRY in period 2" + assert np.all( + heads_right[0, 0, :] > -1.0e30 + ), "right model, top layer should be WET in period 2" # compare heads maxdiff = np.amax(abs(heads - heads_2models)) @@ -389,7 +395,7 @@ def compare_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -400,17 +406,14 @@ def compare_to_ref(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ifmod_vert.py b/autotest/test_gwf_ifmod_vert.py index 5e5240726a7..cf480fa2f9a 100644 --- a/autotest/test_gwf_ifmod_vert.py +++ b/autotest/test_gwf_ifmod_vert.py @@ -28,18 +28,18 @@ the child model should match the theory. In this case we just assert that they are equal for each column, something that is clearly not true when simulating without XT3D. - """ + import os import flopy import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation -ex = ["ifmod_vert"] +cases = ["ifmod_vert"] parent_name = "parent" child_name = "child" @@ -55,7 +55,7 @@ def get_model(idx, dir): global child_domain global hclose - name = ex[idx] + name = cases[idx] # tdis period data nper = 1 @@ -234,19 +234,19 @@ def get_model(idx, dir): return sim -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def eval_heads(sim): +def check_output(idx, test): print("comparing heads for child model to analytical result...") - fpth = os.path.join(sim.simpath, f"{child_name}.hds") + fpth = os.path.join(test.workspace, f"{child_name}.hds") hds_c = flopy.utils.HeadFile(fpth) heads_c = hds_c.get_data() - fpth = os.path.join(sim.simpath, f"{child_name}.dis.grb") + fpth = os.path.join(test.workspace, f"{child_name}.dis.grb") grb_c = flopy.mf6.utils.MfGrdFile(fpth) # (note that without XT3D on the exchange, the 'error' @@ -262,11 +262,11 @@ def eval_heads(sim): for mname in [parent_name, child_name]: print(f"Checking flowja residual for model {mname}") - fpth = os.path.join(sim.simpath, f"{mname}.dis.grb") + fpth = os.path.join(test.workspace, f"{mname}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) ia = grb._datadict["IA"] - 1 - fpth = os.path.join(sim.simpath, f"{mname}.cbc") + fpth = os.path.join(test.workspace, f"{mname}.cbc") assert os.path.isfile(fpth) cbb = flopy.utils.CellBudgetFile(fpth, precision="double") flow_ja_face = cbb.get_data(idx=0) @@ -281,17 +281,14 @@ def eval_heads(sim): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_heads, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_ifmod_xt3d01.py b/autotest/test_gwf_ifmod_xt3d01.py index bcff3b72dc8..2da24e89601 100644 --- a/autotest/test_gwf_ifmod_xt3d01.py +++ b/autotest/test_gwf_ifmod_xt3d01.py @@ -1,37 +1,39 @@ +""" +Test the interface model approach, when running +with a GWF-GWF exchange and XT3D applied on it. +It compares the result for a simple LGR configuration +to the analytical values: + + 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 + 1 1 0 0 0 1 1 +(H=1.0) 1 1 0 0 0 1 1 (H=0.0) + 1 1 0 0 0 1 1 + 1 1 1 1 1 1 1 + 1 1 1 1 1 1 1 + +with the region with ibound == 0 being simulated on the +a refined, 9x9 grid. + +This is also the first test problem presented in +the MODFLOW-USG manual: 'test006_2models' + +When running without XT3D, the results will disagree +with theory because the CVFD requirements are violated at the +at the LGR interface. We compare heads, specific discharge, and +confirm that there is no budget error. +""" + import os import flopy import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation - -# Test for the interface model approach, when running -# with a GWF-GWF exchange and XT3D applied on it. -# It compares the result for a simple LGR configuration -# to the analytical values: -# -# 1 1 1 1 1 1 1 -# 1 1 1 1 1 1 1 -# 1 1 0 0 0 1 1 -# (H=1.0) 1 1 0 0 0 1 1 (H=0.0) -# 1 1 0 0 0 1 1 -# 1 1 1 1 1 1 1 -# 1 1 1 1 1 1 1 -# -# with the region with ibound == 0 being simulated on the -# a refined, 9x9 grid. -# -# This is also the first test problem presented in -# the MODFLOW-USG manual: 'test006_2models' -# -# When running without XT3D, the results will disagree -# with theory because the CVFD requirements are violated at the -# at the LGR interface. We compare heads, specific discharge, and -# confirm that there is no budget error. - -ex = ["ifmod_xt3d01"] + +cases = ["ifmod_xt3d01"] # globally for convenience... useXT3D = True @@ -51,7 +53,7 @@ def get_model(idx, dir): global child_domain global hclose - name = ex[idx] + name = cases[idx] # tdis period data nper = 1 @@ -274,8 +276,8 @@ def get_model(idx, dir): return sim -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None @@ -299,30 +301,30 @@ def qxqyqz(fname, nlay, nrow, ncol): return qx, qy, qz -def eval_heads(sim): +def check_output(idx, test): print("comparing heads and spec. discharges to analytical result...") - fpth = os.path.join(sim.simpath, f"{parent_name}.hds") + fpth = os.path.join(test.workspace, f"{parent_name}.hds") hds = flopy.utils.HeadFile(fpth) heads = hds.get_data() - fpth = os.path.join(sim.simpath, f"{parent_name}.cbc") + fpth = os.path.join(test.workspace, f"{parent_name}.cbc") nlay, nrow, ncol = heads.shape qxb, qyb, qzb = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{child_name}.hds") + fpth = os.path.join(test.workspace, f"{child_name}.hds") hds_c = flopy.utils.HeadFile(fpth) heads_c = hds_c.get_data() - fpth = os.path.join(sim.simpath, f"{child_name}.cbc") + fpth = os.path.join(test.workspace, f"{child_name}.cbc") nlay, nrow, ncol = heads_c.shape qxb_c, qyb_c, qzb_c = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{parent_name}.dis.grb") + fpth = os.path.join(test.workspace, f"{parent_name}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) mg = grb.modelgrid - fpth = os.path.join(sim.simpath, f"{child_name}.dis.grb") + fpth = os.path.join(test.workspace, f"{child_name}.dis.grb") grb_c = flopy.mf6.utils.MfGrdFile(fpth) mg_c = grb_c.modelgrid @@ -406,7 +408,7 @@ def exact(x): # todo: mflistbudget # check cumulative balance error from .lst file for mname in [parent_name, child_name]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -419,7 +421,7 @@ def exact(x): # Check on residual, which is stored in diagonal position of # flow-ja-face. Residual should be less than convergence tolerance, # or this means the residual term is not added correctly. - fpth = os.path.join(sim.simpath, f"{parent_name}.cbc") + fpth = os.path.join(test.workspace, f"{parent_name}.cbc") cbb = flopy.utils.CellBudgetFile(fpth) flow_ja_face = cbb.get_data(idx=0) assert ( @@ -433,14 +435,14 @@ def exact(x): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg # Read gwf-gwf observations values - fpth = os.path.join(sim.simpath, "gwf_obs.csv") + fpth = os.path.join(test.workspace, "gwf_obs.csv") with open(fpth) as f: lines = f.readlines() obsnames = [name for name in lines[0].strip().split(",")[1:]] obsvalues = [float(v) for v in lines[1].strip().split(",")[1:]] # Extract the gwf-gwf flows stored in parent budget file - fpth = os.path.join(sim.simpath, f"{parent_name}.cbc") + fpth = os.path.join(test.workspace, f"{parent_name}.cbc") cbb = flopy.utils.CellBudgetFile(fpth, precision="double") parent_exchange_flows = cbb.get_data( kstpkper=(0, 0), text="FLOW-JA-FACE", paknam="GWF-GWF_1" @@ -448,7 +450,7 @@ def exact(x): parent_exchange_flows = parent_exchange_flows["q"] # Extract the gwf-gwf flows stored in child budget file - fpth = os.path.join(sim.simpath, f"{child_name}.cbc") + fpth = os.path.join(test.workspace, f"{child_name}.cbc") cbb = flopy.utils.CellBudgetFile(fpth, precision="double") child_exchange_flows = cbb.get_data( kstpkper=(0, 0), text="FLOW-JA-FACE", paknam="GWF-GWF_1" @@ -464,7 +466,7 @@ def exact(x): ), "exchange observations do not match child exchange flows" # Read the lumped boundname observations values - fpth = os.path.join(sim.simpath, "gwf_obs_boundnames.csv") + fpth = os.path.join(test.workspace, "gwf_obs_boundnames.csv") with open(fpth) as f: lines = f.readlines() obsnames = [name for name in lines[0].strip().split(",")[1:]] @@ -474,16 +476,13 @@ def exact(x): ), "boundname observations do not match expected results" -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, 0, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_heads, idxsim=0 - ), - str(function_tmpdir), +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_ifmod_xt3d02.py b/autotest/test_gwf_ifmod_xt3d02.py index b95c43b931b..e4876486ae0 100644 --- a/autotest/test_gwf_ifmod_xt3d02.py +++ b/autotest/test_gwf_ifmod_xt3d02.py @@ -1,49 +1,49 @@ +""" +Test the interface model approach. +It compares the result of a single, strongly anisotropic model +with XT3D enabled to the equivalent case where the domain is +decomposed and joined by a GWF-GWF exchange with XT3D applied. + + 'refmodel' 'leftmodel' 'rightmodel' + + 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +The head values should always be indentical. All models are +part of the same solution for convenience. +In addition, a check on the x,y,z components of specific discharge +is present. The values of the left submodel are compared to +the left part of the full model, and similar for right: they +should be identical. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# Test for the interface model approach. -# It compares the result of a single, strongly anisotropic model -# with XT3D enabled to the equivalent case where the domain is -# decomposed and joined by a GWF-GWF exchange with XT3D applied. -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -# -# The head values should always be indentical. All models are -# part of the same solution for convenience. -# In addition, a check on the x,y,z components of specific discharge -# is present. The values of the left submodel are compared to -# the left part of the full model, and similar for right: they -# should be identical. Finally, the budget error is checked. - -ex = ["ifmod_xt3d02"] -# global convenience... + +cases = ["ifmod_xt3d02"] mname_ref = "refmodel" mname_left = "leftmodel" mname_right = "rightmodel" hclose_check = 1e-9 max_inner_it = 300 - useXT3D = True def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -284,8 +284,8 @@ def get_model(idx, dir): return sim -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None @@ -309,27 +309,27 @@ def qxqyqz(fname, nlay, nrow, ncol): return qx, qy, qz -def compare_to_ref(sim): +def check_output(idx, test): print("comparing heads and spec. discharge to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) heads = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_ref}.cbc") + fpth = os.path.join(test.workspace, f"{mname_ref}.cbc") nlay, nrow, ncol = heads.shape qxb, qyb, qzb = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds = flopy.utils.HeadFile(fpth) heads_left = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_left}.cbc") + fpth = os.path.join(test.workspace, f"{mname_left}.cbc") nlay, nrow, ncol = heads_left.shape qxb_left, qyb_left, qzb_left = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds = flopy.utils.HeadFile(fpth) heads_right = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_right}.cbc") + fpth = os.path.join(test.workspace, f"{mname_right}.cbc") nlay, nrow, ncol = heads_right.shape qxb_right, qyb_right, qzb_right = qxqyqz(fpth, nlay, nrow, ncol) @@ -400,7 +400,7 @@ def compare_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -411,16 +411,13 @@ def compare_to_ref(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_ifmod_xt3d03.py b/autotest/test_gwf_ifmod_xt3d03.py new file mode 100644 index 00000000000..e942d03d393 --- /dev/null +++ b/autotest/test_gwf_ifmod_xt3d03.py @@ -0,0 +1,446 @@ +""" +Test the interface model approach. +It compares the result of a single, strongly anisotropic model +with XT3D enabled to the equivalent case where the domain is +decomposed into 4 models connected with GWF-GWF exchanges all +having XT3D enabled. Note the location of the well W, in the +bottom right corner of model "tl" (and also in "ref" of course) + + 'ref' 'tl' 'tr' + + 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 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 1 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 1 1 1 1 W 1 1 1 1 1 + 1 1 1 1 W 1 1 1 1 1 + 1 1 1 1 1 1 1 1 1 1 VS + + + 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 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 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 + + 'bl' 'br' + +The head values should always be indentical. All models are +part of the same solution for convenience. +In addition, a check on the x,y,z components of specific discharge +is present. Finally, the budget error is checked. +""" + +import os +from types import SimpleNamespace + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["ifmod_xt3d03"] + +hclose_check = 1e-9 +max_inner_it = 300 +useXT3D = True + +# model spatial discretization +nlay = 1 +ncol = 10 +ncol_split = 5 +nrow = 10 +nrow_split = 5 + +# cell spacing +delr = 10.0 +delc = 10.0 +area = delr * delc + +# shift (hor. and vert.) +shift_some_x = -20 * delr # avoids overlap +shift_x = 5 * delr +shift_y = 5 * delc + +# top/bot of the aquifer +tops = [0.0, -5.0] + +# hydraulic conductivity +k11 = 10.0 +k22 = 0.1 +k_angle = 45.0 + +# boundary stress period data +h_left = -2.0 +h_right = -2.0 + +# initial head +h_start = -2.0 + +# well +well_id = (0, 4, 4) +well_rate = -1.0 + + +def get_model(idx, dir): + name = cases[idx] + + # parameters and spd + # tdis + nper = 1 + tdis_rc = [] + for i in range(nper): + tdis_rc.append((1.0, 1, 1)) + + # solver data + nouter, ninner = 100, max_inner_it + hclose, rclose, relax = hclose_check, 1e-3, 0.97 + + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir + ) + + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="DBD", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + relaxation_factor=relax, + ) + + # reference model + dis_params = SimpleNamespace( + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + xorigin=shift_some_x, + yorigin=0.0, + tops=tops, + ) + create_gwf_model(sim, "ref", dis_params) + + # top-left model + dis_params.nrow = nrow_split + dis_params.ncol = ncol_split + dis_params.xorigin = 0.0 + dis_params.yorigin = shift_y + create_gwf_model(sim, "tl", dis_params) + + # bottom-left model + dis_params.xorigin = 0.0 + dis_params.yorigin = 0.0 + create_gwf_model(sim, "bl", dis_params) + + # top-right model + dis_params.xorigin = shift_x + dis_params.yorigin = shift_y + create_gwf_model(sim, "tr", dis_params) + + # bottom-right model + dis_params.xorigin = shift_x + dis_params.yorigin = 0.0 + create_gwf_model(sim, "br", dis_params) + + # two types of exchange data: + # tl-tr, bl-br (0 deg) + lr_data = [ + [ + (0, irow, ncol_split - 1), + (0, irow, 0), + 1, + delr / 2.0, + delr / 2.0, + delc, + 0.0, + delr, + ] + for irow in range(nrow_split) + ] + # tl-bl, tr-br (270 deg) + tb_data = [ + [ + (0, nrow_split - 1, icol), + (0, 0, icol), + 1, + delc / 2.0, + delc / 2.0, + delr, + 270.0, + delc, + ] + for icol in range(ncol_split) + ] + + # set up 4 exchanges + # tl-tr + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(lr_data), + exgmnamea="tl", + exgmnameb="tr", + exchangedata=lr_data, + auxiliary=["ANGLDEGX", "CDIST"], + xt3d=useXT3D, + filename="tltr.exg", + ) + + # bl-br + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(lr_data), + exgmnamea="bl", + exgmnameb="br", + exchangedata=lr_data, + auxiliary=["ANGLDEGX", "CDIST"], + xt3d=useXT3D, + filename="blbr.exg", + ) + + # tl-bl + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(tb_data), + exgmnamea="tl", + exgmnameb="bl", + exchangedata=tb_data, + auxiliary=["ANGLDEGX", "CDIST"], + xt3d=useXT3D, + filename="tlbl.exg", + ) + + # tr-br + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(tb_data), + exgmnamea="tr", + exgmnameb="br", + exchangedata=tb_data, + auxiliary=["ANGLDEGX", "CDIST"], + xt3d=useXT3D, + filename="trbr.exg", + ) + + return sim + + +def create_gwf_model(sim, mname, dis_params): + gwf = flopy.mf6.ModflowGwf(sim, modelname=mname, save_flows=True) + + dis_params = flopy.mf6.ModflowGwfdis( + gwf, + nlay=dis_params.nlay, + nrow=dis_params.nrow, + ncol=dis_params.ncol, + delr=dis_params.delr, + delc=dis_params.delc, + xorigin=dis_params.xorigin, + yorigin=dis_params.yorigin, + top=dis_params.tops[0], + botm=dis_params.tops[1:], + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=True, + xt3doptions=useXT3D, + save_flows=True, + icelltype=0, + k=k11, + k22=k22, + angle1=k_angle, + ) + + # chd file + left_chd = [] + right_chd = [] + if mname == "ref": + left_chd = [[(0, irow, 0), h_left] for irow in range(nrow)] + right_chd = [[(0, irow, ncol - 1), h_right] for irow in range(nrow)] + elif mname == "tl" or mname == "bl": + left_chd = [[(0, irow, 0), h_left] for irow in range(nrow_split)] + right_chd = [] + elif mname == "tr" or mname == "br": + left_chd = [] + right_chd = [ + [(0, irow, ncol_split - 1), h_right] for irow in range(nrow_split) + ] + chd_data = left_chd + right_chd + chd_spd = {0: chd_data} + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd) + + # well in top-left corner + if mname == "ref" or mname == "tl": + wel1 = flopy.mf6.ModflowGwfwel( + gwf, + stress_period_data=[[well_id, well_rate]], + print_input=True, + print_flows=True, + save_flows=False, + pname="WEL-1", + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + head_filerecord=f"{mname}.hds", + budget_filerecord=f"{mname}.cbc", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + +def build_models(idx, test): + sim = get_model(idx, test.workspace) + return sim, None + + +def qxqyqz(fname, nlay, nrow, ncol): + nodes = nlay * nrow * ncol + cbb = flopy.utils.CellBudgetFile(fname, precision="double") + spdis = cbb.get_data(text="DATA-SPDIS")[0] + qx = np.ones((nodes), dtype=float) * 1.0e30 + qy = np.ones((nodes), dtype=float) * 1.0e30 + qz = np.ones((nodes), dtype=float) * 1.0e30 + n0 = spdis["node"] - 1 + qx[n0] = spdis["qx"] + qy[n0] = spdis["qy"] + qz[n0] = spdis["qz"] + qx = qx.reshape(nlay, nrow, ncol) + qy = qy.reshape(nlay, nrow, ncol) + qz = qz.reshape(nlay, nrow, ncol) + qx = np.ma.masked_equal(qx, 1.0e30) + qy = np.ma.masked_equal(qy, 1.0e30) + qz = np.ma.masked_equal(qz, 1.0e30) + return qx, qy, qz + + +def check_output(idx, test): + fpth = os.path.join(test.workspace, f"ref.hds") + hds = flopy.utils.HeadFile(fpth) + heads = hds.get_data() + fpth = os.path.join(test.workspace, f"ref.cbc") + nlay, nrow, ncol = heads.shape + qx, qy, qz = qxqyqz(fpth, nlay, nrow, ncol) + + fpth = os.path.join(test.workspace, f"tl.hds") + hds = flopy.utils.HeadFile(fpth) + heads_tl = hds.get_data() + fpth = os.path.join(test.workspace, f"tl.cbc") + nlay, nrow, ncol = heads_tl.shape + qx_tl, qy_tl, qz_tl = qxqyqz(fpth, nlay, nrow, ncol) + + fpth = os.path.join(test.workspace, f"tr.hds") + hds = flopy.utils.HeadFile(fpth) + heads_tr = hds.get_data() + fpth = os.path.join(test.workspace, f"tr.cbc") + nlay, nrow, ncol = heads_tr.shape + qx_tr, qy_tr, qz_tr = qxqyqz(fpth, nlay, nrow, ncol) + + fpth = os.path.join(test.workspace, f"bl.hds") + hds = flopy.utils.HeadFile(fpth) + heads_bl = hds.get_data() + fpth = os.path.join(test.workspace, f"bl.cbc") + nlay, nrow, ncol = heads_bl.shape + qx_bl, qy_bl, qz_bl = qxqyqz(fpth, nlay, nrow, ncol) + + fpth = os.path.join(test.workspace, f"br.hds") + hds = flopy.utils.HeadFile(fpth) + heads_br = hds.get_data() + fpth = os.path.join(test.workspace, f"br.cbc") + nlay, nrow, ncol = heads_br.shape + qx_br, qy_br, qz_br = qxqyqz(fpth, nlay, nrow, ncol) + + heads_top = np.append(heads_tl[0], heads_tr[0], axis=1) + heads_bot = np.append(heads_bl[0], heads_br[0], axis=1) + heads_merged = np.append(heads_top, heads_bot, axis=0) + + # compare heads + maxdiff = np.amax(abs(heads - heads_merged)) + assert ( + maxdiff < 10 * hclose_check + ), "Max. head diff. {} should \ + be within solver tolerance (x10): {}".format( + maxdiff, 10 * hclose_check + ) + + # compare spdis-x + qx_top = np.append(qx_tl[0], qx_tr[0], axis=1) + qx_bot = np.append(qx_bl[0], qx_br[0], axis=1) + qx_merged = np.append(qx_top, qx_bot, axis=0) + + maxdiff = np.amax(abs(qx - qx_merged)) + assert ( + maxdiff < 10 * hclose_check + ), "Max. diff. in spec. discharge (x) {} \ + should be within solver tolerance (x10): {}".format( + maxdiff, 10 * hclose_check + ) + + # compare spdis-y + qy_top = np.append(qy_tl[0], qy_tr[0], axis=1) + qy_bot = np.append(qy_bl[0], qy_br[0], axis=1) + qy_merged = np.append(qy_top, qy_bot, axis=0) + + maxdiff = np.amax(abs(qy - qy_merged)) + assert ( + maxdiff < 10 * hclose_check + ), "Max. diff. in spec. discharge (y) {} \ + should be within solver tolerance (x10): {}".format( + maxdiff, 10 * hclose_check + ) + + # compare spdis-z + qz_top = np.append(qz_tl[0], qz_tr[0], axis=1) + qz_bot = np.append(qz_bl[0], qz_br[0], axis=1) + qz_merged = np.append(qz_top, qz_bot, axis=0) + + maxdiff = np.amax(abs(qz - qz_merged)) + assert ( + maxdiff < 10 * hclose_check + ), "Max. diff. in spec. discharge (z) {} \ + should be within solver tolerance (x10): {}".format( + maxdiff, 10 * hclose_check + ) + + # check budget error from .lst file + for mname in ["ref", "tl", "tr", "bl", "br"]: + fpth = os.path.join(test.workspace, f"{mname}.lst") + for line in open(fpth): + if line.lstrip().startswith("PERCENT"): + cumul_balance_error = float(line.split()[3]) + assert ( + abs(cumul_balance_error) < 0.00001 + ), "Cumulative balance error = {} for {}, should equal 0.0".format( + cumul_balance_error, mname + ) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_ims_rcm_reorder.py b/autotest/test_gwf_ims_rcm_reorder.py index b6b587e5b38..c5f39010094 100644 --- a/autotest/test_gwf_ims_rcm_reorder.py +++ b/autotest/test_gwf_ims_rcm_reorder.py @@ -3,11 +3,12 @@ import flopy import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "ims" -ex = ["ims_rcm"] +cases = ["ims_rcm"] +cmp_prefix = "mf6" # spatial discretization data nlay, nrow, ncol = 2, 5, 30 @@ -26,7 +27,7 @@ def build_model(idx, ws): tdis_rc = [(1.0, 1, 1.0)] # build MODFLOW 6 files - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -41,7 +42,7 @@ def build_model(idx, ws): perioddata=tdis_rc, ) - if not ws.endswith("mf6"): + if not str(ws).endswith(cmp_prefix): reordering_method = "rcm" else: reordering_method = None @@ -111,29 +112,24 @@ def build_model(idx, ws): return sim -def build_models(idx, base_ws): - sim = build_model(idx, base_ws) - - ws = os.path.join(base_ws, "mf6") - mc = build_model(idx, ws) - - return sim, mc - +def build_models(idx, test): + return build_model(idx, test.workspace), build_model( + idx, os.path.join(test.workspace, cmp_prefix) + ) -def eval_flows(sim): - name = sim.name - print("evaluating flow results..." f"({name})") - fpth = os.path.join(sim.simpath, f"{name}.dis.grb") +def check_output(idx, test): + name = test.name + fpth = os.path.join(test.workspace, f"{name}.dis.grb") ia = flopy.mf6.utils.MfGrdFile(fpth).ia - fpth = os.path.join(sim.simpath, f"{name}.cbc") + fpth = os.path.join(test.workspace, f"{name}.cbc") b0 = flopy.utils.CellBudgetFile(fpth, precision="double") - fpth = os.path.join(sim.simpath, "mf6", f"{name}.cbc") + fpth = os.path.join(test.workspace, cmp_prefix, f"{name}.cbc") b1 = flopy.utils.CellBudgetFile(fpth, precision="double") - fpth = os.path.join(sim.simpath, f"{name}.cbc.cmp.out") + fpth = os.path.join(test.workspace, f"{name}.cbc.cmp.out") eval_bud_diff(fpth, b0, b1, ia=ia) # close the budget files @@ -141,20 +137,13 @@ def eval_flows(sim): b1.close() -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_models, 0, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_flows, - idxsim=0, - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_lak_bedleak.py b/autotest/test_gwf_lak_bedleak.py new file mode 100644 index 00000000000..6a3a42d6830 --- /dev/null +++ b/autotest/test_gwf_lak_bedleak.py @@ -0,0 +1,179 @@ +import os + +import flopy +import numpy as np +import pytest + +from framework import DNODATA, TestFramework + +cases = ["bedleak", "bedleak_fail", "bedleak_none"] + + +def build_models(idx, test): + nlay, nrow, ncol = 1, 10, 10 + nper = 1 + perlen = [ + 1.0, + ] + nstp = [ + 1, + ] + tsmult = [ + 1.0, + ] + + lenx = 300.0 + delr = delc = lenx / float(nrow) + strt = 100.0 + + nouter, ninner = 100, 300 + hclose, rclose, relax = 1e-9, 1e-3, 0.97 + + tdis_rc = [] + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + + name = cases[idx] + + # build MODFLOW 6 files + ws = test.workspace + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws + ) + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=nper, + perioddata=tdis_rc, + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="DBD", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf(sim, modelname=name) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=90.0, + botm=0.0, + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, save_flows=True, icelltype=1, k=1.0, k33=0.01 + ) + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=True, + iconvert=1, + ss=0.0, + sy=0.1, + steady_state={0: True}, + ) + + # chd files + chdlist0 = [] + chdlist0.append([(0, 0, 0), 100.0]) + chdlist0.append([(0, nrow - 1, ncol - 1), 95.0]) + + chdspdict = {0: chdlist0} + chd = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdspdict, + save_flows=False, + ) + + # lak package + if "fail" in name: + bedleak = -100.0 + elif "none" in name: + bedleak = "none" + else: + bedleak = DNODATA + + # [] [] + packagedata = [ + [0, 100.0, 1, "lake1"], + [1, 100.0, 1, "lake2"], + ] + # + connectiondata = [ + [0, 0, (0, 1, 1), "vertical", bedleak, 0.0, 0.0, 0.0, 0.0], + [1, 0, (0, 2, 2), "vertical", bedleak, 0.0, 0.0, 0.0, 0.0], + ] + lak = flopy.mf6.ModflowGwflak( + gwf, + boundnames=True, + surfdep=1.0, + print_input=True, + print_stage=True, + print_flows=True, + save_flows=True, + budget_filerecord=f"{name}.lak.bud", + nlakes=len(packagedata), + packagedata=packagedata, + connectiondata=connectiondata, + ) + # lak.remove() + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + + return sim, None + + +def check_output(idx, test): + name = cases[idx] + + # lak budget + if "fail" not in name: + fpth = os.path.join(test.workspace, f"{name}.lak.bud") + bobj = flopy.utils.CellBudgetFile(fpth, precision="double") + bobj.list_unique_records() + records = bobj.get_data(text="GWF") + for r in records: + assert np.allclose(r["q"][0], -4.79616347e-12) + assert np.allclose(r["q"][1], -6.19237994e-12) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + xfail="fail" in str(function_tmpdir), + ) + test.run() diff --git a/autotest/test_gwf_lak_wetlakbedarea01.py b/autotest/test_gwf_lak_wetlakbedarea01.py index cba89465af3..5a0043a0cc0 100644 --- a/autotest/test_gwf_lak_wetlakbedarea01.py +++ b/autotest/test_gwf_lak_wetlakbedarea01.py @@ -1,19 +1,21 @@ -# A simple 2 layer by 1 row by 2 column model. Upper-right cell is the only -# active LAK cell. Lake starts out initially dry and then is wetted by a -# rising water table. A constant head boundary in the lower left corner cell -# is used to raise water table. This autotest checks to ensure that the wetted -# areas between the lake and the 2 connected cells (1 vertical, 1 horizontal) -# is correct. +""" +A simple 2 layer by 1 row by 2 column model. Upper-right cell is the only +active LAK cell. Lake starts out initially dry and then is wetted by a +rising water table. A constant head boundary in the lower left corner cell +is used to raise water table. This autotest checks to ensure that the wetted +areas between the lake and the 2 connected cells (1 vertical, 1 horizontal) +is correct. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["lak-1cellkbd"] +cases = ["lak-1cellkbd"] # Model units length_units = "feet" @@ -29,15 +31,15 @@ k33 = [1179.0, 1179.0] ss = 3e-4 sy = 0.2 -chd_lr = 9.0 +chd_lr = 9.0 lak_strt = 9.0 # Starting lake stage lak_bedleak = 10.0 # Lakebed leakance -idomain = np.full((nlay, nrow, ncol), 1) +idomain = np.full((nlay, nrow, ncol), 1) idomain[0, 0, 1] = 0 # deactivate upper-right corner of 2x1x2 model -top = 20. -botm = [10., 0.] +top = 20.0 +botm = [10.0, 0.0] # define delr and delc delr = 10.0 @@ -62,7 +64,18 @@ # Prepare constant head boundary data information chd_spd = {} -chd_inc = [9.999999, 10.0, 10.000001, 10.00001, 10.0001, 10.001, 10.01, 10.1, 10.11, 10.12] +chd_inc = [ + 9.999999, + 10.0, + 10.000001, + 10.00001, + 10.0001, + 10.001, + 10.01, + 10.1, + 10.11, + 10.12, +] for i, t in enumerate(range(len(perlen))): chd_spd.update({i: [nlay - 1, nrow - 1, 0, chd_inc[i]]}) @@ -85,7 +98,7 @@ [10.25, 0.0280716, 0.4, 0.4], [10.3, 0.068889924, 0.5, 0.5], [10.35, 0.1690610, 0.6, 0.6], - [10.4, 0.4148885490, 0.7, 0.7] + [10.4, 0.4148885490, 0.7, 0.7], ] # Set solver parameters @@ -95,12 +108,14 @@ rclose = 1e-6 relax = 0.97 + def resolve_lvl(stg, hd, toplay): ss = min(stg, toplay) hh = min(hd, toplay) thk = max(ss, hh) return thk + def calc_qSat(top, bot, thk): teps = 1e-6 tbmin = 0.0 @@ -135,13 +150,11 @@ def calc_qSat(top, bot, thk): return y -# -# MODFLOW 6 flopy GWF object -# -def build_model(idx, dir): + +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -159,7 +172,7 @@ def build_model(idx, dir): ats_filerecord=ats_filerecord, nper=nper, perioddata=tdis_rc, - time_units=time_units + time_units=time_units, ) if True: @@ -231,18 +244,34 @@ def build_model(idx, dir): # Instantiate constant head boundary package flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd) - + # Instantiate LAK package lak_conn = [] if use_embedded_lak: - lak_conn.append([0, 0, (0, 0, 1), 'embeddedv', lak_bedleak, 0.0, 0.0, 1.0, 0.0]) + lak_conn.append( + [0, 0, (0, 0, 1), "embeddedv", lak_bedleak, 0.0, 0.0, 1.0, 0.0] + ) else: - lak_conn.append([0, 0, (0, 0, 0), 'horizontal', lak_bedleak, 10.0, 20.0, 10.0, 10.0]) - lak_conn.append([0, 1, (1, 0, 1), 'vertical', lak_bedleak, 0.0, 0.0, 0.0, 0.0]) + lak_conn.append( + [ + 0, + 0, + (0, 0, 0), + "horizontal", + lak_bedleak, + 10.0, + 20.0, + 10.0, + 10.0, + ] + ) + lak_conn.append( + [0, 1, (1, 0, 1), "vertical", lak_bedleak, 0.0, 0.0, 0.0, 0.0] + ) lak_packagedata = [0, lak_strt, len(lak_conn)] budpth = f"{gwfname}.lak.cbc" - tab6_filename = '{}.laktab'.format(gwfname) + tab6_filename = "{}.laktab".format(gwfname) if use_embedded_lak: # LAK package input requires tables option when using embedded lakes. lak = flopy.mf6.ModflowGwflak( @@ -277,7 +306,7 @@ def build_model(idx, dir): budget_filerecord=budpth, time_conversion=86400, length_conversion=3.28081, - #surfdep=0.05, + # surfdep=0.05, pname="LAK-1", filename="{}.lak".format(gwfname), ) @@ -289,23 +318,22 @@ def build_model(idx, dir): ] } lak.obs.initialize( - filename=obs_file, - digits=10, - print_input=True, - continuous=obs_dict + filename=obs_file, digits=10, print_input=True, continuous=obs_dict ) if use_embedded_lak: tabinput = [] for itm in lak_tab: tabinput.append([itm[0], itm[1], itm[2], itm[3]]) - - laktab = flopy.mf6.ModflowUtllaktab(gwf, - nrow=len(tabinput), - ncol=len(tabinput[0]), - table=tabinput, - filename=tab6_filename, - pname='LAK_tab', - parent_file=lak) + + laktab = flopy.mf6.ModflowUtllaktab( + gwf, + nrow=len(tabinput), + ncol=len(tabinput[0]), + table=tabinput, + filename=tab6_filename, + pname="LAK_tab", + parent_file=lak, + ) # Instantiate output control package head_filerecord = "{}.hds".format(gwfname) @@ -315,38 +343,38 @@ def build_model(idx, dir): head_filerecord=head_filerecord, budget_filerecord=budget_filerecord, saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], - printrecord=[("HEAD", "ALL")] + printrecord=[("HEAD", "ALL")], ) return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name # read flow results from model - sim1 = flopy.mf6.MFSimulation.load(sim_ws=sim.simpath, load_only=["dis"]) + sim1 = flopy.mf6.MFSimulation.load( + sim_ws=test.workspace, load_only=["dis"] + ) gwf = sim1.get_model(gwfname) # get final lake stage - lk_pth0 = os.path.join(sim.simpath, f"{gwfname}.lak.obs.csv") + lk_pth0 = os.path.join(test.workspace, f"{gwfname}.lak.obs.csv") lkstg = np.genfromtxt(lk_pth0, names=True, delimiter=",") lkstg_time = lkstg["time"].tolist() lkstg_val = lkstg["STAGE"].tolist() # Store only the values at the end of the time step - idx = [i for i, val in enumerate(lkstg_time) if not val.is_integer()] - for i in idx[::-1]: + indices = [i for i, val in enumerate(lkstg_time) if not val.is_integer()] + for i in indices[::-1]: lkstg_time.pop(i) lkstg_val.pop(i) # Get heads fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hdobj = flopy.utils.binaryfile.HeadFile(fname, precision="double") @@ -354,7 +382,7 @@ def eval_results(sim): # Get lake/gwf exchange information fname = gwfname + ".lak.cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) lakobj = flopy.utils.binaryfile.CellBudgetFile(fname, precision="double") @@ -370,8 +398,10 @@ def eval_results(sim): wetted_out = np.array(wetted_out) # Compare MF6 output to answer calculated here - msg = 'Compare value written by MF6 to a value calculated here based on ' \ - 'either lake stage or gw head' + msg = ( + "Compare value written by MF6 to a value calculated here based on " + "either lake stage or gw head" + ) for tm in np.arange(wetted_out.shape[0]): for conn in np.arange(wetted_out.shape[1]): stg = lkstg_val[tm] @@ -410,17 +440,14 @@ def eval_results(sim): monotonicIncrease = np.diff(wetted_out[2:, 0]) assert np.all(monotonicIncrease > 0), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) + +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_lak_wetlakbedarea02.py b/autotest/test_gwf_lak_wetlakbedarea02.py index 91e83afc917..b72807e67df 100644 --- a/autotest/test_gwf_lak_wetlakbedarea02.py +++ b/autotest/test_gwf_lak_wetlakbedarea02.py @@ -1,17 +1,19 @@ -# An adaptation of the LAK package problem 1 supplemented with an additional -# layer that has variable thinkness to help test that the shared wetted area -# between a lakebed and groundwater cells in contact with the lake are written -# to the LAK cbc output file correctly. +""" +An adaptation of the LAK package problem 1 supplemented with an additional +layer that has variable thinkness to help test that the shared wetted area +between a lakebed and groundwater cells in contact with the lake are written +to the LAK cbc output file correctly. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["lak-wetlkbd"] +cases = ["lak-wetlkbd"] # Model units length_units = "feet" @@ -201,10 +203,10 @@ def calc_qSat(top, bot, thk): # -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -330,25 +332,25 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name # read flow results from model - sim1 = flopy.mf6.MFSimulation.load(sim_ws=sim.simpath, load_only=["dis"]) + sim1 = flopy.mf6.MFSimulation.load( + sim_ws=test.workspace, load_only=["dis"] + ) gwf = sim1.get_model(gwfname) # get final lake stage - lk_pth0 = os.path.join(sim.simpath, f"{gwfname}.lak.obs.csv") + lk_pth0 = os.path.join(test.workspace, f"{gwfname}.lak.obs.csv") lkstg = np.genfromtxt(lk_pth0, names=True, delimiter=",") lkstg_val = lkstg["STAGE"] # Get heads fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hdobj = flopy.utils.binaryfile.HeadFile(fname, precision="double") @@ -356,7 +358,7 @@ def eval_results(sim): # Get lake/gwf exchange information fname = gwfname + ".lak.cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) lakobj = flopy.utils.binaryfile.CellBudgetFile(fname, precision="double") @@ -373,7 +375,7 @@ def eval_results(sim): "The wetted interfacial areas saved in the binary output file " "(.cbc) do not match the values calculated in the autotest script" ) - for idx, itm in enumerate(lak_con): + for ii, itm in enumerate(lak_con): k, i, j = itm[2] ctype = itm[3] if ctype[0] == "h": @@ -393,20 +395,16 @@ def eval_results(sim): width = delc[i] warea = length * width - assert np.isclose(warea, checks_out[idx], atol=1e-5), msg + assert np.isclose(warea, checks_out[ii], atol=1e-5), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_laket.py b/autotest/test_gwf_laket.py index b180ff3baed..91f00bd8d48 100644 --- a/autotest/test_gwf_laket.py +++ b/autotest/test_gwf_laket.py @@ -1,17 +1,15 @@ -# Test for checking lak evaporation. +"""Test for checking lak evaporation.""" import os -import shutil -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "gwf_laket01", "gwf_laket02", "gwf_laket03", @@ -23,7 +21,7 @@ def get_model(idx, ws): - name = ex[idx] + name = cases[idx] nlay = 1 nrow = 1 ncol = 1 @@ -112,7 +110,7 @@ def get_model(idx, ws): ] nlakeconn = 1 - # pak_data = [lakeno, strt, nlakeconn] + # pak_data = [ifno, strt, nlakeconn] pak_data = [(0, lakestage[idx], nlakeconn)] belev = top @@ -175,18 +173,14 @@ def get_model(idx, ws): return sim -def build_model(idx, dir): - +def build_models(idx, test): # build MODFLOW 6 files - sim = get_model(idx, dir) - + sim = get_model(idx, test.workspace) return sim, None -def eval_laket(sim): - msg = "Evaluating Lake ET. " - - fpth = os.path.join(sim.simpath, f"{sim.name}.lak.obs.csv") +def check_output(idx, test): + fpth = os.path.join(test.workspace, f"{test.name}.lak.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -206,7 +200,7 @@ def eval_laket(sim): (8.000000000000, 5.2000000000000028, -0.1), (9.000000000000, 5.1000000000000032, -0.1), (10.00000000000, 5.0000000000000036, -0.1), - (11.00000000000, 5.0000000000000000, 0.0), + (11.00000000000, 5.0000000000000000, 0.0), (12.00000000000, 5.0999999999999996, -0.1), (13.00000000000, 5.1999999999999993, -0.1), (14.00000000000, 5.2999999999999989, -0.1), @@ -257,10 +251,10 @@ def eval_laket(sim): (5.000000000000, 5.1402629856607369, -0.1), (6.000000000000, 5.0345111305663464, -0.1), (7.000000000000, 5.0000000000000000, -0.0345111305663464), - (8.000000000000, 5.0000000000000000, 0.0), - (9.000000000000, 5.0000000000000000, 0.0), - (10.00000000000, 5.0000000000000000, 0.0), - (11.00000000000, 5.0000000000000000, 0.0), + (8.000000000000, 5.0000000000000000, 0.0), + (9.000000000000, 5.0000000000000000, 0.0), + (10.00000000000, 5.0000000000000000, 0.0), + (11.00000000000, 5.0000000000000000, 0.0), (12.00000000000, 5.0857142857142854, -0.1), (13.00000000000, 5.1591836734693874, -0.1), (14.00000000000, 5.2221574344023320, -0.1), @@ -277,41 +271,34 @@ def eval_laket(sim): ), } - if sim.idxsim in ( + if idx in ( 0, 1, 2, ): - evap_compare = np.allclose(obs[sim.idxsim]["evap"], tc["EVAP"]) - stage_compare = np.allclose(obs[sim.idxsim]["stage"], tc["LAKESTAGE"]) + evap_compare = np.allclose(obs[idx]["evap"], tc["EVAP"]) + stage_compare = np.allclose(obs[idx]["stage"], tc["LAKESTAGE"]) else: evap_compare = True stage_compare = True - sim.success = True + test.success = True if not evap_compare: - sim.success = False + test.success = False msg += f" Lake evaporation comparison failed." if not stage_compare: - sim.success = False + test.success = False msg += f" Lake stage comparison failed." - assert sim.success, msg + assert test.success, msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_laket, - idxsim=idx, - mf6_regression=False, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_lakobs01.py b/autotest/test_gwf_lakobs01.py index 8cfc8ff2de9..cff4ab1881d 100644 --- a/autotest/test_gwf_lakobs01.py +++ b/autotest/test_gwf_lakobs01.py @@ -1,21 +1,19 @@ -# Test for checking lak observation input. The following observation types: -# 'lak', 'wetted-area', and 'conductance,' require that ID2 be provided when -# ID is an integer corresponding to a lake number and not BOUNDNAME. -# See table in LAK Package section of mf6io.pdf for an explanation of ID, -# ID2, and Observation Type. +""" +Test for checking lak observation input. The following observation types: +'lak', 'wetted-area', and 'conductance,' require that ID2 be provided when +ID is an integer corresponding to a lake number and not BOUNDNAME. +See table in LAK Package section of mf6io.pdf for an explanation of ID, +ID2, and Observation Type. +""" import os -import shutil -import sys import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = "gwf_lakobs_01a" +cases = "gwf_lakobs_01a" gwf = None @@ -54,7 +52,7 @@ def build_model(dir, exe): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex + name = cases # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( @@ -138,7 +136,7 @@ def build_model(dir, exe): irch[i, j] = k + 1 nlakeconn = len(lake_vconnect) - # pak_data = [lakeno, strt, nlakeconn] + # pak_data = [ifno, strt, nlakeconn] initial_stage = 0.1 pak_data = [(0, initial_stage, nlakeconn)] @@ -206,13 +204,8 @@ def build_model(dir, exe): def test_mf6model(function_tmpdir, targets): - mf6 = targets["mf6"] - - # initialize testing framework - test = TestFramework() - # build the models - sim = build_model(str(function_tmpdir), mf6) + sim = build_model(str(function_tmpdir), targets["mf6"]) # write model input sim.write_simulation() @@ -235,8 +228,8 @@ def test_mf6model(function_tmpdir, targets): ) # fix the error and attempt to rerun model - orig_fl = str(function_tmpdir / (ex + ".lak.obs")) - new_fl = str(function_tmpdir / (ex + ".lak.obs.new")) + orig_fl = str(function_tmpdir / (cases + ".lak.obs")) + new_fl = str(function_tmpdir / (cases + ".lak.obs.new")) sr = open(orig_fl, "r") sw = open(new_fl, "w") diff --git a/autotest/test_gwf_libmf6_evt01.py b/autotest/test_gwf_libmf6_evt01.py index b962f653f30..067e7ac7ae4 100644 --- a/autotest/test_gwf_libmf6_evt01.py +++ b/autotest/test_gwf_libmf6_evt01.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest -Test the bmi which is used update the calculate a head-based pumping rate that -is equivalent to use of the evapotranspiration package in the -non-bmi simulation. +Test bmi with a head-based pumping rate equivalent to +the evapotranspiration package in a non-bmi simulation. """ import os @@ -10,11 +8,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_evt01"] +from framework import TestFramework + +cases = ["libgwf_evt01"] # et variables et_max = 0.1 @@ -128,14 +126,14 @@ def get_model(ws, name, bmi=False): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") mc = get_model(ws, name, bmi=True) return sim, mc @@ -153,7 +151,7 @@ def head2et_wellrate(h): def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." output_file_path = os.path.join(model_ws, "mfsim.stdout") @@ -184,7 +182,7 @@ def api_func(exe, idx, model_ws=None): max_iter = mf6.get_value(mxit_tag) # get copy of well data - well_tag = mf6.get_var_address("BOUND", name, "WEL_0") + well_tag = mf6.get_var_address("Q", name, "WEL_0") well = mf6.get_value(well_tag) # check NPF type @@ -202,7 +200,6 @@ def api_func(exe, idx, model_ws=None): # model time loop idx = 0 while current_time < end_time: - # get dt and prepare for non-linear iterations dt = mf6.get_time_step() mf6.prepare_time_step(dt) @@ -212,10 +209,9 @@ def api_func(exe, idx, model_ws=None): mf6.prepare_solve() while kiter < max_iter: - # update well rate twell[:] = head2et_wellrate(head[0]) - well[:, 0] = twell[:] + well[:] = twell[:] mf6.set_value(well_tag, well) # solve with updated well rate @@ -254,16 +250,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_ghb01.py b/autotest/test_gwf_libmf6_ghb01.py index 43e7ce239f5..4809b430c45 100644 --- a/autotest/test_gwf_libmf6_ghb01.py +++ b/autotest/test_gwf_libmf6_ghb01.py @@ -1,21 +1,19 @@ """ -MODFLOW 6 Autotest -Test the api which is used update to set the simulate the effect of a general -head boundary (ghb) at the downgradient end of the model with a head below the -bottom of the cell. The api results are compared to a non-api simulation that -uses the well package to simulate the effect of the same ghb. This is a -possible solution to https://github.com/MODFLOW-USGS/modflow6/issues/724 +Simulate the effect of a general head boundary (ghb) at the downgradient end +of the model with a head below the bottom of the cell. Compare api result to +a non-api simulation using the well package to simulate an equivalent ghb. +Possible solution to https://github.com/MODFLOW-USGS/modflow6/issues/724 """ import os import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_ghb01"] +from framework import TestFramework + +cases = ["libgwf_ghb01"] # temporal discretization nper = 10 @@ -162,15 +160,14 @@ def get_model(ws, name, api=False): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] - + ws = test.workspace + name = cases[idx] sim = get_model(ws, name) # build comparison model with zeroed values - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") mc = get_model(ws, name, api=True) return sim, mc @@ -183,7 +180,7 @@ def api_ghb_pak(hcof, rhs): def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." output_file_path = os.path.join(model_ws, "mfsim.stdout") @@ -228,7 +225,6 @@ def api_func(exe, idx, model_ws=None): # model time loop while current_time < end_time: - # get dt dt = mf6.get_time_step() @@ -277,16 +273,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_ifmod01.py b/autotest/test_gwf_libmf6_ifmod01.py index 51577ed622f..6ffe87935c3 100644 --- a/autotest/test_gwf_libmf6_ifmod01.py +++ b/autotest/test_gwf_libmf6_ifmod01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the interface model approach for coupling two gwf models. We need the API for this, as the interface model is hidden and not present in any of the output. The setup is two coupled @@ -16,19 +15,16 @@ import flopy import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_ifmod01"] +from framework import TestFramework -# global convenience... +cases = ["libgwf_ifmod01"] name_left = "leftmodel" name_right = "rightmodel" def get_model(dir, name): - useXT3D = True # parameters and spd @@ -197,14 +193,14 @@ def get_model(dir, name): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") sim_compare = get_model(ws, name) return sim, sim_compare @@ -307,17 +303,13 @@ def check_interface_models(mf6): ), "AREA in interface model does not match" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_ifmod02.py b/autotest/test_gwf_libmf6_ifmod02.py index 5faa7d76512..b9f6462ddd3 100644 --- a/autotest/test_gwf_libmf6_ifmod02.py +++ b/autotest/test_gwf_libmf6_ifmod02.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the interface model approach for an inhomogeneous coupling of three gwf models using the API. One exchange will have XT3D enabled (Exg1) and the other one (Exg2) doesn't. And the top-left @@ -41,11 +40,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_ifmod02"] +from framework import TestFramework + +cases = ["libgwf_ifmod02"] # global convenience... name_tl = "topleft" @@ -54,7 +53,6 @@ def get_model(dir, name): - # parameters and spd # tdis nper = 1 @@ -291,14 +289,14 @@ def get_model(dir, name): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") sim_compare = get_model(ws, name) return sim, sim_compare @@ -403,17 +401,14 @@ def check_interface_models(mf6): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_ifmod03.py b/autotest/test_gwf_libmf6_ifmod03.py index c238d269110..f5d24a342db 100644 --- a/autotest/test_gwf_libmf6_ifmod03.py +++ b/autotest/test_gwf_libmf6_ifmod03.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the interface model approach for coupling two DIS models where one is translated and rotated in space: @@ -31,11 +30,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_ifmod03"] +from framework import TestFramework + +cases = ["libgwf_ifmod03"] # global convenience... name_left = "left" @@ -44,12 +43,11 @@ def get_model(dir, name): - # parameters and spd # tdis nper = 1 tdis_rc = [] - for i in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1)) # solver data @@ -208,14 +206,14 @@ def get_model(dir, name): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") sim_compare = get_model(ws, name) return sim, sim_compare @@ -289,16 +287,13 @@ def check_interface_models(mf6): assert abs(ymax - ymin) < 1e-6 -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_rch01.py b/autotest/test_gwf_libmf6_rch01.py index bb8252e8cff..b7ef4c50e6c 100644 --- a/autotest/test_gwf_libmf6_rch01.py +++ b/autotest/test_gwf_libmf6_rch01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to make sure that recharge is passed to the highest active layer and verify that recharge is in the highest active layer by looking at the individual budget terms. For this test, there are two layers and five @@ -13,11 +12,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_rch01"] +from framework import TestFramework + +cases = ["libgwf_rch01"] # recharge package name rch_pname = "RCH-1" @@ -135,21 +134,21 @@ def get_model(ws, name, rech): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name, rech=rch_spd) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") mc = get_model(ws, name, rech=0.0) return sim, mc def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." @@ -177,13 +176,12 @@ def api_func(exe, idx, model_ws=None): max_iter = mf6.get_value(mxit_tag) # get copy of recharge array - rch_tag = mf6.get_var_address("BOUND", name, rch_pname) + rch_tag = mf6.get_var_address("RECHARGE", name, rch_pname) new_recharge = mf6.get_value(rch_tag) # model time loop idx = 0 while current_time < end_time: - # get dt and prepare for non-linear iterations dt = mf6.get_time_step() mf6.prepare_time_step(dt) @@ -193,7 +191,7 @@ def api_func(exe, idx, model_ws=None): mf6.prepare_solve() # update recharge - new_recharge[:, 0] = rch_spd[idx] * area + new_recharge[:] = rch_spd[idx] mf6.set_value(rch_tag, new_recharge) while kiter < max_iter: @@ -232,16 +230,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_rch02.py b/autotest/test_gwf_libmf6_rch02.py index 1e7a5797a3e..fc1b4c6fdf9 100644 --- a/autotest/test_gwf_libmf6_rch02.py +++ b/autotest/test_gwf_libmf6_rch02.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the bmi which is used to calculate a recharge rate that results in a simulated head in the center of the model domain to be equal to the simulated head in the non-bmi simulation. @@ -10,11 +9,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_rch02"] +from framework import TestFramework + +cases = ["libgwf_rch02"] # recharge package name rch_pname = "RCH-1" @@ -153,26 +152,25 @@ def get_model(ws, name, exe, rech=rch_spd): return sim -def build_model(idx, dir, exe): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] - sim = get_model(ws, name, exe) + ws = test.workspace + name = cases[idx] + sim = get_model(ws, name, "mf6") # build comparison model - ws = os.path.join(dir, "libmf6") - mc = get_model(ws, name, exe, rech=0.0) + ws = os.path.join(test.workspace, "libmf6") + mc = get_model(ws, name, "mf6", rech=0.0) return sim, mc def run_perturbation(mf6, max_iter, recharge, tag, rch): - mf6.prepare_solve() kiter = 0 while kiter < max_iter: # update recharge - recharge[:, 0] = rch * area + recharge[:] = rch mf6.set_value(tag, recharge) # solve with updated well rate has_converged = mf6.solve() @@ -185,7 +183,7 @@ def run_perturbation(mf6, max_iter, recharge, tag, rch): def api_func(exe, idx, model_ws=None): print("\nBMI implementation test:") - name = ex[idx].upper() + name = cases[idx].upper() init_wd = os.path.abspath(os.getcwd()) if model_ws is not None: os.chdir(model_ws) @@ -193,7 +191,7 @@ def api_func(exe, idx, model_ws=None): output_file_path = os.path.join(model_ws, "mfsim.stdout") # get the observations from the standard run - fpth = os.path.join("..", f"{ex[idx]}.head.obs.csv") + fpth = os.path.join("..", f"{cases[idx]}.head.obs.csv") hobs = np.genfromtxt(fpth, delimiter=",", names=True)["H1_6_6"] try: @@ -222,7 +220,7 @@ def api_func(exe, idx, model_ws=None): max_iter = mf6.get_value(mxit_tag) # get copy of recharge array - rch_tag = mf6.get_var_address("BOUND", name, rch_pname) + rch_tag = mf6.get_var_address("RECHARGE", name, rch_pname) new_recharge = mf6.get_value(rch_tag).copy() # determine initial recharge value @@ -232,7 +230,6 @@ def api_func(exe, idx, model_ws=None): # model time loop idx = 0 while current_time < end_time: - # target head htarget = hobs[idx] @@ -308,20 +305,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build( - lambda i, d: build_model(i, d, targets["mf6"]), - idx, - str(function_tmpdir), - ) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_riv01.py b/autotest/test_gwf_libmf6_riv01.py index 0fc8dd7e598..ef42e2e29d7 100644 --- a/autotest/test_gwf_libmf6_riv01.py +++ b/autotest/test_gwf_libmf6_riv01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the bmi which is used update to set the river stages to the same values as they are in the non-bmi simulation. """ @@ -8,11 +7,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_riv01"] +from framework import TestFramework + +cases = ["libgwf_riv01"] # temporal discretization nper = 10 @@ -129,10 +128,10 @@ def get_model(ws, name, riv_spd): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] # create river data rd = [ @@ -146,7 +145,7 @@ def build_model(idx, dir): sim = get_model(ws, name, riv_spd={0: rd, 5: rd2}) # build comparison model with zeroed values - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") rd_bmi = [[(0, 0, icol), 999.0, 999.0, 0.0] for icol in range(1, ncol - 1)] mc = get_model(ws, name, riv_spd={0: rd_bmi}) @@ -154,7 +153,7 @@ def build_model(idx, dir): def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." @@ -178,13 +177,16 @@ def api_func(exe, idx, model_ws=None): end_time = mf6.get_end_time() # get copy of (multi-dim) array with river parameters - riv_tag = mf6.get_var_address("BOUND", name, riv_packname) - new_spd = mf6.get_value(riv_tag) + stage_tag = mf6.get_var_address("STAGE", name, riv_packname) + cond_tag = mf6.get_var_address("COND", name, riv_packname) + rbot_tag = mf6.get_var_address("RBOT", name, riv_packname) + new_stage = mf6.get_value(stage_tag) + new_cond = mf6.get_value(cond_tag) + new_rbot = mf6.get_value(rbot_tag) # model time loop idx = 0 while current_time < end_time: - # get dt dt = mf6.get_time_step() @@ -192,16 +194,18 @@ def api_func(exe, idx, model_ws=None): mf6.prepare_time_step(dt) # set the RIV data through the BMI + # change cond and rbot data + new_cond[:] = [riv_cond] + new_rbot[:] = [riv_bot] + mf6.set_value(cond_tag, new_cond) + mf6.set_value(rbot_tag, new_rbot) + # change stage data if current_time < 5: - # set columns of BOUND data (we're setting entire columns of the - # 2D array for convenience, setting only the value for the active - # stress period should work too) - new_spd[:] = [riv_stage, riv_cond, riv_bot] - mf6.set_value(riv_tag, new_spd) + new_stage[:] = [riv_stage] + mf6.set_value(stage_tag, new_stage) else: - # change only stage data - new_spd[:] = [riv_stage2, riv_cond, riv_bot] - mf6.set_value(riv_tag, new_spd) + new_stage[:] = [riv_stage2] + mf6.set_value(stage_tag, new_stage) kiter = 0 mf6.prepare_solve() @@ -242,16 +246,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_riv02.py b/autotest/test_gwf_libmf6_riv02.py index eb3337c0561..2f94f7717e5 100644 --- a/autotest/test_gwf_libmf6_riv02.py +++ b/autotest/test_gwf_libmf6_riv02.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the api which is used set hcof and rhs in api package compare to river package in the non-api simulation. """ @@ -8,11 +7,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_riv02"] +from framework import TestFramework + +cases = ["libgwf_riv02"] # temporal discretization nper = 10 @@ -132,10 +131,10 @@ def get_model(ws, name, riv_spd, api=False): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] # create river data rd = [ @@ -149,7 +148,7 @@ def build_model(idx, dir): sim = get_model(ws, name, riv_spd={0: rd, 5: rd2}) # build comparison model with zeroed values - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") rd_api = [[(0, 0, icol), 999.0, 999.0, 0.0] for icol in range(1, ncol - 1)] mc = get_model(ws, name, riv_spd={0: rd_api}, api=True) @@ -168,7 +167,7 @@ def api_riv_pak(stage, h, hcof, rhs): def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." @@ -216,7 +215,6 @@ def api_func(exe, idx, model_ws=None): # model time loop idx = 0 while current_time < end_time: - # get dt dt = mf6.get_time_step() @@ -273,16 +271,13 @@ def api_func(exe, idx, model_ws=None): return True, open(output_file_path).readlines() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_libmf6_sto01.py b/autotest/test_gwf_libmf6_sto01.py index 4cbe8caeb68..24283ffa3ee 100644 --- a/autotest/test_gwf_libmf6_sto01.py +++ b/autotest/test_gwf_libmf6_sto01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the bmi set_value function, which is used update the Sy=0 value with same Sy used to calculate SC2 in the non-bmi simulation. @@ -10,11 +9,11 @@ import flopy import numpy as np import pytest -from framework import TestFramework from modflowapi import ModflowApi -from simulation import TestSimulation -ex = ["libgwf_sto01"] +from framework import TestFramework + +cases = ["libgwf_sto01"] # average recharge rate avg_rch = 0.001 @@ -138,21 +137,21 @@ def get_model(ws, name, sy): return sim -def build_model(idx, dir): +def build_models(idx, test): # build MODFLOW 6 files - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] sim = get_model(ws, name, sy=sy_val) # build comparison model - ws = os.path.join(dir, "libmf6") + ws = os.path.join(test.workspace, "libmf6") mc = get_model(ws, name, sy=0.0) return sim, mc def api_func(exe, idx, model_ws=None): - name = ex[idx].upper() + name = cases[idx].upper() if model_ws is None: model_ws = "." @@ -185,7 +184,6 @@ def api_func(exe, idx, model_ws=None): # model time loop idx = 0 while current_time < end_time: - # run the time step try: mf6.update() @@ -209,16 +207,13 @@ def api_func(exe, idx, model_ws=None): @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, idxsim=idx, api_func=api_func - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + api_func=lambda exe, ws: api_func(exe, idx, ws), ) + test.run() diff --git a/autotest/test_gwf_maw01.py b/autotest/test_gwf_maw01.py new file mode 100644 index 00000000000..d94a41d37bf --- /dev/null +++ b/autotest/test_gwf_maw01.py @@ -0,0 +1,189 @@ +import os +from types import SimpleNamespace + +import flopy +import numpy as np +import pytest + +cases = ["maw01", "maw01nwt", "maw01nwtur"] +budtol = 1e-2 +bud_lst = ["GWF_IN", "GWF_OUT", "RATE_IN", "RATE_OUT"] +krylov = ["CG", "BICGSTAB", "BICGSTAB"] +newton = [None, "NEWTON", "NEWTON UNDER_RELAXATION"] +nlay = 1 +nrow = 1 +ncol = 3 +nper = 3 +delr = 300 +delc = 300 +perlen = 3 * [1] +nstp = 3 * [1] +tsmult = 3 * [1] +well = SimpleNamespace( + observations={"maw_obs.csv": [("mh1", "head", 1)]}, + packagedata=[[0, 0.1, 50.0, 100.0, "THIEM", 1]], + connectiondata=[[0, 0, (0, 0, 1), 100.0, 50.0, 1.0, 0.1]], + perioddata=[[0, "rate", 0.0]], +) +strt = 100 +hk = 1 +nouter = 100 +ninner = 300 +hclose = 1e-9 +rclose = 1e-3 +relaxation_factor = 1 +compare = False + + +def build_model(idx, ws, mf6): + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name=mf6, + sim_ws=ws, + ) + + # create tdis package + tdis_rc = [(perlen[i], nstp[i], tsmult[i]) for i in range(nper)] + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create gwf model + gwf = flopy.mf6.MFModel( + sim, + model_type="gwf6", + modelname=name, + model_nam_file=f"{name}.nam", + ) + gwf.name_file.newtonoptions = newton[idx] + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration=krylov[idx], + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relaxation_factor, + ) + sim.register_ims_package(ims, [gwf.name]) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=100.0, + botm=0.0, + idomain=1, + filename=f"{name}.dis", + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{name}.ic") + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=True, + icelltype=1, + k=hk, + k33=hk, + filename=f"{name}.npf", + ) + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=True, + iconvert=1, + ss=0.0, + sy=0.1, + steady_state={0: True}, + # transient={1: False}, + filename=f"{name}.sto", + ) + + # chd files + chdlist0 = [] + chdlist0.append([(0, 0, 0), 100.0]) + chdlist0.append([(0, 0, 2), 100.0]) + + chdlist1 = [] + chdlist1.append([(0, 0, 0), 25.0]) + chdlist1.append([(0, 0, 2), 25.0]) + + chdspdict = {0: chdlist0, 1: chdlist1, 2: chdlist0} + chd = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdspdict, + save_flows=False, + filename=f"{name}.chd", + ) + + # wel files + # wel = flopy.mf6.ModflowGwfwel(gwf, print_input=True, print_flows=True, + # maxbound=len(ws), + # periodrecarray=wd6, + # save_flows=False) + # MAW + maw = flopy.mf6.ModflowGwfmaw( + gwf, + filename=f"{name}.maw", + print_input=True, + print_head=True, + print_flows=True, + save_flows=True, + observations=well.observations, + packagedata=well.packagedata, + connectiondata=well.connectiondata, + perioddata=well.perioddata, + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename=f"{name}.oc", + ) + + return sim, None + + +def check_output(workspace): + # MODFLOW 6 maw results + fpth = os.path.join(workspace, "maw_obs.csv") + tc = np.genfromtxt(fpth, names=True, delimiter=",") + + # create known results array + tc0 = np.array([100.0, 25.0, 100.0]) + + # calculate maximum absolute error + diff = tc["MH1"] - tc0 + diffmax = np.abs(diff).max() + dtol = 1e-9 + msg = f"maximum absolute maw head difference {diffmax}" + assert diffmax < dtol, msg + f" exceeds tolerance {dtol}" + print(msg) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + ws = str(function_tmpdir) + sim, _ = build_model(idx, ws, targets["mf6"]) + sim.write_simulation() + sim.run_simulation() + check_output(ws) diff --git a/autotest/test_gwf_maw02.py b/autotest/test_gwf_maw02.py new file mode 100644 index 00000000000..bd9f42704f3 --- /dev/null +++ b/autotest/test_gwf_maw02.py @@ -0,0 +1,289 @@ +import os +from types import SimpleNamespace + +import flopy +import numpy as np +import pytest + +cases = ["maw02"] +budtol = 1e-2 +bud_lst = ["GWF_IN", "GWF_OUT", "RATE_IN", "RATE_OUT"] +krylov = "CG" +nlay = 1 +nrow = 1 +ncol = 3 +nper = 5 +delr = 300 +delc = 300 +perlen = 5 * [1] +nstp = 5 * [1] +tsmult = 5 * [1] +well = SimpleNamespace( + observations={"maw_obs.csv": [("mh1", "head", 1)]}, + packagedata=[ + [0, 0.1, 0.0, 100.0, "THIEM", 1], + [1, 0.1, 0.0, 100.0, "THIEM", 1], + ], + connectiondata=[ + [0, 0, (0, 0, 1), 100.0, 0.0, 1.0, 0.1], + [1, 0, (0, 0, 1), 100.0, 0.0, 1.0, 0.1], + ], + perioddata={ + 0: [ + [0, "rate", -20.0], + [0, "status", "inactive"], + [0, "rate_scaling", 1.0, 15.0], + [1, "rate", -30.0], + [1, "status", "inactive"], + [1, "rate_scaling", 5.0, 15.0], + ], + 1: [ + [0, "rate", -110.0], + [0, "status", "active"], + [1, "rate", -130.0], + [1, "status", "active"], + ], + 3: [[0, "status", "inactive"]], + 4: [[0, "status", "active"]], + }, +) +strt = 100 +hk = 1 +nouter = 100 +ninner = 300 +hclose = 1e-9 +rclose = 1e-3 +relaxation_factor = 1 +compare = False + + +def build_model(idx, ws, mf6): + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=mf6, sim_ws=ws + ) + + # create tdis package + tdis_rc = [(perlen[i], nstp[i], tsmult[i]) for i in range(nper)] + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create gwf model + gwf = flopy.mf6.MFModel( + sim, + model_type="gwf6", + modelname=name, + model_nam_file=f"{name}.nam", + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration=krylov, + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relaxation_factor, + ) + sim.register_ims_package(ims, [gwf.name]) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=100.0, + botm=0.0, + idomain=1, + filename=f"{name}.dis", + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{name}.ic") + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=True, + icelltype=1, + k=hk, + k33=hk, + filename=f"{name}.npf", + ) + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=True, + iconvert=1, + ss=0.0, + sy=0.1, + steady_state={0: True}, + # transient={1: False}, + filename=f"{name}.sto", + ) + + # chd files + chdlist0 = [] + chdlist0.append([(0, 0, 0), 100.0]) + chdlist0.append([(0, 0, 2), 100.0]) + + chdlist1 = [] + chdlist1.append([(0, 0, 0), 25.0]) + chdlist1.append([(0, 0, 2), 25.0]) + + chdspdict = {0: chdlist0, 1: chdlist1, 2: chdlist0} + chd = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdspdict, + save_flows=False, + filename=f"{name}.chd", + ) + + # MAW + maw = flopy.mf6.ModflowGwfmaw( + gwf, + filename=f"{name}.maw", + budget_filerecord=f"{name}.maw.cbc", + print_input=True, + print_head=True, + print_flows=True, + save_flows=True, + observations=well.observations, + packagedata=well.packagedata, + connectiondata=well.connectiondata, + perioddata=well.perioddata, + pname="MAW-1", + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename=f"{name}.oc", + ) + + return sim, None + + +def eval_results(name, workspace): + shape3d = (nlay, nrow, ncol) + size3d = nlay * nrow * ncol + + # get results from listing file + fpth = os.path.join(workspace, f"{os.path.basename(name)}.lst") + budl = flopy.utils.Mf6ListBudget( + fpth, budgetkey="MAW-1 BUDGET FOR ENTIRE MODEL AT END OF TIME STEP" + ) + names = list(bud_lst) + d0 = budl.get_budget(names=names)[0] + dtype = d0.dtype + nbud = d0.shape[0] + + # get results from cbc file + cbc_bud = ["GWF", "RATE"] + d = np.recarray(nbud, dtype=dtype) + for key in bud_lst: + d[key] = 0.0 + fpth = os.path.join(workspace, f"{os.path.basename(name)}.maw.cbc") + cobj = flopy.utils.CellBudgetFile(fpth, precision="double") + kk = cobj.get_kstpkper() + times = cobj.get_times() + cbc_vals = [] + for idx, (k, t) in enumerate(zip(kk, times)): + for text in cbc_bud: + qin = 0.0 + qout = 0.0 + v = cobj.get_data(kstpkper=k, text=text)[0] + if isinstance(v, np.recarray): + vt = np.zeros(size3d, dtype=float) + wq = [] + for jdx, node in enumerate(v["node"]): + vt[node - 1] += v["q"][jdx] + wq.append(v["q"][jdx]) + v = vt.reshape(shape3d) + if text == cbc_bud[-1]: + cbc_vals.append(wq) + for kk in range(v.shape[0]): + for ii in range(v.shape[1]): + for jj in range(v.shape[2]): + vv = v[kk, ii, jj] + if vv < 0.0: + qout -= vv + else: + qin += vv + d["totim"][idx] = t + d["time_step"][idx] = k[0] + d["stress_period"] = k[1] + key = f"{text}_IN" + d[key][idx] = qin + key = f"{text}_OUT" + d[key][idx] = qout + + maw_vals = [ + [0.000, 0.000], + [-106.11303563809453, -96.22598985147631], + [-110.000, -130.000], + [0.0, -130.000], + [-110.000, -130.000], + ] + + # evaluate if well rates in cbc file are equal to expected values + diffv = [] + for ovs, svs in zip(maw_vals, cbc_vals): + for ov, sv in zip(ovs, svs): + diffv.append(ov - sv) + diffv = np.abs(np.array(diffv)).max() + msg = f"\nmaximum absolute maw rate difference ({diffv})\n" + + # calculate difference between water budget items in the lst and cbc files + diff = np.zeros((nbud, len(bud_lst)), dtype=float) + for idx, key in enumerate(bud_lst): + diff[:, idx] = d0[key] - d[key] + diffmax = np.abs(diff).max() + msg += f"maximum absolute total-budget difference ({diffmax}) " + + # write summary + fpth = os.path.join(workspace, f"{os.path.basename(name)}.bud.cmp.out") + f = open(fpth, "w") + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for idx, key in enumerate(bud_lst): + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for idx, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, idx]:25g}" + f.write(line + "\n") + f.close() + + assert diffmax < budtol, ( + msg + f"diffmax {diffmax} exceeds tolerance {budtol}" + ) + assert diffv < budtol, msg + f"diffv {diffv} exceeds tolerance {budtol}" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + ws = str(function_tmpdir) + sim, _ = build_model(idx, ws, targets["mf6"]) + sim.write_simulation() + sim.run_simulation() + eval_results(name, ws) diff --git a/autotest/test_gwf_maw03.py b/autotest/test_gwf_maw03.py new file mode 100644 index 00000000000..3f37660960e --- /dev/null +++ b/autotest/test_gwf_maw03.py @@ -0,0 +1,214 @@ +import os +from types import SimpleNamespace + +import flopy +import numpy as np +import pytest + +cases = ["maw03a", "maw03b", "maw03c"] +budtol = 1e-2 +bud_lst = ["GWF_IN", "GWF_OUT", "RATE_IN", "RATE_OUT"] + + +def well3(name): + perioddata = { + "maw03a": [ + (0, "rate", 2000.0), + ], + "maw03b": [(0, "rate", 2000.0), (0, "head_limit", 0.4)], + "maw03c": [(0, "rate", 2000.0), (0, "rate_scaling", 0.0, 1.0)], + } + wellbottom = -1000 + return SimpleNamespace( + observations={ + f"{name}.maw.obs.csv": [ + ("m1head", "head", (0,)), + ("m1rate", "rate", (0,)), + ] # is this index one-based? Not if in a tuple + }, + packagedata=[[0, 0.15, wellbottom, 0.0, "THIEM", 1]], + connectiondata=[[0, 0, (0, 50, 50), 0.0, wellbottom, 0.0, 0.0]], + perioddata=perioddata[name], + ) + + +krylov = "CG" +nlay = 1 +nrow = 101 +ncol = 101 +nper = 1 +delr = 142 +delc = 142 +perlen = [1000] +nstp = [50] +tsmult = [1.2] +strt = 0 +hk = 10 +nouter = 100 +ninner = 100 +hclose = 1e-6 +rclose = 1e-6 +relaxation_factor = 1 +compare = False + + +def build_model(idx, ws, mf6): + top = 0.0 + botm = [-1000.0] + + tdis_rc = [] + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + + name = cases[idx] + sim = flopy.mf6.MFSimulation(sim_name=name, sim_ws=ws, exe_name=mf6) + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create gwf model + gwf = flopy.mf6.MFModel( + sim, + model_type="gwf6", + modelname=name, + model_nam_file=f"{name}.nam", + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration=krylov, + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relaxation_factor, + ) + sim.register_ims_package(ims, [gwf.name]) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=1, + filename=f"{name}.dis", + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{name}.ic") + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=True, + icelltype=1, + k=hk, + k33=hk, + filename=f"{name}.npf", + ) + + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=True, + iconvert=0, + ss=1.0e-5, + sy=0.1, + steady_state={0: False}, + transient={0: True}, + filename=f"{name}.sto", + ) + + # MAW + well = well3(name) + maw = flopy.mf6.ModflowGwfmaw( + gwf, + filename=f"{name}.maw", + print_input=True, + print_head=True, + print_flows=True, + save_flows=True, + observations=well.observations, + packagedata=well.packagedata, + connectiondata=well.connectiondata, + perioddata=well.perioddata, + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + headprintrecord=[ + ("COLUMNS", ncol, "WIDTH", 15, "DIGITS", 6, "GENERAL") + ], + saverecord=[("HEAD", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename=f"{name}.oc", + ) + + # head observations + obs_data0 = [("head_well_cell", "HEAD", (0, 0, 0))] + obs_recarray = {f"{name}.obs.csv": obs_data0} + obs = flopy.mf6.ModflowUtlobs( + gwf, + pname="head_obs", + filename=f"{name}.obs", + digits=15, + print_input=True, + continuous=obs_recarray, + ) + + return sim + + +def eval_results(name, workspace): + # MODFLOW 6 maw results + test_name = name + fpth = os.path.join(workspace, f"{test_name}.maw.obs.csv") + tc = np.genfromtxt(fpth, names=True, delimiter=",") + + if test_name.endswith("a"): + # M1RATE should be 2000. + msg = "The injection rate should be 2000. for all times" + assert tc["M1RATE"].min() == tc["M1RATE"].max() == 2000, msg + + elif test_name.endswith("b"): + # M1RATE should have a minimum value less than 200 and + # M1HEAD should not exceed 0.400001 + msg = ( + "Injection rate should fall below 200 and the head should not" + "exceed 0.4" + ) + assert tc["M1RATE"].min() < 200.0, msg + assert tc["M1HEAD"].max() < 0.400001, msg + + elif test_name.endswith("c"): + # M1RATE should have a minimum value less than 800 + # M1HEAD should not exceed 1.0. + msg = ( + "Min injection rate should be less than 800 and well " + "head should not exceed 1.0" + ) + assert tc["M1RATE"].min() < 800.0 and tc["M1HEAD"].max() < 1.0, msg + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + ws = str(function_tmpdir) + sim = build_model(idx, ws, targets["mf6"]) + sim.write_simulation() + sim.run_simulation() + eval_results(name, ws) diff --git a/autotest/test_gwf_maw04.py b/autotest/test_gwf_maw04.py index e77656f0c68..dbbe44cc4c4 100644 --- a/autotest/test_gwf_maw04.py +++ b/autotest/test_gwf_maw04.py @@ -3,8 +3,7 @@ import flopy import numpy as np -from modflow_devtools.case import Case -from pytest_cases import parametrize +import pytest # temporal discretization nper = 2 @@ -101,198 +100,172 @@ def well4(label): ) -case = Case( - name="maw_iss305", - nlay=nlay, - nrow=nrow, - ncol=ncol, - nper=nper, - delr=delr, - perlen=perlen, - nstp=nstp, - tsmult=tsmult, - steady=steady, - strt=0, - hk=10, - nouter=100, - ninner=100, - hclose=1e-9, - rclose=1e-6, - relax=1, - top=top, - botm=botm, - confined=confined, - ss=ss, - chd_spd=chd_spd, - chd5_spd=chd5_spd, - nhalf=nhalf, - radius=radius, - wellq=wellq, - compare=False, -) -cases = [case.copy_update(name=case.name + "a", well=well4("a"),)] + [ - case.copy_update(name=case.name + label, well=well4(label), xfail=True) - for label in [ - "b", - # "c", # todo: this one passes when it should fail - "d", - "e", - "f", - ] -] +# npf data +strt = 0 +hk = 10 +# solver +nouter = 100 +ninner = 100 +hclose = 1e-9 +rclose = 1e-6 +relax = 1 -class GwfMaw04Cases: - @parametrize(data=cases, ids=[c.name for c in cases]) - def case_4(self, function_tmpdir, targets, data): - name = data.name - ws = str(function_tmpdir) +# subproblems +subprobs = ["a", "b", "c", "d", "e", "f"] +ex = [f"maw_iss305{sp}" for sp in subprobs] +wells = [well4(sp) for sp in subprobs] +xfail = [False, True, True, True, True, True] - # build MODFLOW 6 files - sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=ws - ) - # create tdis package - tdis_rc = [] - for idx in range(data.nper): - tdis_rc.append( - (data.perlen[idx], data.nstp[idx], data.tsmult[idx]) - ) - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=data.nper, perioddata=tdis_rc - ) - # create iterative model solution - ims = flopy.mf6.ModflowIms( - sim, - inner_dvclose=data.hclose, - rcloserecord=data.rclose, - outer_dvclose=data.hclose, - ) +def build_model(idx, ws, mf6): + name = ex[idx] + well = wells[idx] + # build MODFLOW 6 files + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=mf6, sim_ws=ws + ) + # create tdis package + tdis_rc = [] + for kper in range(nper): + tdis_rc.append((perlen[kper], nstp[kper], tsmult[kper])) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) - # create gwf model - gwf = flopy.mf6.ModflowGwf(sim, modelname=name, save_flows=True) + # create iterative model solution + ims = flopy.mf6.ModflowIms( + sim, + inner_dvclose=hclose, + rcloserecord=rclose, + outer_dvclose=hclose, + ) - # discretization - dis = flopy.mf6.ModflowGwfdis( - gwf, - nlay=data.nlay, - nrow=data.nrow, - ncol=data.ncol, - delr=data.delr, - delc=data.delr, - top=data.top, - botm=data.botm, - ) - # initial conditions - ic = flopy.mf6.ModflowGwfic(gwf, strt=data.strt) + # create gwf model + gwf = flopy.mf6.ModflowGwf(sim, modelname=name, save_flows=True) - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, save_flows=False, icelltype=data.confined, k=data.hk - ) - # storage - sto = flopy.mf6.ModflowGwfsto( - gwf, - save_flows=False, - iconvert=data.confined, - ss=data.ss, - steady_state={0: True}, - transient={1: True}, + # discretization + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delr, + top=top, + botm=botm, + ) + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, save_flows=False, icelltype=confined, k=hk + ) + # storage + sto = flopy.mf6.ModflowGwfsto( + gwf, + save_flows=False, + iconvert=confined, + ss=ss, + steady_state={0: True}, + transient={1: True}, + ) + # constant head + chd = flopy.mf6.ModflowGwfchd( + gwf, stress_period_data=chd_spd, save_flows=False + ) + # multi-aquifer well + maw = flopy.mf6.ModflowGwfmaw( + gwf, + print_input=well.print_input, + no_well_storage=well.no_well_storage, + packagedata=well.packagedata, + connectiondata=well.connectiondata, + perioddata=well.perioddata, + ) + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{name}.cbc", + head_filerecord=f"{name}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + # build MODFLOW-2005 files + if xfail[idx]: + mc = None + else: + cmppth = "mf2005" + ws = os.path.join(ws, cmppth) + mc = flopy.modflow.Modflow(name, model_ws=ws, version=cmppth) + dis = flopy.modflow.ModflowDis( + mc, + nlay=nlay, + nrow=nrow, + ncol=ncol, + nper=nper, + perlen=perlen, + nstp=nstp, + tsmult=tsmult, + steady=steady, + delr=delr, + delc=delr, + top=top, + botm=botm, ) - # constant head - chd = flopy.mf6.ModflowGwfchd( - gwf, stress_period_data=data.chd_spd, save_flows=False + bas = flopy.modflow.ModflowBas(mc, strt=strt) + lpf = flopy.modflow.ModflowLpf( + mc, + laytyp=confined, + hk=hk, + vka=hk, + ss=ss, + sy=0, ) - # multi-aquifer well - maw = flopy.mf6.ModflowGwfmaw( - gwf, - print_input=data.well.print_input, - no_well_storage=data.well.no_well_storage, - packagedata=data.well.packagedata, - connectiondata=data.well.connectiondata, - perioddata=data.well.perioddata, + chd = flopy.modflow.ModflowChd(mc, stress_period_data=chd5_spd) + # mnw2 + # empty mnw2 file to create recarrays + mnw2 = flopy.modflow.ModflowMnw2(mc) + node_data = mnw2.get_empty_node_data(2) + node_data["ztop"] = np.array([top, botm[0]]) + node_data["zbotm"] = np.array([botm[0], botm[1]]) + node_data["i"] = np.array([nhalf, nhalf]) + node_data["j"] = np.array([nhalf, nhalf]) + node_data["wellid"] = np.array(["well1", "well1"]) + node_data["losstype"] = np.array(["skin", "skin"]) + node_data["rw"] = np.array([radius, radius]) + node_data["rskin"] = np.array([sradius[name[-1]], sradius[name[-1]]]) + hks = hk * skin_mult[name[-1]] + node_data["kskin"] = np.array([hks, hks]) + dtype = [("wellid", np.unicode_, 20), ("qdes", " + # mawpackagedata = [ [0, mawradius, mawbottom, mstrt, mawcondeqn, mawngwfnodes] ] - # + # mawconnectiondata = [ [0, icon, (icon, 0, 0), top, mawbottom, -999.0, -999.0] for icon in range(nlay) ] - # + # mawperioddata = [[0, "STATUS", "ACTIVE"]] maw = flopy.mf6.ModflowGwfmaw( gwf, @@ -177,26 +179,24 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf_" + name fname = gwfname + ".maw.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="HEAD") stage = bobj.get_alldata().flatten() fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata() # calculate initial volume of water in well and aquifer - v0maw = mawstrt[sim.idxsim] * np.pi * 0.1**2 + v0maw = mawstrt[idx] * np.pi * 0.1**2 v0gwf = 4 * 7 * 0.3 v0 = v0maw + v0gwf top = [4.0, 3.0, 2.0, 1.0] @@ -214,7 +214,6 @@ def eval_results(sim): # calculate current volume of water in well and aquifer and compare with # initial volume for kstp, mawstage in enumerate(stage): - vgwf = 0 for k in range(nlay): for j in range(ncol): @@ -241,17 +240,14 @@ def eval_results(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_maw06.py b/autotest/test_gwf_maw06.py index 7a4748b059c..d16b04135b2 100644 --- a/autotest/test_gwf_maw06.py +++ b/autotest/test_gwf_maw06.py @@ -1,16 +1,18 @@ -# Test maw package ability to equalize and the flow correction. -# maw_06a - well start at .25, aquifer starts at 2 -# maw_06b - well starts at 2, aquifer starts at .25 +""" +Test maw package ability to equalize the flow correction. +maw_06a - well start at .25, aquifer starts at 2 +maw_06b - well starts at 2, aquifer starts at .25 +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["maw_06a", "maw_06b"] +cases = ["maw_06a", "maw_06b"] nlay = 2 nrow = 1 @@ -47,7 +49,7 @@ mawcond = Kh * delc * dz / (0.5 * delr) -def build_model(idx, dir): +def build_models(idx, test): nper = 1 perlen = [10.0] nstp = [100] @@ -60,10 +62,10 @@ def build_model(idx, dir): nouter, ninner = 700, 200 hclose, rclose, relax = 1e-9, 1e-9, 1.0 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -131,14 +133,14 @@ def build_model(idx, dir): mstrt = mawstrt[idx] mawcondeqn = "SPECIFIED" mawngwfnodes = nlay - # + # mawpackagedata = [[0, mawradius, bot, mstrt, mawcondeqn, mawngwfnodes]] - # + # mawconnectiondata = [ [0, icon, (icon, 0, 0), top, bot, mawcond, -999] for icon in range(nlay) ] - # + # mawperioddata = [[0, "STATUS", "ACTIVE"]] mbin = f"{gwfname}.maw.bin" mbud = f"{gwfname}.maw.bud" @@ -197,27 +199,25 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf_" + name fname = gwfname + ".maw.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="HEAD") stage = bobj.get_alldata().flatten() fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata() # calculate initial volume of water in well and aquifer - v0maw = mawstrt[sim.idxsim] * mawarea - v0gwf = (gwfstrt[sim.idxsim] - bot) * sy * gwfarea + v0maw = mawstrt[idx] * mawarea + v0gwf = (gwfstrt[idx] - bot) * sy * gwfarea v0 = v0maw + v0gwf print( @@ -257,13 +257,13 @@ def eval_results(sim): # compare the maw-gwf flows with the gwf-maw flows fname = gwfname + ".maw.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mbud = flopy.utils.CellBudgetFile(fname, precision="double") maw_gwf = mbud.get_data(text="GWF") fname = gwfname + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gbud = flopy.utils.CellBudgetFile(fname, precision="double") gwf_maw = gbud.get_data(text="MAW") @@ -279,17 +279,14 @@ def eval_results(sim): assert np.allclose(qmaw, -qgwf), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_maw07.py b/autotest/test_gwf_maw07.py index c92ff6e105b..8ddede3585e 100644 --- a/autotest/test_gwf_maw07.py +++ b/autotest/test_gwf_maw07.py @@ -1,16 +1,18 @@ -# Modifiy the previous test by having a first stress period where the -# MAW well is inactive. Test ensures that gwf-maw and maw-gwf flows reported -# in the gwf and maw budget files are zero for this first period. +""" +Modify the previous test by having a first stress period where the +MAW well is inactive. Test ensures that gwf-maw and maw-gwf flows +in the gwf and maw budget files are zero for this first period. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["maw_07a", "maw_07b"] +cases = ["maw_07a", "maw_07b"] nlay = 2 nrow = 1 @@ -47,7 +49,7 @@ mawcond = Kh * delc * dz / (0.5 * delr) -def build_model(idx, dir): +def build_models(idx, test): nper = 2 perlen = [10.0, 10.0] nstp = [1, 100] @@ -60,10 +62,10 @@ def build_model(idx, dir): nouter, ninner = 700, 200 hclose, rclose, relax = 1e-9, 1e-9, 1.0 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -131,14 +133,14 @@ def build_model(idx, dir): mstrt = mawstrt[idx] mawcondeqn = "SPECIFIED" mawngwfnodes = nlay - # + # mawpackagedata = [[0, mawradius, bot, mstrt, mawcondeqn, mawngwfnodes]] - # + # mawconnectiondata = [ [0, icon, (icon, 0, 0), top, bot, mawcond, -999] for icon in range(nlay) ] - # + # mawperioddata = {} mawperioddata[0] = [[0, "STATUS", "INACTIVE"]] mawperioddata[1] = [[0, "STATUS", "ACTIVE"]] @@ -199,27 +201,25 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # calculate volume of water and make sure it is conserved - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf_" + name fname = gwfname + ".maw.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="HEAD") stage = bobj.get_alldata().flatten()[1:] fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata()[1:] # calculate initial volume of water in well and aquifer - v0maw = mawstrt[sim.idxsim] * mawarea - v0gwf = (gwfstrt[sim.idxsim] - bot) * sy * gwfarea + v0maw = mawstrt[idx] * mawarea + v0gwf = (gwfstrt[idx] - bot) * sy * gwfarea v0 = v0maw + v0gwf print( @@ -259,13 +259,13 @@ def eval_results(sim): # compare the maw-gwf flows with the gwf-maw flows fname = gwfname + ".maw.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mbud = flopy.utils.CellBudgetFile(fname, precision="double") maw_gwf = mbud.get_data(text="GWF") fname = gwfname + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gbud = flopy.utils.CellBudgetFile(fname, precision="double") gwf_maw = gbud.get_data(text="MAW") @@ -285,17 +285,14 @@ def eval_results(sim): assert np.allclose(qmaw, -qgwf), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_maw08.py b/autotest/test_gwf_maw08.py index e4f423298f9..94e7dfa36f7 100644 --- a/autotest/test_gwf_maw08.py +++ b/autotest/test_gwf_maw08.py @@ -1,15 +1,17 @@ -# test to evaluate Newton-Raphson solution for a single column steady-state -# dry multi-aquifer well problem. Developed to address issue #546 +""" +Test Newton-Raphson solution for a single column steady-state +dry multi-aquifer well problem. Developed to address issue #546 +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ("maw_08a", "maw_08b") +cases = ("maw_08a", "maw_08b") dis_option = ("dis", "disv") nlay = 3 @@ -42,13 +44,13 @@ radius = 0.05 -def build_model(idx, dir): +def build_models(idx, test): dvclose, rclose, relax = 1e-9, 1e-9, 1.0 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -121,7 +123,7 @@ def build_model(idx, dir): k33=Kv, ) - # + # mawpackagedata = flopy.mf6.ModflowGwfmaw.packagedata.empty(gwf, maxbound=1) mawpackagedata["radius"] = radius mawpackagedata["bottom"] = maw_bot @@ -129,7 +131,7 @@ def build_model(idx, dir): mawpackagedata["condeqn"] = "thiem" mawpackagedata["ngwfnodes"] = 2 - # + # mawconnectiondata = flopy.mf6.ModflowGwfmaw.connectiondata.empty( gwf, maxbound=2 ) @@ -194,14 +196,12 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def eval_results(idx, test): # calculate volume of water and make sure it is conserved - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf_" + name fname = gwfname + ".maw.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.HeadFile(fname, text="HEAD") @@ -211,20 +211,20 @@ def eval_results(sim): ), f"simulated maw head ({well_head[0]}) does not equal 10." fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata()[1:] # compare the maw-gwf flows with the gwf-maw flows fname = gwfname + ".maw.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mbud = flopy.utils.CellBudgetFile(fname, precision="double") maw_gwf = mbud.get_data(text="GWF") fname = gwfname + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gbud = flopy.utils.CellBudgetFile(fname, precision="double") gwf_maw = gbud.get_data(text="MAW") @@ -240,17 +240,13 @@ def eval_results(sim): assert np.allclose(qmaw, -qgwf), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: eval_results(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_maw09.py b/autotest/test_gwf_maw09.py index 48541261bb7..730e5cb0c8d 100644 --- a/autotest/test_gwf_maw09.py +++ b/autotest/test_gwf_maw09.py @@ -1,15 +1,17 @@ -# test to evaluate Newton-Raphson solution for a single column transient -# dry multi-aquifer well problem. Developed to address issue #546 +""" +test to evaluate Newton-Raphson solution for a single column transient +dry multi-aquifer well problem. Developed to address issue #546 +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ("maw_09a", "maw_09b", "maw_09c", "maw_09d") +cases = ("maw_09a", "maw_09b", "maw_09c", "maw_09d") dis_option = ("dis", "dis", "disv", "disv") flow_correction = (None, True, None, True) @@ -44,13 +46,13 @@ radius = np.sqrt(1.0 / np.pi) -def build_model(idx, dir): +def build_models(idx, test): dvclose, rclose, relax = 1e-9, 1e-9, 1.0 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -146,7 +148,7 @@ def build_model(idx, dir): gwf, ss=0.0, sy=1.0, transient=True, iconvert=1 ) - # + # mawpackagedata = flopy.mf6.ModflowGwfmaw.packagedata.empty(gwf, maxbound=1) mawpackagedata["radius"] = radius mawpackagedata["bottom"] = maw_bot @@ -154,7 +156,7 @@ def build_model(idx, dir): mawpackagedata["condeqn"] = "specified" mawpackagedata["ngwfnodes"] = 2 - # + # mawconnectiondata = flopy.mf6.ModflowGwfmaw.connectiondata.empty( gwf, maxbound=2 ) @@ -220,21 +222,19 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwfname = "gwf_" + name # get well observations fname = f"{gwfname}.gwf.obs.csv" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gobs = np.genfromtxt(fname, delimiter=",", names=True) # get well observations fname = f"{gwfname}.maw.obs.csv" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) wobs = np.genfromtxt(fname, delimiter=",", names=True)["WHEAD"] @@ -242,10 +242,10 @@ def eval_results(sim): # volume comparisons can be made based on saturated thickness because # the cell area and well area are both equal to 1 v0 = (maw_strt - 10.0) + (strt - 0.0) - for idx, w in enumerate(wobs): + for i, w in enumerate(wobs): vg = 0.0 for jdx, tag in enumerate(("C1", "C2", "C3")): - g = gobs[tag][idx] + g = gobs[tag][i] ctop = zelevs[jdx] cbot = zelevs[jdx + 1] if g > ctop: @@ -259,7 +259,7 @@ def eval_results(sim): vt = vw + vg # write a message - msg = f"{idx}\n well volume: {vw} " + msg = f"{i}\n well volume: {vw} " msg += f"\n groundwater volume: {vg}" msg += f"\n total volume: {vt}" print(msg) @@ -276,20 +276,20 @@ def eval_results(sim): ), f"final simulated maw head ({well_head}) does not equal 17.25." fname = gwfname + ".hds" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) hobj = flopy.utils.HeadFile(fname) head = hobj.get_alldata()[1:] # compare the maw-gwf flows with the gwf-maw flows fname = gwfname + ".maw.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mbud = flopy.utils.CellBudgetFile(fname, precision="double") maw_gwf = mbud.get_data(text="GWF") fname = gwfname + ".cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) gbud = flopy.utils.CellBudgetFile(fname, precision="double") gwf_maw = gbud.get_data(text="MAW") @@ -305,17 +305,14 @@ def eval_results(sim): assert np.allclose(qmaw, -qgwf), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + compare="mf6_regression", ) + test.run() diff --git a/autotest/test_gwf_maw10.py b/autotest/test_gwf_maw10.py index f677c7814c7..0ef9d13338e 100644 --- a/autotest/test_gwf_maw10.py +++ b/autotest/test_gwf_maw10.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to confirm that the sum of rate-actual and maw-reduction observations is equal to the specified MAW extraction or injection pumping rate when reported using the MAW_FLOW_REDUCE_CSV option. Injection and extraction @@ -12,10 +11,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["maw10a", "maw10b", "maw10c", "maw10d"] +cases = ["maw10a", "maw10b", "maw10c", "maw10d"] mawsetting_a = { 0: [ [0, "rate", -2000.0], @@ -61,8 +60,7 @@ mawsettings = [mawsetting_a, mawsetting_b, mawsetting_c, mawsetting_d] -def build_model(idx, dir): - +def build_models(idx, test): nlay, nrow, ncol = 1, 101, 101 nper = 2 perlen = [500.0, 500.0] @@ -81,10 +79,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation(sim_name=name, sim_ws=ws) # create tdis package @@ -212,14 +210,11 @@ def build_model(idx, dir): # 1. within the .maw-reduction.csv file, do values of actual + reduction = requested? # 2. do the values in .maw-reduction.csv file match with the .maw.obs.csv file at each time # (and all are reduction times present in the obs file)? -def eval_mawred(sim): - print("evaluating MAW flow reduction outputs...") - +def check_output(idx, test): # MODFLOW 6 maw results - idx = sim.idxsim - name = ex[idx] - fpthobs = os.path.join(sim.simpath, f"{name}.maw.obs.csv") - fpthmfr = os.path.join(sim.simpath, f"{name}.maw-reduction.csv") + name = cases[idx] + fpthobs = os.path.join(test.workspace, f"{name}.maw.obs.csv") + fpthmfr = os.path.join(test.workspace, f"{name}.maw-reduction.csv") try: tcobs = np.genfromtxt(fpthobs, names=True, delimiter=",") except: @@ -266,17 +261,13 @@ def eval_mawred(sim): @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_mawred, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_maw_cases.py b/autotest/test_gwf_maw_cases.py deleted file mode 100644 index 4469bcee2cc..00000000000 --- a/autotest/test_gwf_maw_cases.py +++ /dev/null @@ -1,817 +0,0 @@ -import os -from collections import namedtuple -from types import SimpleNamespace - -import flopy -import numpy as np -from modflow_devtools.case import Case -from pytest_cases import parametrize - -well1 = SimpleNamespace( - observations={"maw_obs.csv": [("mh1", "head", 1)]}, - packagedata=[[0, 0.1, 50.0, 100.0, "THIEM", 1]], - connectiondata=[[0, 0, (0, 0, 1), 100.0, 50.0, 1.0, 0.1]], - perioddata=[[0, "rate", 0.0]], -) - -well2 = SimpleNamespace( - observations={"maw_obs.csv": [("mh1", "head", 1)]}, - packagedata=[ - [0, 0.1, 0.0, 100.0, "THIEM", 1], - [1, 0.1, 0.0, 100.0, "THIEM", 1], - ], - connectiondata=[ - [0, 0, (0, 0, 1), 100.0, 0.0, 1.0, 0.1], - [1, 0, (0, 0, 1), 100.0, 0.0, 1.0, 0.1], - ], - perioddata={ - 0: [ - [0, "rate", -20.0], - [0, "status", "inactive"], - [0, "rate_scaling", 1.0, 15.0], - [1, "rate", -30.0], - [1, "status", "inactive"], - [1, "rate_scaling", 5.0, 15.0], - ], - 1: [ - [0, "rate", -110.0], - [0, "status", "active"], - [1, "rate", -130.0], - [1, "status", "active"], - ], - 3: [[0, "status", "inactive"]], - 4: [[0, "status", "active"]], - }, -) - - -def well3(name): - perioddata = { - "maw03a": [ - (0, "rate", 2000.0), - ], - "maw03b": [(0, "rate", 2000.0), (0, "head_limit", 0.4)], - "maw03c": [(0, "rate", 2000.0), (0, "rate_scaling", 0.0, 1.0)], - } - wellbottom = -1000 - return SimpleNamespace( - observations={ - f"{name}.maw.obs.csv": [ - ("m1head", "head", (0,)), - ("m1rate", "rate", (0,)), - ] # is this index one-based? Not if in a tuple - }, - packagedata=[[0, 0.15, wellbottom, 0.0, "THIEM", 1]], - connectiondata=[[0, 0, (0, 50, 50), 0.0, wellbottom, 0.0, 0.0]], - perioddata=perioddata[name], - ) - - -def well4(case, condeqn): - radius0 = np.sqrt( - case.delr[case.nhalf] * case.delr[case.nhalf] / (8.0 * np.pi) - ) - radius = 0.25 - sradius0 = radius + 0.1 - sradius = [sradius0, sradius0, sradius0, sradius0, sradius0, radius0 * 1.5] - packagedata = [[0, case.radius, case.botm[-1], case.strt, condeqn, 2]] - connectiondata = [ - [ - 0, - 0, - (0, case.nhalf, case.nhalf), - case.top, - case.botm[0], - case.hks, - sradius[case.name], - ], - [ - 0, - 1, - (1, case.nhalf, case.nhalf), - case.botm[0], - case.botm[1], - case.hks, - sradius[case.name], - ], - ] - perioddata = {1: [[0, "RATE", case.wellq]]} - return SimpleNamespace( - print_input=True, - no_well_storage=True, - packagedata=packagedata, - connectiondata=connectiondata, - perioddata=perioddata, - ) - - -class GwfMawCases: - """ - Test cases for multi-aquifer well groundwater flow models. - """ - - budtol = 1e-2 - bud_lst = ["GWF_IN", "GWF_OUT", "RATE_IN", "RATE_OUT"] - - case1 = Case( - name="maw01", - nlay=1, - nrow=1, - ncol=3, - nper=3, - delr=300, - delc=300, - krylov="CG", - perlen=3 * [1], - nstp=3 * [1], - tsmult=3 * [1], - well=well1, - strt=100, - hk=1, - nouter=100, - ninner=300, - hclose=1e-9, - rclose=1e-3, - relaxation_factor=1, - newton=None, - compare=False, - ) - cases1 = [ - case1, - case1.copy_update(name="maw01nwt", krylov="BICGSTAB", newton="NEWTON"), - case1.copy_update( - name="maw01nwtur", - krylov="BICGSTAB", - newton="NEWTON UNDER_RELAXATION", - ), - ] - - @parametrize(data=cases1, ids=[c.name for c in cases1]) - def case_1(self, function_tmpdir, targets, data): - sim = flopy.mf6.MFSimulation( - sim_name=data.name, - version="mf6", - exe_name=targets["mf6"], - sim_ws=str(function_tmpdir), - ) - - # create tdis package - tdis_rc = [ - (data.perlen[i], data.nstp[i], data.tsmult[i]) - for i in range(data.nper) - ] - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=data.nper, perioddata=tdis_rc - ) - - # create gwf model - gwf = flopy.mf6.MFModel( - sim, - model_type="gwf6", - modelname=data.name, - model_nam_file=f"{data.name}.nam", - ) - gwf.name_file.newtonoptions = data.newton - - # create iterative model solution and register the gwf model with it - ims = flopy.mf6.ModflowIms( - sim, - print_option="SUMMARY", - outer_dvclose=data.hclose, - outer_maximum=data.nouter, - under_relaxation="NONE", - inner_maximum=data.ninner, - inner_dvclose=data.hclose, - rcloserecord=data.rclose, - linear_acceleration=data.krylov, - scaling_method="NONE", - reordering_method="NONE", - relaxation_factor=data.relaxation_factor, - ) - sim.register_ims_package(ims, [gwf.name]) - - dis = flopy.mf6.ModflowGwfdis( - gwf, - nlay=data.nlay, - nrow=data.nrow, - ncol=data.ncol, - delr=data.delr, - delc=data.delc, - top=100.0, - botm=0.0, - idomain=1, - filename=f"{data.name}.dis", - ) - - # initial conditions - ic = flopy.mf6.ModflowGwfic( - gwf, strt=data.strt, filename=f"{data.name}.ic" - ) - - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, - save_flows=True, - icelltype=1, - k=data.hk, - k33=data.hk, - filename=f"{data.name}.npf", - ) - # storage - sto = flopy.mf6.ModflowGwfsto( - gwf, - save_flows=True, - iconvert=1, - ss=0.0, - sy=0.1, - steady_state={0: True}, - # transient={1: False}, - filename=f"{data.name}.sto", - ) - - # chd files - chdlist0 = [] - chdlist0.append([(0, 0, 0), 100.0]) - chdlist0.append([(0, 0, 2), 100.0]) - - chdlist1 = [] - chdlist1.append([(0, 0, 0), 25.0]) - chdlist1.append([(0, 0, 2), 25.0]) - - chdspdict = {0: chdlist0, 1: chdlist1, 2: chdlist0} - chd = flopy.mf6.ModflowGwfchd( - gwf, - stress_period_data=chdspdict, - save_flows=False, - filename=f"{data.name}.chd", - ) - - # wel files - # wel = flopy.mf6.ModflowGwfwel(gwf, print_input=True, print_flows=True, - # maxbound=len(ws), - # periodrecarray=wd6, - # save_flows=False) - # MAW - maw = flopy.mf6.ModflowGwfmaw( - gwf, - filename=f"{data.name}.maw", - print_input=True, - print_head=True, - print_flows=True, - save_flows=True, - observations=data.well.observations, - packagedata=data.well.packagedata, - connectiondata=data.well.connectiondata, - perioddata=data.well.perioddata, - ) - - # output control - oc = flopy.mf6.ModflowGwfoc( - gwf, - budget_filerecord=f"{data.name}.cbc", - head_filerecord=f"{data.name}.hds", - headprintrecord=[ - ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") - ], - saverecord=[("HEAD", "ALL")], - printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - filename=f"{data.name}.oc", - ) - - return data, sim, None, self.eval_1 - - def eval_1(self, config, data): - print("evaluating MAW heads...") - - # MODFLOW 6 maw results - fpth = os.path.join(config.simpath, "maw_obs.csv") - tc = np.genfromtxt(fpth, names=True, delimiter=",") - - # create known results array - tc0 = np.array([100.0, 25.0, 100.0]) - - # calculate maximum absolute error - diff = tc["MH1"] - tc0 - diffmax = np.abs(diff).max() - dtol = 1e-9 - msg = f"maximum absolute maw head difference ({diffmax}) " - - if diffmax > dtol: - config.success = False - msg += f"exceeds {dtol}" - assert diffmax < dtol, msg - else: - config.success = True - print(" " + msg) - - case2 = Case( - name="maw02", - krylov="CG", - nlay=1, - nrow=1, - ncol=3, - nper=5, - delr=300, - delc=300, - perlen=5 * [1], - nstp=5 * [1], - tsmult=5 * [1], - well=well2, - strt=100, - hk=1, - nouter=100, - ninner=300, - hclose=1e-9, - rclose=1e-3, - relaxation_factor=1, - compare=False, - ) - cases2 = [case2] - - @parametrize(data=cases2, ids=[c.name for c in cases2]) - def case_2(self, function_tmpdir, targets, data): - name = data.name - ws = str(function_tmpdir) - sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=ws - ) - - # create tdis package - tdis_rc = [ - (data.perlen[i], data.nstp[i], data.tsmult[i]) - for i in range(data.nper) - ] - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=data.nper, perioddata=tdis_rc - ) - - # create gwf model - gwf = flopy.mf6.MFModel( - sim, - model_type="gwf6", - modelname=name, - model_nam_file=f"{name}.nam", - ) - - # create iterative model solution and register the gwf model with it - ims = flopy.mf6.ModflowIms( - sim, - print_option="SUMMARY", - outer_dvclose=data.hclose, - outer_maximum=data.nouter, - under_relaxation="NONE", - inner_maximum=data.ninner, - inner_dvclose=data.hclose, - rcloserecord=data.rclose, - linear_acceleration=data.krylov, - scaling_method="NONE", - reordering_method="NONE", - relaxation_factor=data.relaxation_factor, - ) - sim.register_ims_package(ims, [gwf.name]) - - dis = flopy.mf6.ModflowGwfdis( - gwf, - nlay=data.nlay, - nrow=data.nrow, - ncol=data.ncol, - delr=data.delr, - delc=data.delc, - top=100.0, - botm=0.0, - idomain=1, - filename=f"{name}.dis", - ) - - # initial conditions - ic = flopy.mf6.ModflowGwfic(gwf, strt=data.strt, filename=f"{name}.ic") - - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, - save_flows=True, - icelltype=1, - k=data.hk, - k33=data.hk, - filename=f"{name}.npf", - ) - # storage - sto = flopy.mf6.ModflowGwfsto( - gwf, - save_flows=True, - iconvert=1, - ss=0.0, - sy=0.1, - steady_state={0: True}, - # transient={1: False}, - filename=f"{name}.sto", - ) - - # chd files - chdlist0 = [] - chdlist0.append([(0, 0, 0), 100.0]) - chdlist0.append([(0, 0, 2), 100.0]) - - chdlist1 = [] - chdlist1.append([(0, 0, 0), 25.0]) - chdlist1.append([(0, 0, 2), 25.0]) - - chdspdict = {0: chdlist0, 1: chdlist1, 2: chdlist0} - chd = flopy.mf6.ModflowGwfchd( - gwf, - stress_period_data=chdspdict, - save_flows=False, - filename=f"{name}.chd", - ) - - # MAW - maw = flopy.mf6.ModflowGwfmaw( - gwf, - filename=f"{name}.maw", - budget_filerecord=f"{name}.maw.cbc", - print_input=True, - print_head=True, - print_flows=True, - save_flows=True, - observations=data.well.observations, - packagedata=data.well.packagedata, - connectiondata=data.well.connectiondata, - perioddata=data.well.perioddata, - pname="MAW-1", - ) - - # output control - oc = flopy.mf6.ModflowGwfoc( - gwf, - budget_filerecord=f"{name}.cbc", - head_filerecord=f"{name}.hds", - headprintrecord=[ - ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") - ], - saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - filename=f"{name}.oc", - ) - - return data, sim, None, self.eval_2 - - def eval_2(self, config, data): - print("evaluating MAW budgets...") - - shape3d = (data.nlay, data.nrow, data.ncol) - size3d = data.nlay * data.nrow * data.ncol - - # get results from listing file - fpth = os.path.join( - config.simpath, f"{os.path.basename(config.name)}.lst" - ) - budl = flopy.utils.Mf6ListBudget( - fpth, budgetkey="MAW-1 BUDGET FOR ENTIRE MODEL AT END OF TIME STEP" - ) - names = list(self.bud_lst) - d0 = budl.get_budget(names=names)[0] - dtype = d0.dtype - nbud = d0.shape[0] - - # get results from cbc file - cbc_bud = ["GWF", "RATE"] - d = np.recarray(nbud, dtype=dtype) - for key in self.bud_lst: - d[key] = 0.0 - fpth = os.path.join( - config.simpath, f"{os.path.basename(config.name)}.maw.cbc" - ) - cobj = flopy.utils.CellBudgetFile(fpth, precision="double") - kk = cobj.get_kstpkper() - times = cobj.get_times() - cbc_vals = [] - for idx, (k, t) in enumerate(zip(kk, times)): - for text in cbc_bud: - qin = 0.0 - qout = 0.0 - v = cobj.get_data(kstpkper=k, text=text)[0] - if isinstance(v, np.recarray): - vt = np.zeros(size3d, dtype=float) - wq = [] - for jdx, node in enumerate(v["node"]): - vt[node - 1] += v["q"][jdx] - wq.append(v["q"][jdx]) - v = vt.reshape(shape3d) - if text == cbc_bud[-1]: - cbc_vals.append(wq) - for kk in range(v.shape[0]): - for ii in range(v.shape[1]): - for jj in range(v.shape[2]): - vv = v[kk, ii, jj] - if vv < 0.0: - qout -= vv - else: - qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] - d["stress_period"] = k[1] - key = f"{text}_IN" - d[key][idx] = qin - key = f"{text}_OUT" - d[key][idx] = qout - - maw_vals = [ - [0.000, 0.000], - [-106.11303563809453, -96.22598985147631], - [-110.000, -130.000], - [0.0, -130.000], - [-110.000, -130.000], - ] - - # evaluate if well rates in cbc file are equal to expected values - diffv = [] - for ovs, svs in zip(maw_vals, cbc_vals): - for ov, sv in zip(ovs, svs): - diffv.append(ov - sv) - diffv = np.abs(np.array(diffv)).max() - msg = f"\nmaximum absolute maw rate difference ({diffv})\n" - - # calculate difference between water budget items in the lst and cbc files - diff = np.zeros((nbud, len(self.bud_lst)), dtype=float) - for idx, key in enumerate(self.bud_lst): - diff[:, idx] = d0[key] - d[key] - diffmax = np.abs(diff).max() - msg += f"maximum absolute total-budget difference ({diffmax}) " - - # write summary - fpth = os.path.join( - config.simpath, f"{os.path.basename(config.name)}.bud.cmp.out" - ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(self.bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" - f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(self.bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() - - if diffmax > self.budtol or diffv > self.budtol: - config.success = False - msg += f"\n...exceeds {self.budtol}" - assert diffmax < self.budtol, msg - else: - config.success = True - print(" " + msg) - - case3 = Case( - name="maw03", - krylov="CG", - nlay=1, - nrow=101, - ncol=101, - nper=1, - delr=142, - delc=142, - perlen=[1000], - nstp=[50], - tsmult=[1.2], - strt=0, - hk=10, - nouter=100, - ninner=100, - hclose=1e-6, - rclose=1e-6, - relaxation_factor=1, - compare=False, - ) - cases3 = [ - case3.copy_update( - name="maw03a", - well=well3("maw03a"), - ), - case3.copy_update(name="maw03b", well=well3("maw03b")), - case3.copy_update(name="maw03c", well=well3("maw03c")), - ] - - @parametrize(data=cases3, ids=[c.name for c in cases3]) - def case_3(self, function_tmpdir, targets, data): - top = 0.0 - botm = [-1000.0] - - tdis_rc = [] - for i in range(data.nper): - tdis_rc.append((data.perlen[i], data.nstp[i], data.tsmult[i])) - - name = data.name - ws = str(function_tmpdir) - sim = flopy.mf6.MFSimulation( - sim_name=name, sim_ws=ws, exe_name=targets["mf6"] - ) - - # create tdis package - tdis = flopy.mf6.ModflowTdis( - sim, time_units="DAYS", nper=data.nper, perioddata=tdis_rc - ) - - # create gwf model - gwf = flopy.mf6.MFModel( - sim, - model_type="gwf6", - modelname=name, - model_nam_file=f"{name}.nam", - ) - - # create iterative model solution and register the gwf model with it - ims = flopy.mf6.ModflowIms( - sim, - print_option="SUMMARY", - outer_dvclose=data.hclose, - outer_maximum=data.nouter, - under_relaxation="NONE", - inner_maximum=data.ninner, - inner_dvclose=data.hclose, - rcloserecord=data.rclose, - linear_acceleration=data.krylov, - scaling_method="NONE", - reordering_method="NONE", - relaxation_factor=data.relaxation_factor, - ) - sim.register_ims_package(ims, [gwf.name]) - - dis = flopy.mf6.ModflowGwfdis( - gwf, - nlay=data.nlay, - nrow=data.nrow, - ncol=data.ncol, - delr=data.delr, - delc=data.delc, - top=top, - botm=botm, - idomain=1, - filename=f"{name}.dis", - ) - - # initial conditions - ic = flopy.mf6.ModflowGwfic(gwf, strt=data.strt, filename=f"{name}.ic") - - # node property flow - npf = flopy.mf6.ModflowGwfnpf( - gwf, - save_flows=True, - icelltype=1, - k=data.hk, - k33=data.hk, - filename=f"{name}.npf", - ) - - # storage - sto = flopy.mf6.ModflowGwfsto( - gwf, - save_flows=True, - iconvert=0, - ss=1.0e-5, - sy=0.1, - steady_state={0: False}, - transient={0: True}, - filename=f"{name}.sto", - ) - - # MAW - maw = flopy.mf6.ModflowGwfmaw( - gwf, - filename=f"{name}.maw", - print_input=True, - print_head=True, - print_flows=True, - save_flows=True, - observations=data.well.observations, - packagedata=data.well.packagedata, - connectiondata=data.well.connectiondata, - perioddata=data.well.perioddata, - ) - - # output control - oc = flopy.mf6.ModflowGwfoc( - gwf, - budget_filerecord=f"{name}.cbc", - head_filerecord=f"{name}.hds", - headprintrecord=[ - ("COLUMNS", data.ncol, "WIDTH", 15, "DIGITS", 6, "GENERAL") - ], - saverecord=[("HEAD", "ALL")], - printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], - filename=f"{name}.oc", - ) - - # head observations - obs_data0 = [("head_well_cell", "HEAD", (0, 0, 0))] - obs_recarray = {f"{name}.obs.csv": obs_data0} - obs = flopy.mf6.ModflowUtlobs( - gwf, - pname="head_obs", - filename=f"{name}.obs", - digits=15, - print_input=True, - continuous=obs_recarray, - ) - - return data, sim, None, self.eval_3 - - def eval_3(self, config, data): - print("evaluating MAW heads...") - - # MODFLOW 6 maw results - test_name = config.name - case_name = data.name - fpth = os.path.join(config.simpath, f"{test_name}.maw.obs.csv") - tc = np.genfromtxt(fpth, names=True, delimiter=",") - - if case_name == "a": - - # M1RATE should be 2000. - msg = "The injection rate should be 2000. for all times" - assert tc["M1RATE"].min() == tc["M1RATE"].max() == 2000, msg - - elif case_name == "b": - - # M1RATE should have a minimum value less than 200 and - # M1HEAD should not exceed 0.400001 - msg = ( - "Injection rate should fall below 200 and the head should not" - "exceed 0.4" - ) - assert tc["M1RATE"].min() < 200.0, msg - assert tc["M1HEAD"].max() < 0.400001, msg - - elif case_name == "c": - - # M1RATE should have a minimum value less than 800 - # M1HEAD should not exceed 1.0. - msg = ( - "Min injection rate should be less than 800 and well " - "head should not exceed 1.0" - ) - assert tc["M1RATE"].min() < 800.0 and tc["M1HEAD"].max() < 1.0, msg - - # TODO - # case4 = Case( - # name='maw_iss305', - # krylov='CG', - # nlay=2, - # nrow=101, - # ncol=101, - # nper=2, - # delr=142, - # delc=142, - # perlen=[0.0, 365.0], - # nstp=[1, 25], - # tsmult=[1.0, 1.1], - # steady=[True, False], - # well=None, - # strt=0, - # hk=10, - # nouter=100, - # ninner=100, - # hclose=1e-9, - # rclose=1e-6, - # relax=1, - # require_failure=True - # ) - # cases4 = [ - # case4.copy_update({ - # 'name': "maw_iss305a", - # 'well': well4(case4, "CUMULATIVE"), - # 'require_failure': False - # }), - # case4.copy_update({ - # 'name': "maw_iss305b", - # 'well': well4(case4, "SKIN") - # }), - # case4.copy_update({ - # 'name': "maw_iss305c", - # 'well': well4(case4, "SKIN") - # }), - # case4.copy_update({ - # 'name': "maw_iss305d", - # 'well': well4(case4, "SKIN") - # }), - # case4.copy_update({ - # 'name': "maw_iss305e", - # 'well': well4(case4, "SPECIFIED") - # }), - # case4.copy_update({ - # 'name': "maw_iss305f", - # 'well': well4(case4, "CUMULATIVE") - # }) - # ] - - # @parametrize(data=cases4, ids=[c['name'] for c in cases4]) - # def case_4(self, function_tmpdir, targets, data): - # pass - - # def eval_4(self, sim, data): - # pass diff --git a/autotest/test_gwf_maw_obs.py b/autotest/test_gwf_maw_obs.py index 7455949fc37..1b9666878b5 100644 --- a/autotest/test_gwf_maw_obs.py +++ b/autotest/test_gwf_maw_obs.py @@ -1,20 +1,20 @@ -# Test for checking maw observation input. The following observation types: -# 'maw' and 'conductance,' require that ID2 be provided when -# ID is an integer corresponding to a well number and not BOUNDNAME. -# See table in MAW Package section of mf6io.pdf for an explanation of ID, -# ID2, and Observation Type. - +""" +Test for checking maw observation input. The following observation types: +'maw' and 'conductance,' require that ID2 be provided when +ID is an integer corresponding to a well number and not BOUNDNAME. +See table in MAW Package section of mf6io.pdf for an explanation of ID, +ID2, and Observation Type. +""" import os import flopy newtonoptions = [None, "NEWTON", "NEWTON UNDER_RELAXATION"] -ex = "maw_obs" +cases = "maw_obs" def build_model(dir, exe): - nlay, nrow, ncol = 1, 1, 3 nper = 3 perlen = [1.0, 1.0, 1.0] @@ -35,7 +35,7 @@ def build_model(dir, exe): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex + name = cases # build MODFLOW 6 files ws = dir @@ -188,8 +188,8 @@ def test_mf6model(function_tmpdir, targets): ) # fix the error and attempt to rerun model - orig_fl = str(function_tmpdir / (ex + ".maw.obs")) - new_fl = str(function_tmpdir / (ex + ".maw.obs.new")) + orig_fl = str(function_tmpdir / (cases + ".maw.obs")) + new_fl = str(function_tmpdir / (cases + ".maw.obs.new")) sr = open(orig_fl, "r") sw = open(new_fl, "w") @@ -210,5 +210,4 @@ def test_mf6model(function_tmpdir, targets): # rerun the model, should be no errors success, buff = sim.run_simulation() - - assert success, "model rerun failed" + assert success, buff diff --git a/autotest/test_gwf_mf6io_app2_examples_distypes.py b/autotest/test_gwf_mf6io_app2_examples_distypes.py new file mode 100644 index 00000000000..542b3e694f0 --- /dev/null +++ b/autotest/test_gwf_mf6io_app2_examples_distypes.py @@ -0,0 +1,569 @@ +import pathlib as pl + +import flopy +import numpy as np +import pytest +from flopy.utils.gridgen import Gridgen +from conftest import try_get_target + +from framework import TestFramework + +dis_types = ( + "disv", + "disu", +) +problems = ( + "ps1a", + "ps2a", + "ps2b", + "ps2c", + "ps2c1", + "ps2d", + "ps2e", +) +cases = [] +for problem in problems: + cases += [f"{problem}_{dis_type}" for dis_type in dis_types] + +# base spatial discretization +nlay, nrow, ncol = 3, 21, 20 +shape3d = (nlay, nrow, ncol) +shape2d = (nrow, ncol) +size3d = nlay * nrow * ncol +size2d = nrow * ncol + +delr = delc = 500.0 +x0_base, x1_base, y0_base, y1_base = 0, ncol * delr, 0.0, nrow * delc +top = 400.0 +bot = 0.0 +botm = [220.0, 200.0, 0.0] +z_node = [310.0, 210.0, 100.0] + +hk = [50.0, 0.01, 200.0] +vk = [10.0, 0.01, 20.0] + +concentration = 1.0 + +canal_head = 330.0 +canal_coordinates = [ + (0.5 * delr, y1_base - delc * (i + 0.5)) for i in range(nrow) +] + +river_head = 320.0 +river_coordinates = [ + (x1_base - 0.5 * delr, y1_base - delc * (i + 0.5)) for i in range(nrow) +] + +rch_rate = 0.005 + +drain_coordinates = [ + (x0_base + (j + 0.5) * delr, y1_base - 14.5 * delc) for j in range(9, ncol) +] + +well_coordinates = [ + (x0_base + 9.5 * delr, y1_base - 10.5 * delc), + (x0_base + 4.5 * delr, y1_base - 12.5 * delc), +] +wellq = ( + -75000.0, + -100000.0, +) +well_layers = ( + 0, + 2, +) + + +def build_dis(gwf): + return flopy.mf6.ModflowGwfdis( + gwf, + length_units="FEET", + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + ) + + +def get_gridgen_ws(ws): + gridgen_ws = ws / "gridgen" + gridgen_ws.mkdir(parents=True, exist_ok=True) + return gridgen_ws + + +def get_dis_name(name): + return name.replace("disv", "dis").replace("disu", "dis") + + +def build_temp_gwf(ws): + gridgen_ws = get_gridgen_ws(ws) + gridgen_sim = flopy.mf6.MFSimulation( + sim_name="gridgen", sim_ws=gridgen_ws, exe_name="mf6" + ) + gridgen_gwf = flopy.mf6.ModflowGwf(gridgen_sim, modelname="gridgen") + return gridgen_gwf + + +def build_disv(ws, gwf, gridgen): + temp_gwf = build_temp_gwf(ws) + dis = build_dis(temp_gwf) + g = Gridgen( + temp_gwf.modelgrid, + model_ws=get_gridgen_ws(ws), + exe_name=gridgen, + ) + g.build() + gridprops = g.get_gridprops_disv() + gridprops["top"] = top + gridprops["botm"] = botm + return flopy.mf6.ModflowGwfdisv( + gwf, + length_units="FEET", + **gridprops, + ) + + +def build_disu(ws, gwf, gridgen): + temp_gwf = build_temp_gwf(ws) + dis = build_dis(temp_gwf) + g = Gridgen( + temp_gwf.modelgrid, + model_ws=get_gridgen_ws(ws), + exe_name=gridgen, + ) + g.build() + gridprops = g.get_gridprops_disu6() + return flopy.mf6.ModflowGwfdisu( + gwf, + length_units="FEET", + **gridprops, + ) + + +def get_node_number(modelgrid, cellid): + if modelgrid.grid_type == "unstructured": + node = cellid + elif modelgrid.grid_type == "vertex": + node = modelgrid.ncpl * cellid[0] + cellid[1] + else: + node = ( + modelgrid.nrow * modelgrid.ncol * cellid[0] + + modelgrid.ncol * cellid[1] + + cellid[2] + ) + return node + + +def build_3d_array(modelgrid, values, dtype=float): + if isinstance(values, dtype): + arr = np.full(modelgrid.nnodes, values, dtype=dtype) + else: + arr = np.zeros(modelgrid.nnodes, dtype=dtype) + ia = [] + x0, x1, y0, y1 = modelgrid.extent + for k in range(nlay): + cellid = modelgrid.intersect(x0 + 0.1, y1 - 0.1, z=z_node[k]) + ia.append(get_node_number(modelgrid, cellid)) + ia.append(modelgrid.nnodes + 1) + for k in range(nlay): + arr[ia[k] : ia[k + 1]] = values[k] + return arr.reshape(modelgrid.shape) + + +def build_chd_data( + modelgrid, + coordinates, + head, + layer_number=0, + boundname="canal", +): + chd_spd = [] + for x, y in coordinates: + cellid = modelgrid.intersect(x, y, z=z_node[layer_number]) + if isinstance(cellid, int): + cellid = (cellid,) + chd_spd.append((cellid, head, concentration, boundname)) + return {0: chd_spd} + + +def build_riv_data(modelgrid): + cond = 20.0 * 10 * delc / 1.0 + spd = [] + for x, y in river_coordinates: + cellid = modelgrid.intersect(x, y, z=z_node[0]) + if isinstance(cellid, int): + cellid = (cellid,) + spd.append((*cellid, river_head, cond, 317.0, concentration, "river")) + return {0: spd} + + +def build_drn_data(modelgrid, boundname="drain"): + cond = 100000.0 + drain_elev = 322.5 + spd = [] + for x, y in drain_coordinates: + cellid = modelgrid.intersect(x, y, z=z_node[0]) + if isinstance(cellid, int): + cellid = (cellid,) + spd.append((*cellid, drain_elev, cond, concentration, boundname)) + return {0: spd} + + +def build_well_data(modelgrid, nper): + spd_dict = {} + for iper in range(nper): + if iper > 1: + continue + if iper == 0: + iend = 1 + else: + iend = 2 + spd = [] + for i, (x, y) in enumerate(well_coordinates[:iend]): + cellid = modelgrid.intersect(x, y, z=z_node[well_layers[i]]) + if isinstance(cellid, int): + cellid = (cellid,) + spd.append((*cellid, wellq[i], concentration, f"well-{i+1}")) + spd_dict[iper] = spd + return spd_dict + + +def build_rch_package(gwf, list_recharge): + if list_recharge: + spd = [] + for i in range(nrow): + y = y1_base - delr * (i + 0.5) + for j in range(ncol): + x = delc * (j + 0.5) + cellid = gwf.modelgrid.intersect(x, y, z=z_node[0]) + if isinstance(cellid, int): + cellid = (cellid,) + spd.append((*cellid, rch_rate, concentration, "recharge")) + rch = flopy.mf6.ModflowGwfrch( + gwf, + auxiliary=["concentration"], + boundnames=True, + stress_period_data=spd, + ) + else: + rch = flopy.mf6.ModflowGwfrcha(gwf, recharge=rch_rate) + return rch + + +def build_models(idx, test): + gridgen = try_get_target(test.targets, "gridgen") + return build_mf6(idx, test.workspace, gridgen), build_mf6( + idx, test.workspace / "mf6", gridgen + ) + + +# build MODFLOW 6 files +def build_mf6(idx, ws, gridgen): + if ws.name == "mf6": + dis_type = "dis" + elif "disv" in str(ws): + dis_type = "disv" + elif "disu" in str(ws): + dis_type = "disu" + else: + raise ValueError(f"Invalid discretization type in {str(ws)}") + + if "disu" in str(ws): + list_recharge = True + else: + list_recharge = False + + name = cases[idx] + if dis_type == "dis": + name = get_dis_name(name) + sim_name = name[0:3] + + sim = flopy.mf6.MFSimulation( + sim_name=sim_name, + version="mf6", + exe_name="mf6", + sim_ws=ws, + ) + # create tdis package + if "ps2e" in name: + nper = 3 + perioddata = ( + (300000.0, 1, 1.0), + (36500.0, 10, 1.5), + (300000.0, 1, 1.0), + ) + + else: + nper = 1 + perioddata = ((1.0, 1, 1.0),) + + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=nper, + perioddata=perioddata, + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="simple", + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=sim_name, + print_input=True, + print_flows=True, + save_flows=True, + ) + + if dis_type == "disv": + dis = build_disv(ws, gwf, gridgen) + elif dis_type == "disu": + dis = build_disu(ws, gwf, gridgen) + else: + dis = build_dis(gwf) + + # initial conditions + if dis_type == "disu": + strt = top + else: + strt = [top, top, top] + ic = flopy.mf6.ModflowGwfic( + gwf, + strt=strt, + ) + + if dis_type in ("dis", "disv"): + k11 = hk + k33 = vk + icelltype = [1, 0, 0] + else: + k11 = build_3d_array(gwf.modelgrid, hk) + k33 = build_3d_array(gwf.modelgrid, vk) + icelltype = build_3d_array(gwf.modelgrid, [1, 0, 0], dtype=int) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + icelltype=icelltype, + k=k11, + k33=k33, + ) + + if nper > 1: + sto = flopy.mf6.ModflowGwfsto( + gwf, + ss=0.0001, + sy=0.1, + iconvert=1, + steady_state={0: True, 2: True}, + transient={1: True}, + ) + + # canal chd + if name.startswith("ps1"): + canal_chd = flopy.mf6.ModflowGwfchd( + gwf, + auxiliary=["concentration"], + boundnames=True, + filename=f"{name}.canal.chd", + pname="canal", + stress_period_data=build_chd_data( + gwf.modelgrid, + canal_coordinates, + canal_head, + boundname="canal", + ), + ) + + if name.startswith("ps1") or name.startswith("ps2a"): + river_chd = flopy.mf6.ModflowGwfchd( + gwf, + auxiliary=["concentration"], + boundnames=True, + filename=f"{name}.river.chd", + pname="river", + stress_period_data=build_chd_data( + gwf.modelgrid, + river_coordinates, + river_head, + boundname="river", + ), + ) + else: + river_riv = flopy.mf6.ModflowGwfriv( + gwf, + auxiliary=["concentration"], + boundnames=True, + pname="river", + stress_period_data=build_riv_data( + gwf.modelgrid, + ), + ) + + if name.startswith("ps2"): + rch = build_rch_package(gwf, list_recharge) + + if "ps2c" in name or "ps2d" in name or "ps2e" in name: + if "ps2c1" in name: + ghb = flopy.mf6.ModflowGwfghb( + gwf, + auxiliary=["concentration"], + boundnames=True, + stress_period_data=build_drn_data( + gwf.modelgrid, + boundname="ghb-1", + ), + ) + else: + drn = flopy.mf6.ModflowGwfdrn( + gwf, + auxiliary=["concentration"], + boundnames=True, + stress_period_data=build_drn_data(gwf.modelgrid), + ) + + if "ps2d" in name or "ps2e" in name: + wel = flopy.mf6.ModflowGwfwel( + gwf, + auxiliary=["concentration"], + boundnames=True, + stress_period_data=build_well_data(gwf.modelgrid, nper=nper), + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{sim_name}.cbc", + head_filerecord=f"{sim_name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + return sim + + +def check_output(idx, test): + name = cases[idx] + sim_name = name[0:3] + ws = pl.Path(test.workspace) + + if name.startswith("ps1"): + row_values = np.array( + [ + 330.000, + 329.259, + 328.600, + 328.008, + 327.473, + 326.983, + 326.529, + 326.102, + 325.694, + 325.297, + 324.903, + 324.504, + 324.092, + 323.659, + 323.195, + 322.691, + 322.133, + 321.510, + 320.805, + 320.000, + ] + ) + elif name.startswith("ps2a"): + row_values = np.array( + [ + 346.054, + 345.979, + 345.828, + 345.598, + 345.286, + 344.886, + 344.391, + 343.792, + 343.079, + 342.238, + 341.251, + 340.099, + 338.755, + 337.189, + 335.362, + 333.224, + 330.714, + 327.750, + 324.227, + 320.000, + ] + ) + elif name.startswith("ps2b"): + row_values = np.array( + [ + 346.268, + 346.193, + 346.042, + 345.813, + 345.500, + 345.100, + 344.606, + 344.008, + 343.295, + 342.454, + 341.468, + 340.316, + 338.974, + 337.410, + 335.584, + 333.449, + 330.943, + 327.984, + 324.468, + 320.250, + ] + ) + else: + row_values = None + if row_values is None: + answer = None + else: + answer = np.zeros(shape2d) + for i in range(nrow): + answer[i, :] = row_values[:] + + # get disv or disu simulation + sim_base = flopy.mf6.MFSimulation.load(sim_name=sim_name, sim_ws=ws) + gwf_base = sim_base.get_model() + + head = gwf_base.output.head().get_data().flatten().reshape(shape3d) + if answer is not None: + assert np.allclose( + head[0], answer + ), "head data for first layer does not match know result" + + extension = "cbc" + fpth0 = ws / f"{sim_name}.{extension}" + # fpth1 = ws / f"mf6/{get_dis_name(name)}.{extension}" + fpth1 = ws / f"mf6/{sim_name}.{extension}" + test._compare_budget_files(extension, fpth0, fpth1) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + verbose=False, + ) + test.run() diff --git a/autotest/test_gwf_multimvr.py b/autotest/test_gwf_multimvr.py index 9fddf576be0..f85ce24ce7f 100644 --- a/autotest/test_gwf_multimvr.py +++ b/autotest/test_gwf_multimvr.py @@ -5,10 +5,10 @@ import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation -mvr_scens = ["mltmvr", "mltmvr5050", "mltmvr7525"] +cases = ["mltmvr", "mltmvr5050", "mltmvr7525"] sim_workspaces = [] gwf_names = [] @@ -837,7 +837,8 @@ def add_parent_sfr(gwf, gwfname, conns): print_flows=True, mover=True, pname="SFR-parent", - unit_conversion=86400.00, + length_conversion=1.0, + time_conversion=86400.0, boundnames=False, nreaches=len(conns), packagedata=pkdat, @@ -857,7 +858,8 @@ def add_child_sfr(gwfc, gwfnamec): print_flows=True, mover=True, pname="SFR-child", - unit_conversion=86400.00, + length_conversion=1.0, + time_conversion=86400.0, boundnames=False, nreaches=len(connsc), packagedata=pkdatc, @@ -970,17 +972,16 @@ def add_sim_mvr(sim, gwfname, gwfnamec, remaining_frac=None): ) -def build_model(idx, sim_ws): - +def build_models(idx, test): scen_nm, conns, frac = ( - mvr_scens[idx], + cases[idx], scen_conns[idx], parent_mvr_frac[idx], ) scen_nm_parent = "gwf_" + scen_nm + "_p" scen_nm_child = "gwf_" + scen_nm + "_c" sim, gwf, gwfc = instantiate_base_simulation( - sim_ws, scen_nm_parent, scen_nm_child + test.workspace, scen_nm_parent, scen_nm_child ) # add the sfr packages add_parent_sfr(gwf, scen_nm_parent, conns) @@ -996,9 +997,7 @@ def build_model(idx, sim_ws): return sim, None -def check_simulation_output(sim): - idx = sim.idxsim - +def check_output(idx, test): gwf_srch_str1 = ( " SFR-PARENT PACKAGE - SUMMARY OF FLOWS FOR EACH CONTROL VOLUME" ) @@ -1006,8 +1005,8 @@ def check_simulation_output(sim): sim_srch_str = " WATER MOVER PACKAGE (MVR) FLOW RATES " # cur_ws, gwfparent = ex[idx], gwf_names[idx] - cur_ws = sim.simpath - gwfparent = "gwf_" + mvr_scens[idx] + "_p" + cur_ws = test.workspace + gwfparent = "gwf_" + cases[idx] + "_p" with open(os.path.join(cur_ws, gwfparent + ".lst"), "r") as gwf_lst, open( os.path.join(cur_ws, "mfsim.lst"), "r" ) as sim_lst: @@ -1068,9 +1067,13 @@ def check_simulation_output(sim): # - 50/50: ~107 units of flow in each # - 75/25: 75% goes through the gwf mvr, 25% through the simulation mvr q_target = 214.25 - assert math.isclose(parent_sfr_last_reach_flow, q_target, rel_tol=0.1,), ( + assert math.isclose( + parent_sfr_last_reach_flow, + q_target, + rel_tol=0.1, + ), ( "Flow in the last reach of scenario " - + mvr_scens[idx] + + cases[idx] + " = " + str(parent_sfr_last_reach_flow) + ", whereas the target flow " @@ -1114,19 +1117,13 @@ def check_simulation_output(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(mvr_scens)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=check_simulation_output, - idxsim=idx, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_mvr01.py b/autotest/test_gwf_mvr01.py index 8ba4f45b1e1..0913dbc40c2 100644 --- a/autotest/test_gwf_mvr01.py +++ b/autotest/test_gwf_mvr01.py @@ -3,19 +3,19 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation name = "gwf_mvr01" -ex = [name] +cases = [name] -def build_model(idx, dir): +def build_models(idx, test): # static model data # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) # spatial discretization data @@ -36,7 +36,7 @@ def build_model(idx, dir): # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=str(dir) + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -372,11 +372,9 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # mvr budget terms - fpth = os.path.join(sim.simpath, "gwf_mvr01.mvr.bud") + fpth = os.path.join(test.workspace, "gwf_mvr01.mvr.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") times = bobj.get_times() records = bobj.get_data(totim=times[-1]) @@ -446,17 +444,13 @@ def eval_model(sim): assert records[24].shape == (0,) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_newton01.py b/autotest/test_gwf_newton01.py index 60c83c8f768..e184e92da20 100644 --- a/autotest/test_gwf_newton01.py +++ b/autotest/test_gwf_newton01.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["newton01"] +cases = ["newton01"] nlay = 2 nrow, ncol = 3, 3 top = 20 @@ -22,7 +22,7 @@ obs_recarray = {oname: [("h1", "HEAD", (0, 1, 1)), ("h2", "HEAD", (1, 1, 1))]} -def build_model(idx, ws): +def build_models(idx, test): c6 = [] for loc in chdloc: c6.append([loc, chd]) @@ -31,11 +31,11 @@ def build_model(idx, ws): nper = 1 tdis_rc = [(1.0, 1, 1.0)] - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package flopy.mf6.ModflowTdis( @@ -97,9 +97,8 @@ def build_model(idx, ws): return sim, None -def eval_head(sim): - print("evaluating heads...") - fpth = os.path.join(sim.simpath, oname) +def check_output(idx, test): + fpth = os.path.join(test.workspace, oname) v = np.genfromtxt(fpth, delimiter=",", names=True) msg = f"head in layer 1 != 8. ({v['H1']})" @@ -109,12 +108,13 @@ def eval_head(sim): assert np.allclose(v["H2"], 7.0), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run(TestSimulation(name=name, exe_dict=targets, exfunc=eval_head), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_newton_under_relaxation.py b/autotest/test_gwf_newton_under_relaxation.py new file mode 100644 index 00000000000..9fedb1875a8 --- /dev/null +++ b/autotest/test_gwf_newton_under_relaxation.py @@ -0,0 +1,135 @@ +import pathlib as pl + +import flopy +import numpy as np +import pytest + +from conftest import project_root_path +from framework import TestFramework + +cases = ["nr_ur01", "nr_ur02"] +data_path = project_root_path / "autotest/data/ex-gwf-bump/" +nper = 1 +nlay = 1 +nrow = 51 +ncol = 51 +xlen = 100.0 +ylen = 100.0 +top = 25.0 +k11 = 1.0 +H1 = 7.5 +H2 = 2.5 +delr = xlen / float(ncol) +delc = ylen / float(nrow) +extents = (0, xlen, 0, ylen) +shape2d = (nrow, ncol) +shape3d = (nlay, nrow, ncol) +nouter = 50 +ninner = 100 +hclose = 1e-9 +hclose_outer = hclose * 10.0 +rclose = 1e-3 +botm = np.loadtxt(data_path / "bottom.txt").reshape(shape3d) +chd_spd = [[0, i, 0, H1] for i in range(nrow)] +chd_spd += [[0, i, ncol - 1, H2] for i in range(nrow)] +base_heads = flopy.utils.HeadFile(data_path / "results.hds.cmp").get_data() + + +def build_models(idx, test): + name = cases[idx] + if idx == 1: + sim_ws = pl.Path(f"{test.workspace}/working") + else: + sim_ws = test.workspace + sim = flopy.mf6.MFSimulation( + sim_name=name, + sim_ws=str(sim_ws), + exe_name="mf6", + ) + flopy.mf6.ModflowTdis(sim, nper=nper) + linear_acceleration = "bicgstab" + newtonoptions = "newton under_relaxation" + + flopy.mf6.ModflowIms( + sim, + print_option="ALL", + linear_acceleration=linear_acceleration, + outer_maximum=nouter, + outer_dvclose=hclose_outer, + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + ) + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=name, + newtonoptions=newtonoptions, + ) + flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=1, + ) + flopy.mf6.ModflowGwfnpf( + gwf, + icelltype=1, + k=k11, + ) + flopy.mf6.ModflowGwfic(gwf, strt=H1) + flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd) + + head_filerecord = f"{name}.hds" + flopy.mf6.ModflowGwfoc( + gwf, + head_filerecord=head_filerecord, + saverecord=[("HEAD", "ALL")], + ) + + if idx == 1: + sim.write_simulation(silent=True) + mfsplit = flopy.mf6.utils.Mf6Splitter(sim) + split_array = np.tri(nrow, ncol).astype(int) + new_sim = mfsplit.split_model(split_array) + new_sim.set_sim_path(test.workspace) + mfsplit.save_node_mapping(pl.Path(f"{test.workspace}/mapping.json")) + return new_sim, None + else: + return sim, None + + +def check_output(idx, test): + mf6sim = flopy.mf6.MFSimulation.load(sim_ws=test.workspace) + if idx == 1: + mfsplit = flopy.mf6.utils.Mf6Splitter(mf6sim) + mfsplit.load_node_mapping( + mf6sim, pl.Path(f"{test.workspace}/mapping.json") + ) + head_dict = {} + for modelname in mf6sim.model_names: + mnum = int(modelname.split("_")[-1]) + head_dict[mnum] = ( + mf6sim.get_model(modelname).output.head().get_data() + ) + heads = mfsplit.reconstruct_array(head_dict) + else: + heads = mf6sim.get_model().output.head().get_data() + msg = "head comparison failed" + assert np.allclose(base_heads, heads), msg + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_noptc01.py b/autotest/test_gwf_noptc01.py index d32c04fdecb..19be84d2512 100644 --- a/autotest/test_gwf_noptc01.py +++ b/autotest/test_gwf_noptc01.py @@ -2,12 +2,12 @@ import flopy import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_noptc01", "gwf_noptc02", "gwf_noptc03"] +cases = ["gwf_noptc01", "gwf_noptc02", "gwf_noptc03"] no_ptcrecords = ["FIRST", "ALL", None] -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] # static model data # temporal discretization @@ -49,7 +49,7 @@ def get_model(idx, dir, no_ptcrecord): - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files ws = dir @@ -123,22 +123,22 @@ def get_model(idx, dir, no_ptcrecord): # water table recharge problem -def build_model(idx, dir): - sim = get_model(idx, dir, no_ptcrecords[idx]) +def build_models(idx, test): + sim = get_model(idx, test.workspace, no_ptcrecords[idx]) # build MODFLOW-6 without no_ptc option - pth = os.path.join(dir, "mf6") + pth = os.path.join(test.workspace, "mf6") mc = get_model(idx, pth, None) return sim, mc -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run(TestSimulation(name=name, exe_dict=targets, idxsim=idx), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_npf01_75x75.py b/autotest/test_gwf_npf01_75x75.py index e976784b582..505059079ed 100644 --- a/autotest/test_gwf_npf01_75x75.py +++ b/autotest/test_gwf_npf01_75x75.py @@ -3,17 +3,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["npf01a_75x75", "npf01b_75x75"] +cases = ["npf01a_75x75", "npf01b_75x75"] top = [100.0, 0.0] laytyp = [1, 0] ss = [0.0, 1.0e-4] sy = [0.1, 0.0] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 75, 75 nper = 3 perlen = [1.0, 1000.0, 1.0] @@ -54,10 +54,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -132,7 +132,7 @@ def build_model(idx, dir): gwf, print_input=True, print_flows=True, - maxbound=len(ws), + maxbound=len(str(ws)), stress_period_data=wd6, save_flows=False, ) @@ -148,8 +148,8 @@ def build_model(idx, dir): ) # build MODFLOW-2005 files - ws = os.path.join(dir, "mf2005") - mc = flopy.modflow.Modflow(name, model_ws=ws) + ws = os.path.join(test.workspace, "mf2005") + mc = flopy.modflow.Modflow(name, model_ws=ws, exe_name=test.targets["mf2005"]) dis = flopy.modflow.ModflowDis( mc, nlay=nlay, @@ -190,12 +190,12 @@ def build_model(idx, dir): return sim, mc -# - No need to change any code below -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run(TestSimulation(name=name, exe_dict=targets), str(function_tmpdir)) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_npf02_rewet.py b/autotest/test_gwf_npf02_rewet.py index 96eb0e8d4ab..ad448eb8e24 100644 --- a/autotest/test_gwf_npf02_rewet.py +++ b/autotest/test_gwf_npf02_rewet.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["npf02_hreweta", "npf02_hrewetb", "npf02_hrewetc", "npf02_hrewetd"] +cases = ["npf02_hreweta", "npf02_hrewetb", "npf02_hrewetc", "npf02_hrewetd"] ncols = [[15], [10, 5], [15], [10, 5]] nlays = [1, 1, 3, 3] @@ -50,8 +50,8 @@ def get_local_data(idx): return ncolst, nmodels, mnames -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] nlay = nlays[idx] if nlay == 1: @@ -80,7 +80,7 @@ def build_model(idx, dir): cd6left[1] = c6left # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -207,9 +207,7 @@ def build_model(idx, dir): return sim, None -def eval_hds(sim): - print("evaluating rewet heads...") - +def check_output(idx, test): hdata01lay = [ [ 1.000000000000000000e02, @@ -283,7 +281,6 @@ def eval_hds(sim): ], ] - idx = sim.idxsim ncolst, nmodels, mnames = get_local_data(idx) nlay = nlays[idx] @@ -295,7 +292,7 @@ def eval_hds(sim): imid = int(nrow / 2) for j in range(nmodels): - fn = os.path.join(sim.simpath, f"{mnames[j]}.hds") + fn = os.path.join(test.workspace, f"{mnames[j]}.hds") hobj = flopy.utils.HeadFile(fn) times = hobj.get_times() ioff = 0 @@ -313,7 +310,7 @@ def eval_hds(sim): hval[n, ioff:i1] = ht.copy() # # save results if the know results change slightly - # fpth = os.path.join(sim.simpath, "results.dat") + # fpth = os.path.join(sim.workspace, "results.dat") # np.savetxt(fpth, hval, delimiter=",") # known results @@ -329,25 +326,21 @@ def eval_hds(sim): msg = f"maximum absolute maw head difference ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_hds, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf03_sfr.py b/autotest/test_gwf_npf03_sfr.py index d4490ea4146..3e19037b510 100644 --- a/autotest/test_gwf_npf03_sfr.py +++ b/autotest/test_gwf_npf03_sfr.py @@ -3,11 +3,11 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["npf03_sfra", "npf03_sfrb"] +cases = ["npf03_sfra", "npf03_sfrb"] fpth = str(project_root_path / "autotest" / "data" / "npf03_hk.ref") shape = (50, 108) hk = flopy.utils.Util2d.load_txt(shape, fpth, dtype=float, fmtin="(FREE)") @@ -30,7 +30,8 @@ hbndl = [12.0, 8.0] # sfr data -unit_conv = 1.0 +len_conv = 1.0 +time_conv = 1.0 slope = 1.2012012e-03 width = 20.0 bthick = 1.5 @@ -54,8 +55,8 @@ def get_local_data(idx): return ncolst, nmodels, mnames -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # set local data for this model ncolst, nmodels, mnames = get_local_data(idx) @@ -72,7 +73,7 @@ def build_model(idx, dir): cd6right = {0: c6right} # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, memory_print_option="all", @@ -270,7 +271,8 @@ def build_model(idx, dir): sfr = flopy.mf6.ModflowGwfsfr( gwf, - unit_conversion=unit_conv, + length_conversion=len_conv, + time_conversion=time_conv, print_stage=True, print_flows=True, package_convergence_filerecord=cnvgpth, @@ -334,9 +336,7 @@ def build_model(idx, dir): return sim, None -def eval_hds(sim): - print("evaluating mover test heads...") - +def check_output(idx, test): hdata = np.array( [ 1.200000000000000000e01, @@ -5743,7 +5743,6 @@ def eval_hds(sim): ) hdata = hdata.reshape((1, 50, 108)) - idx = sim.idxsim ncolst, nmodels, mnames = get_local_data(idx) # make single head array @@ -5754,7 +5753,7 @@ def eval_hds(sim): i0 = 0 for j in range(nmodels): - fn = os.path.join(sim.simpath, f"{mnames[j]}.hds") + fn = os.path.join(test.workspace, f"{mnames[j]}.hds") hobj = flopy.utils.HeadFile(fn) h = hobj.get_data() i1 = i0 + h.shape[2] @@ -5768,26 +5767,22 @@ def eval_hds(sim): msg = f"maximum absolute maw head difference ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_hds, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf04_spdis.py b/autotest/test_gwf_npf04_spdis.py index b771b1b4161..22577cccb91 100644 --- a/autotest/test_gwf_npf04_spdis.py +++ b/autotest/test_gwf_npf04_spdis.py @@ -1,11 +1,9 @@ """ -MODFLOW 6 Autotest Test the specific discharge calculation for an LGR-like simulation that has a parent model and a child model. The child model is inset into the parent model, but they both have the same resolution, so it is essentially a simple 3D grid. The child qx velocity should be the same as the qx velocity in the parent grid. The heads are also compared. - """ import os @@ -14,16 +12,15 @@ import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation -ex = ["npf04"] +cases = ["npf04"] namea = "a" nameb = "b" -def build_model(idx, dir): - +def build_models(idx, test): # grid properties nlay = 3 nrow = 6 @@ -46,12 +43,12 @@ def build_model(idx, dir): ncppl = [1, 1, 1] lgr = Lgr(nlay, nrow, ncol, delr, delc, top, botm, idomain, ncpp, ncppl) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files # create simulation sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package @@ -175,14 +172,12 @@ def qxqyqz(fname, nlay, nrow, ncol): return qx, qy, qz -def eval_mf6(sim): - print("evaluating head and qx in parent and child models...") - +def check_output(idx, test): # make sure parent head is same as child head in same column - fname = os.path.join(sim.simpath, f"{namea}.hds") + fname = os.path.join(test.workspace, f"{namea}.hds") hdobj = flopy.utils.HeadFile(fname) ha = hdobj.get_data() - fname = os.path.join(sim.simpath, f"{nameb}.hds") + fname = os.path.join(test.workspace, f"{nameb}.hds") hdobj = flopy.utils.HeadFile(fname) hb = hdobj.get_data() msg = f"Heads should be the same {ha[0, 1, 2]} {hb[0, 0, 0]}" @@ -190,17 +185,17 @@ def eval_mf6(sim): # make sure specific discharge is calculated correctly for child and # parent models (even though child model has same resolution as parent - fname = os.path.join(sim.simpath, f"{namea}.cbc") + fname = os.path.join(test.workspace, f"{namea}.cbc") nlaya, nrowa, ncola = ha.shape qxa, qya, qza = qxqyqz(fname, nlaya, nrowa, ncola) - fname = os.path.join(sim.simpath, f"{nameb}.cbc") + fname = os.path.join(test.workspace, f"{nameb}.cbc") nlayb, nrowb, ncolb = hb.shape qxb, qyb, qzb = qxqyqz(fname, nlayb, nrowb, ncolb) msg = f"qx should be the same {qxa[0, 2, 1]} {qxb[0, 0, 0]}" assert np.allclose(qxa[0, 2, 1], qxb[0, 0, 0]), msg - cbcpth = os.path.join(sim.simpath, f"{namea}.cbc") - grdpth = os.path.join(sim.simpath, f"{namea}.dis.grb") + cbcpth = os.path.join(test.workspace, f"{namea}.cbc") + grdpth = os.path.join(test.workspace, f"{namea}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(grdpth) cbb = flopy.utils.CellBudgetFile(cbcpth, precision="double") flow_ja_face = cbb.get_data(text="FLOW-JA-FACE") @@ -212,17 +207,13 @@ def eval_mf6(sim): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_mf6, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf05_anisotropy.py b/autotest/test_gwf_npf05_anisotropy.py index cb6e46e0272..221c086f41c 100644 --- a/autotest/test_gwf_npf05_anisotropy.py +++ b/autotest/test_gwf_npf05_anisotropy.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to make sure that NPF anisotropy ratio options are read and processed correctly. """ @@ -9,14 +8,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["npf05a"] +from framework import TestFramework +cases = ["npf05a"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 2, 1, 5 chdheads = [100.0] nper = len(chdheads) @@ -37,7 +35,7 @@ def build_model(idx, dir): name = "npf" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -125,9 +123,8 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - fpth = os.path.join(sim.simpath, "npf.hds") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "npf.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") heads = hobj.get_alldata() # answer was obtained from running problem without anistropy @@ -147,17 +144,13 @@ def eval_model(sim): assert np.allclose(heads.flatten(), answer) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_thickstrt.py b/autotest/test_gwf_npf_thickstrt.py index be92018ad1d..28d6362a48e 100644 --- a/autotest/test_gwf_npf_thickstrt.py +++ b/autotest/test_gwf_npf_thickstrt.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "gwf_npf_thickstrt01", # case 01 -- icelltype=0 "gwf_npf_thickstrt02", # case 02 -- icelltype=0, using thickstrt, but it has no effect "gwf_npf_thickstrt03", # case 03 -- icelltype=-1, using thickstrt and strt = 5. @@ -21,7 +21,8 @@ icelltype = [0, 0, -1, 1, -1, 0, -1, 1, -1] hfb_on = [False, False, False, False, False, True, True, True, True] -def build_model(idx, dir): + +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 6 nper = 1 perlen = [1.0] @@ -46,7 +47,7 @@ def build_model(idx, dir): name = "flow" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -101,11 +102,7 @@ def build_model(idx, dir): thickstrt_option = thickstrt[idx] ict = icelltype[idx] npf = flopy.mf6.ModflowGwfnpf( - gwf, - thickstrt=thickstrt_option, - icelltype=ict, - k=hk, - k33=hk + gwf, thickstrt=thickstrt_option, icelltype=ict, k=hk, k33=hk ) if hfb_on[idx]: @@ -113,7 +110,7 @@ def build_model(idx, dir): gwf, print_input=True, maxhfb=1, - stress_period_data=[((0, 0, 2), (0, 0, 3), 1.e-4)], + stress_period_data=[((0, 0, 2), (0, 0, 3), 1.0e-4)], ) # chd files @@ -139,12 +136,10 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): name = "flow" - fpth = os.path.join(sim.simpath, f"{name}.hds") + fpth = os.path.join(test.workspace, f"{name}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_data().flatten() @@ -157,60 +152,70 @@ def eval_model(sim): answer_confined_hfb = (6.0, 5.9998, 5.9996, 4.0004, 4.0002, 4.0) answer_confined_hfb = np.array(answer_confined_hfb) - answer_confined_thickstart_hfb = (6., 5.9996004, 5.9992008, 4.0007992, 4.0003996, 4.) + answer_confined_thickstart_hfb = ( + 6.0, + 5.9996004, + 5.9992008, + 4.0007992, + 4.0003996, + 4.0, + ) answer_confined_thickstart_hfb = np.array(answer_confined_thickstart_hfb) - answer_unconfined_hfb = (6., 5.99983342, 5.99966683, 4.00049971, 4.00024986, 4.) + answer_unconfined_hfb = ( + 6.0, + 5.99983342, + 5.99966683, + 4.00049971, + 4.00024986, + 4.0, + ) answer_unconfined_hfb = np.array(answer_unconfined_hfb) answer_dict = { - 0: answer_linear, - 1: answer_linear, - 2: answer_linear, - 3: answer_water_table, - 4: answer_water_table, + 0: answer_linear, + 1: answer_linear, + 2: answer_linear, + 3: answer_water_table, + 4: answer_water_table, 5: answer_confined_hfb, 6: answer_confined_thickstart_hfb, 7: answer_unconfined_hfb, 8: answer_unconfined_hfb, } - hres = answer_dict[sim.idxsim] + hres = answer_dict[idx] assert np.allclose( hres, head ), "simulated head do not match with known solution." - fpth = os.path.join(sim.simpath, f"{name}.cbc") + fpth = os.path.join(test.workspace, f"{name}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") - q_simulated_inflow = cobj.get_data(idx=1)[0]['q'][0] + q_simulated_inflow = cobj.get_data(idx=1)[0]["q"][0] q_answer_dict = { - 0: 4., - 1: 4., - 2: 2., + 0: 4.0, + 1: 4.0, + 2: 2.0, 3: 1.9965396769631871, 4: 1.9965396769631871, - 5: 1.9990E-03, - 6: 1.9980E-03, - 7: 9.9949E-04, - 8: 9.9949E-04, + 5: 1.9990e-03, + 6: 1.9980e-03, + 7: 9.9949e-04, + 8: 9.9949e-04, } - q_answer = q_answer_dict[sim.idxsim] + q_answer = q_answer_dict[idx] assert np.allclose( q_answer, q_simulated_inflow ), "simulated flow does not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_tvk01.py b/autotest/test_gwf_npf_tvk01.py index f7791a3c6cc..530da8314c4 100644 --- a/autotest/test_gwf_npf_tvk01.py +++ b/autotest/test_gwf_npf_tvk01.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvk01"] +cases = ["tvk01"] time_varying_k = [1.0, 10.0] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 3, 3, 3 perlen = [100.0, 100.0] nper = len(perlen) @@ -31,10 +31,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -138,13 +138,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name # head - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_data() @@ -152,7 +150,7 @@ def eval_model(sim): assert False, f'could not load data from "{fpth}"' # budget - fpth = os.path.join(sim.simpath, f"{gwfname}.cbc") + fpth = os.path.join(test.workspace, f"{gwfname}.cbc") try: bobj = flopy.utils.CellBudgetFile(fpth, precision="double") bud_allspd = bobj.get_data(text="CHD") @@ -172,24 +170,18 @@ def eval_model(sim): print(f"Calculated q is {flow_rate_calc}") for node, node2, q in bud: print(node, node2, q, flow_rate_calc) - errmsg = f"Expected flow rate {flow_rate_calc} but found {q}" - assert np.isclose(flow_rate_calc, abs(q)) - - # comment when done testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, + assert np.isclose( + flow_rate_calc, abs(q) + ), f"Expected flow rate {flow_rate_calc} but found {q}" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_tvk02.py b/autotest/test_gwf_npf_tvk02.py index 48d30e65a0d..d0f36cdc7e2 100644 --- a/autotest/test_gwf_npf_tvk02.py +++ b/autotest/test_gwf_npf_tvk02.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvk02"] +cases = ["tvk02"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 3 perlen = [1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0] nper = len(perlen) @@ -32,10 +32,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -158,13 +158,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name # head - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata() @@ -193,29 +191,19 @@ def eval_model(sim): for kper, expected_result in enumerate(expected_results): h = head[kper, ex_lay - 1, ex_row - 1, ex_col - 1] - print(kper, h, expected_result) - - errmsg = ( - f"Expected head {expected_result} in period {kper} but found {h}" - ) - assert np.isclose(h, expected_result) - - # comment when done testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, + assert np.isclose( + h, expected_result + ), f"Expected head {expected_result} in period {kper} but found {h}" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_tvk03.py b/autotest/test_gwf_npf_tvk03.py index 226ee8bc932..99bb445f171 100644 --- a/autotest/test_gwf_npf_tvk03.py +++ b/autotest/test_gwf_npf_tvk03.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvk03"] +cases = ["tvk03"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 3, 1, 1 perlen = [1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0] nper = len(perlen) @@ -32,10 +32,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -158,13 +158,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name # head - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata() @@ -193,29 +191,19 @@ def eval_model(sim): for kper, expected_result in enumerate(expected_results): h = head[kper, ex_lay - 1, ex_row - 1, ex_col - 1] - print(kper, h, expected_result) - - errmsg = ( - f"Expected head {expected_result} in period {kper} but found {h}" - ) - assert np.isclose(h, expected_result) - - # comment when done testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, + assert np.isclose( + h, expected_result + ), f"Expected head {expected_result} in period {kper} but found {h}" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_tvk04.py b/autotest/test_gwf_npf_tvk04.py index 67b3c980c33..5168b42a643 100644 --- a/autotest/test_gwf_npf_tvk04.py +++ b/autotest/test_gwf_npf_tvk04.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvk05"] +cases = ["tvk05"] time_varying_k = [1.0, 10.0] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 3, 3, 3 perlen = [100.0, 100.0] nper = len(perlen) @@ -32,10 +32,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -155,13 +155,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # budget try: - fname = f"gwf_{sim.name}.lst" - ws = sim.simpath + fname = f"gwf_{test.name}.lst" + ws = test.workspace fname = os.path.join(ws, fname) lst = flopy.utils.Mf6ListBudget( fname, budgetkey="VOLUME BUDGET FOR ENTIRE MODEL" @@ -184,17 +182,13 @@ def eval_model(sim): assert 2.0 * sp_x[0][8] < sp_x[1][8], errmsg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_npf_tvk05.py b/autotest/test_gwf_npf_tvk05.py index 99059f5d9f0..d0347b7f913 100644 --- a/autotest/test_gwf_npf_tvk05.py +++ b/autotest/test_gwf_npf_tvk05.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvk05"] +cases = ["tvk05"] time_varying_k = [1.0, 10.0] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 3, 3 perlen = [100.0, 100.0] nper = len(perlen) @@ -32,10 +32,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -156,13 +156,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - +def check_output(idx, test): # budget try: - fname = f"gwf_{sim.name}.lst" - ws = sim.simpath + fname = f"gwf_{test.name}.lst" + ws = test.workspace fname = os.path.join(ws, fname) lst = flopy.utils.Mf6ListBudget( fname, budgetkey="VOLUME BUDGET FOR ENTIRE MODEL" @@ -185,17 +183,13 @@ def eval_model(sim): assert sp_x[0][8] == sp_x[1][8], errmsg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_obs01.py b/autotest/test_gwf_obs01.py index bcee2743b56..ac69e386f3d 100644 --- a/autotest/test_gwf_obs01.py +++ b/autotest/test_gwf_obs01.py @@ -3,11 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation cell_dimensions = (300,) -ex = [f"gwf_obs01{chr(ord('a') + idx)}" for idx in range(len(cell_dimensions))] +cases = [ + f"gwf_obs01{chr(ord('a') + idx)}" for idx in range(len(cell_dimensions)) +] h0, h1 = 1.0, 0.0 @@ -23,11 +25,11 @@ def get_obs(idx): for j in range(ncol): node = i * ncol + j + 1 obs_lst.append([node, "head", (0, i, j)]) - return {f"{ex[idx]}.gwf.obs.csv": obs_lst} + return {f"{cases[idx]}.gwf.obs.csv": obs_lst} -def get_obs_out(sim): - fpth = os.path.join(sim.simpath, f"{ex[sim.idxsim]}.gwf.obs.csv") +def get_obs_out(idx, test): + fpth = os.path.join(test.workspace, f"{cases[idx]}.gwf.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") return tc.view((float, len(tc.dtype.names)))[1:] @@ -42,7 +44,7 @@ def get_chd(idx): return {0: c} -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, cell_dimensions[idx], cell_dimensions[idx] nper = 1 perlen = [5.0] @@ -62,10 +64,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -136,26 +138,22 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model observations...") - hres = get_strt_array(sim.idxsim).flatten() - obs = get_obs_out(sim) - msg = "simulated head observations do not match with known solution." - assert np.allclose(hres, obs), msg +def check_output(idx, test): + hres = get_strt_array(idx).flatten() + obs = get_obs_out(idx, test) + assert np.allclose( + hres, obs + ), "simulated head observations do not match with known solution." @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_obs02.py b/autotest/test_gwf_obs02.py index bfef5b1a50e..4af6330f91a 100644 --- a/autotest/test_gwf_obs02.py +++ b/autotest/test_gwf_obs02.py @@ -7,16 +7,16 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation cell_dimensions = (300,) -ex = ["gwf_obs02"] +cases = ["gwf_obs02"] h0, h1 = 1.0, 0.0 nlay, nrow, ncol = 1, 10, 10 -def build_model(idx, dir): +def build_models(idx, test): nper = 1 perlen = [5.0] nstp = [1] @@ -35,10 +35,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -124,13 +124,12 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model observations...") +def check_output(idx, test): headcsv = np.empty((nlay, nrow, ncol), dtype=float) for i in range(nrow): - fname = f"{sim.name}.{i}.obs.csv" + fname = f"{test.name}.{i}.obs.csv" print(f"Loading and testing {fname}") - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) rec = np.genfromtxt(fname, names=True, delimiter=",", deletechars="") for j in range(ncol): obsname_true = f"h_{i}_{j}".upper() @@ -142,7 +141,7 @@ def eval_model(sim): assert obsname_true == obsname_found, errmsg headcsv[0, i, :] = np.array(rec.tolist()[1:]) - fn = os.path.join(sim.simpath, f"{sim.name}.hds") + fn = os.path.join(test.workspace, f"{test.name}.hds") hobj = flopy.utils.HeadFile(fn) headbin = hobj.get_data() @@ -151,17 +150,13 @@ def eval_model(sim): ), "headcsv not equal head from binary file" -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_pertim.py b/autotest/test_gwf_pertim.py index d3adcccc358..0e02c57ed43 100644 --- a/autotest/test_gwf_pertim.py +++ b/autotest/test_gwf_pertim.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "gwf_pertim", ] @@ -17,8 +17,8 @@ nstp = [1] tsmult = [1.0] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 3, 21, 20 @@ -38,11 +38,11 @@ river_spd = [(0, i, ncol - 1, 320.0, "river") for i in range(nrow)] -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -114,11 +114,8 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - - print("evaluating results...") - - fpth = os.path.join(sim.simpath, f"{sim.name}.lst") +def check_output(idx, test): + fpth = os.path.join(test.workspace, f"{test.name}.lst") mflist = flopy.utils.Mf6ListBudget(fpth) inc = mflist.get_incremental() @@ -133,20 +130,13 @@ def eval_model(sim): ), f"CHD2_OUT <> {q_out} ({q_out_sim})" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_model, - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ptc01.py b/autotest/test_gwf_ptc01.py index cf1737c3020..2e58b9c14da 100644 --- a/autotest/test_gwf_ptc01.py +++ b/autotest/test_gwf_ptc01.py @@ -8,13 +8,11 @@ import os import flopy -import numpy as np import pytest -from conftest import project_root_path + from framework import TestFramework -from simulation import TestSimulation -ex = ["ptc01"] +cases = ["ptc01"] # static model data # temporal discretization nper = 1 @@ -57,7 +55,7 @@ def build_mf6(idx, ws, storage=True): - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( @@ -128,28 +126,24 @@ def build_mf6(idx, ws, storage=True): saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], printrecord=[("HEAD", "LAST"), ("BUDGET", "ALL")], ) - + return sim -def build_model(idx, dir): - ws = dir +def build_models(idx, test): # build mf6 with storage package but steady state stress periods - sim = build_mf6(idx, ws, storage=True) - + sim = build_mf6(idx, test.workspace, storage=True) # build mf6 with no storage package - wsc = os.path.join(ws, "mf6") - mc = build_mf6(idx, wsc, storage=False) - + mc = build_mf6(idx, os.path.join(test.workspace, "mf6"), storage=False) return sim, mc -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run(TestSimulation(name=name, exe_dict=targets), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + ) + test.run() diff --git a/autotest/test_gwf_rch01.py b/autotest/test_gwf_rch01.py index 879739313f5..c3c1947538b 100644 --- a/autotest/test_gwf_rch01.py +++ b/autotest/test_gwf_rch01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to make sure that recharge is passed to the highest active layer and verify that recharge is in the highest active layer by looking at the individual budget terms. For this test, there are two layers and five @@ -13,15 +12,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["rch01a", "rch01b", "rch01c"] +cases = ["rch01a", "rch01b", "rch01c"] irch = [None, 0, [1, 1, 0, 1, 1]] -def build_model(idx, dir): - +def build_models(idx, test): nlay, nrow, ncol = 2, 1, 5 chdheads = [25.0] nper = len(chdheads) @@ -43,7 +41,7 @@ def build_model(idx, dir): name = "rch" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -121,10 +119,8 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - fpth = os.path.join(sim.simpath, "rch.cbc") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "rch.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="rch")[0] @@ -136,22 +132,18 @@ def eval_model(sim): assert np.allclose(records["node2"], answer["node2"]) assert np.allclose(records["q"], answer["q"]) - fpth = os.path.join(sim.simpath, "rch.hds") + fpth = os.path.join(test.workspace, "rch.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") heads = hobj.get_alldata() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_rch02.py b/autotest/test_gwf_rch02.py index e7aced8d6ff..3decd75cb36 100644 --- a/autotest/test_gwf_rch02.py +++ b/autotest/test_gwf_rch02.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to make sure that array based recharge is applied correctly when idomain is used to remove part of the grid. """ @@ -9,14 +8,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["rch02"] +from framework import TestFramework +cases = ["rch02"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 2, 4, 5 perlen = [1.0] nper = len(perlen) @@ -35,7 +33,7 @@ def build_model(idx, dir): name = "rch" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -110,10 +108,8 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - fpth = os.path.join(sim.simpath, "rch.cbc") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "rch.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="rch")[0] @@ -128,22 +124,18 @@ def eval_model(sim): errmsg = "node2 numbers must be the same as node." assert np.allclose(records["node2"], records["node"]), errmsg - fpth = os.path.join(sim.simpath, "rch.hds") + fpth = os.path.join(test.workspace, "rch.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") heads = hobj.get_alldata() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_rch03.py b/autotest/test_gwf_rch03.py index c853cd4eaef..e8e608e407c 100644 --- a/autotest/test_gwf_rch03.py +++ b/autotest/test_gwf_rch03.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to make sure that array based recharge is applied correctly when idomain is used with -1, 0, and 1 for top layer. """ @@ -9,14 +8,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["rch03"] +from framework import TestFramework +cases = ["rch03"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 2, 4, 5 perlen = [1.0] nper = len(perlen) @@ -35,7 +33,7 @@ def build_model(idx, dir): name = "rch" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -132,10 +130,8 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - fpth = os.path.join(sim.simpath, "rch.cbc") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "rch.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") records = bobj.get_data(text="rch")[0] @@ -154,22 +150,18 @@ def eval_model(sim): errmsg = f"rech q must be {answer}. found {records['q']}" assert np.allclose(records["q"], answer), errmsg - fpth = os.path.join(sim.simpath, "rch.hds") + fpth = os.path.join(test.workspace, "rch.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") heads = hobj.get_alldata() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_returncodes.py b/autotest/test_gwf_returncodes.py index 3eda6b7ef76..67aa6f44eb0 100644 --- a/autotest/test_gwf_returncodes.py +++ b/autotest/test_gwf_returncodes.py @@ -271,5 +271,5 @@ def compiler_argv(dir, exe): ), ) def test_main(fn, function_tmpdir, targets): - mf6 = targets.as_dict()["mf6"] + mf6 = targets["mf6"] eval(fn)(function_tmpdir, mf6) diff --git a/autotest/test_gwf_sfr_badfactor.py b/autotest/test_gwf_sfr_badfactor.py index 23677308164..f55eb08bc4d 100644 --- a/autotest/test_gwf_sfr_badfactor.py +++ b/autotest/test_gwf_sfr_badfactor.py @@ -1,16 +1,19 @@ import flopy import numpy as np +import pytest + +from framework import TestFramework paktest = "sfr" -testname = "ts_sfr01" +cases = ["ts_sfr01"] -def build_model(ws, exe, timeseries=False): +def build_models(idx, test, timeseries=False): # static model data # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) ts_times = np.arange(0.0, 2.0, 1.0, dtype=float) @@ -34,9 +37,9 @@ def build_model(ws, exe, timeseries=False): imsla = "BICGSTAB" # build MODFLOW 6 files - name = testname + name = cases[idx] sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -506,26 +509,29 @@ def build_model(ws, exe, timeseries=False): return sim -def test_mf6model(function_tmpdir, targets): - mf6 = targets.mf6 +def check_output(idx, test): + print("Running surfdep check") + with open(test.workspace / "mfsim.lst", "r") as f: + lines = f.readlines() + error_count = 0 + for line in lines: + if "cprior" and "divflow not within" in line: + error_count += 1 - # build and run the test model - sim = build_model(str(function_tmpdir), mf6) - sim.write_simulation() - sim.run_simulation() + # ensure that error msg is in mfsim.lst file + assert error_count == 1, ( + "error count = " + str(error_count) + "but should equal 1" + ) - # ensure that the error msg is contained in the mfsim.lst file - f = open(str(function_tmpdir / "mfsim.lst"), "r") - lines = f.readlines() - error_count = 0 - expected_msg = False - for line in lines: - if "cprior" and "divflow not within" in line: - expected_msg = True - error_count += 1 - assert error_count == 1, ( - "error count = " + str(error_count) + "but should equal 1" +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + xfail=True, ) - - print("Finished running surfdep check") + test.run() diff --git a/autotest/test_gwf_sfr_diversion.py b/autotest/test_gwf_sfr_diversion.py new file mode 100644 index 00000000000..4ca34d74bd0 --- /dev/null +++ b/autotest/test_gwf_sfr_diversion.py @@ -0,0 +1,179 @@ +import os + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["sfr_div"] +inflows = np.array([10, 0, 10, 0, 10]) +diversion = np.array([0.5, 0.5, 0.5, 0.5, 0.0]) + + +def build_models(idx, test): + # static model data + # temporal discretization + nper = len(inflows) + tdis_rc = [ + (1.0, 1, 1.0), + ] * nper + + # spatial discretization data + nlay, nrow, ncol = 1, 1, 1 + delr, delc = 100.0, 100.0 + top = 0.0 + botm = -10.0 + strt = 0.0 + + # build MODFLOW 6 files + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=test.workspace, + ) + sim.simulation_data.verify_data = False + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="days", + nper=nper, + perioddata=tdis_rc, + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=name, + ) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + icelltype=0, + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, budget_filerecord=name + ".cbb", saverecord=[["BUDGET", "ALL"]] + ) + + # sfr file + cellid = (0, 0, 0) + nreaches = 3 + rlen = 10.0 + rwid = 10.0 + roughness = 0.001 + rbth = 1.0 + rhk = 0.0 + slope = 0.001 + + sfrrch_prop = [cellid, rlen, rwid, slope, top, rbth, rhk, roughness] + packagedata = [ + [ + 0, + ] + + sfrrch_prop + + [2, 1.0, 1], + [ + 1, + ] + + sfrrch_prop + + [1, 0.0, 0], + [ + 2, + ] + + sfrrch_prop + + [1, 1.0, 0], + ] + connectiondata = [ + [0, -1, -2], + [1, 0], + [2, 0], + ] + diversiondata = [ + [0, 0, 1, "FRACTION"], + ] + perioddata = { + i: [[0, "inflow", qin], [0, "diversion", 0, qdiv]] + for i, (qin, qdiv) in enumerate(zip(inflows, diversion)) + } + + sfr = flopy.mf6.ModflowGwfsfr( + gwf, + print_stage=True, + print_flows=True, + print_input=True, + budgetcsv_filerecord=name + ".sfr.csv", + budget_filerecord=name + ".sfr.cbb", + nreaches=nreaches, + packagedata=packagedata, + connectiondata=connectiondata, + diversions=diversiondata, + perioddata=perioddata, + pname="sfr-1", + ) + + return sim, None + + +def check_output(idx, test): + # check flow for indivdual reach + fname = os.path.join(test.workspace, f"{test.name}.sfr.cbb") + with flopy.utils.CellBudgetFile(fname) as cbb: + outflows = cbb.get_data(text="EXT-OUTFLOW") + + # check outflow for reach 2 and 3 + assert np.allclose( + [r.q[1] for r in outflows], -inflows * diversion + ), "Incorrect outflow for diversion reach" + assert np.allclose( + [r.q[2] for r in outflows], -inflows * (1 - diversion) + ), "Incorrect outflow for outlet reach" + + # load SFR budget CSV and check overall budget + with open(fname.replace(".cbb", ".csv")) as f: + header = f.readline().strip().split(",") + flux = np.loadtxt(f, delimiter=",") + + assert np.allclose( + flux[:, header.index("EXT-OUTFLOW_IN")], 0 + ), "External flow IN larger than zero" + assert np.allclose( + flux[:, header.index("PERCENT_DIFFERENCE")], 0 + ), "Large mass balance error in SFR" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwf_sfr_evap.py b/autotest/test_gwf_sfr_evap.py index 2e9646680bc..3b820d6b101 100644 --- a/autotest/test_gwf_sfr_evap.py +++ b/autotest/test_gwf_sfr_evap.py @@ -1,14 +1,16 @@ -# Test evap in SFR reaches (no interaction with gwf) +""" +Test evap in SFR reaches (no interaction with gwf) +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["sfr-evap"] +cases = ["sfr-evap"] # Model units @@ -65,15 +67,11 @@ nouter, ninner = 1000, 300 hclose, rclose, relax = 1e-3, 1e-4, 0.97 -# -# MODFLOW 6 flopy GWF object -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -265,7 +263,8 @@ def build_model(idx, dir): print_stage=True, print_flows=True, print_input=True, - unit_conversion=1.0 * 86400, + length_conversion=1.0, + time_conversion=86400.0, budget_filerecord=budpth, mover=False, nreaches=nreaches, @@ -362,7 +361,8 @@ def build_model(idx, dir): print_stage=True, print_flows=True, print_input=True, - unit_conversion=1.0 * 86400, + length_conversion=1.0, + time_conversion=86400.0, budget_filerecord=budpth, mover=False, nreaches=nreaches, @@ -376,16 +376,14 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname_t = "gwf-" + name + "-t" gwfname_r = "gwf-" + name + "-r" fname = gwfname_t + ".sfr.cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) sfrobj = flopy.utils.binaryfile.CellBudgetFile(fname, precision="double") @@ -414,7 +412,7 @@ def eval_results(sim): # Now check results from standard rectangular x-section setup (not an n-point channel) fname2 = gwfname_r + ".sfr.cbc" - fname2 = os.path.join(sim.simpath, fname2) + fname2 = os.path.join(test.workspace, fname2) assert os.path.isfile(fname2) sfrobj = flopy.utils.binaryfile.CellBudgetFile(fname2, precision="double") @@ -434,17 +432,13 @@ def eval_results(sim): assert np.allclose(stored_strm_evap_r, sim_evap_r, atol=1e-4), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sfr_gwf_conn.py b/autotest/test_gwf_sfr_gwf_conn.py new file mode 100644 index 00000000000..332eb29a59a --- /dev/null +++ b/autotest/test_gwf_sfr_gwf_conn.py @@ -0,0 +1,283 @@ +import os + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +paktest = "sfr" +cases = [ + "sfr_dis", + "sfr_dis_fail", + "sfr_dis_none", + "sfr_disv", + "sfr_disv_fail", + "sfr_disv_none", + "sfr_disu", + "sfr_disu_fail", + "sfr_disu_none", +] +dis_types = [ + "dis", + "dis", + "dis", + "disv", + "disv", + "disv", + "disu", + "disu", + "disu", +] + +# spatial discretization data +nlay, nrow, ncol = 1, 1, 1 +delr, delc = 100.0, 100.0 +top = 0.0 +botm = -10.0 +strt = 0.0 + +# spatial discretization data for disv and disu +vertices = [(0, 0.0, 0.0), (1, 0.0, delc), (2, delr, delc), (3, delr, 0.0)] +cell2d = [(0, delr / 2.0, delc / 2.0, 4, 0, 1, 2, 3)] + +# sfr data +nreaches = 10 +rlen = 10.0 +rwid = 10.0 +roughness = 0.001 +rbth = 1.0 +rhk = 0.0 +slope = 0.001 +ustrf = 1.0 +ndv = 0 + + +def build_model(idx, ws): + # static model data + # temporal discretization + nper = 1 + tdis_rc = [(11.0, 11, 1.0)] + ts_times = np.arange(0.0, 12.0, 1.0, dtype=float) + ts_flows = np.array([1000.0] + [float(q) for q in range(1000, -100, -100)]) + + # build MODFLOW 6 files + name = cases[idx] + dis_type = dis_types[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, + ) + sim.simulation_data.verify_data = False + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="seconds", + nper=nper, + perioddata=tdis_rc, + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + ) + + # create gwf model + gwf = flopy.mf6.ModflowGwf( + sim, + modelname=name, + ) + + if dis_type == "dis": + dis = flopy.mf6.ModflowGwfdis( + gwf, + length_units="meters", + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=1, + ) + elif dis_type == "disv": + dis = flopy.mf6.ModflowGwfdisv( + gwf, + length_units="meters", + nlay=nlay, + ncpl=1, + nvert=4, + vertices=vertices, + cell2d=cell2d, + top=top, + botm=botm, + idomain=1, + ) + else: + disukwargs = flopy.utils.gridutil.get_disu_kwargs( + nlay, + nrow, + ncol, + [delr], + [delc], + top, + [botm], + ) + dis = flopy.mf6.ModflowGwfdisu( + gwf, + vertices=vertices, + cell2d=cell2d, + **disukwargs, + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf(gwf) + + # chd files + # chd data + if dis_type == "dis": + spd = [ + [(0, 0, 0), 0.0], + ] + elif dis_type == "disv": + spd = [ + [(0, 0), 0.0], + ] + else: + spd = [ + [(0,), 0.0], + ] + + chd = flopy.mf6.modflow.ModflowGwfchd( + gwf, maxbound=1, stress_period_data=spd, pname="chd-1" + ) + + # sfr file + if dis_type == "dis": + if "fail" in name: + cellid = (2, 2, 2) + elif "none" in name: + cellid = "none" + else: + cellid = (-1, -1, -1) + elif dis_type == "disv": + if "fail" in name: + cellid = (2, 2) + elif "none" in name: + cellid = "none" + else: + cellid = (-1, -1) + else: + if "fail" in name: + cellid = (2,) + elif "none" in name: + cellid = "none" + else: + cellid = (-1,) + packagedata = [] + for irch in range(nreaches): + nconn = 1 + if 0 < irch < nreaches - 1: + nconn += 1 + rp = [ + irch, + cellid, + rlen, + rwid, + slope, + top, + rbth, + rhk, + roughness, + nconn, + ustrf, + ndv, + ] + packagedata.append(rp) + + if not str(ws).endswith("mf6"): + packagedata = packagedata[::-1] + + connectiondata = [] + inflow_loc = 0 + ioutflow_loc = nreaches - 1 + for irch in range(nreaches): + rc = [irch] + if irch > 0: + rc.append(irch - 1) + if irch < nreaches - 1: + rc.append(-(irch + 1)) + connectiondata.append(rc) + + ts_names = ["inflow"] + perioddata = [ + [inflow_loc, "inflow", "inflow"], + ] + ts_methods = ["linearend"] * len(ts_names) + ts_data = [] + for t, q in zip(ts_times, ts_flows): + ts_data.append((t, q)) + + sfr = flopy.mf6.ModflowGwfsfr( + gwf, + print_stage=True, + print_flows=True, + print_input=True, + mover=True, + nreaches=nreaches, + packagedata=packagedata, + connectiondata=connectiondata, + perioddata=perioddata, + pname="sfr-1", + ) + fname = f"{name}.sfr.ts" + sfr.ts.initialize( + filename=fname, + timeseries=ts_data, + time_series_namerecord=ts_names, + interpolation_methodrecord=ts_methods, + ) + fname = f"{name}.sfr.obs" + sfr_obs = { + f"{fname}.csv": [ + ("inflow", "ext-inflow", (inflow_loc,)), + ("outflow", "ext-outflow", (ioutflow_loc,)), + ] + } + sfr.obs.initialize(filename=fname, print_input=True, continuous=sfr_obs) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + printrecord=[ + ("BUDGET", "ALL"), + ], + ) + + return sim + + +def build_models(idx, test): + sim = build_model(idx, test.workspace) + return sim, None + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + compare=None, + xfail="fail" in name, + ) + test.run() diff --git a/autotest/test_gwf_sfr_npoint01.py b/autotest/test_gwf_sfr_npoint01.py index 7579e1b2025..7d654809633 100644 --- a/autotest/test_gwf_sfr_npoint01.py +++ b/autotest/test_gwf_sfr_npoint01.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from cross_section_functions import get_depths from framework import TestFramework -from simulation import TestSimulation paktest = "sfr" -ex = [ +cases = [ "sfr_npt01a", "sfr_npt01b", "sfr_npt01c", @@ -117,9 +117,7 @@ } -# -def build_model(idx, ws): - +def build_models(idx, test): xsect_type = xsect_types[idx] # static model data @@ -130,12 +128,12 @@ def build_model(idx, ws): ts_flows = np.array([1000.0] + [float(q) for q in range(1000, -100, -100)]) # build MODFLOW 6 files - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", - sim_ws=ws, + sim_ws=test.workspace, ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -299,10 +297,8 @@ def build_model(idx, ws): return sim, None -def eval_npointq(sim, idx): - print("evaluating n-point cross-section results..." f"({sim.name})") - - obs_pth = os.path.join(sim.simpath, f"{sim.name}.sfr.obs.csv") +def check_output(idx, test): + obs_pth = os.path.join(test.workspace, f"{test.name}.sfr.obs.csv") obs = flopy.utils.Mf6Obs(obs_pth).get_data() assert np.allclose( @@ -327,20 +323,13 @@ def eval_npointq(sim, idx): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=lambda s: eval_npointq(s, idx), - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sfr_npoint02.py b/autotest/test_gwf_sfr_npoint02.py index db51e9238da..ee987d1ae5d 100644 --- a/autotest/test_gwf_sfr_npoint02.py +++ b/autotest/test_gwf_sfr_npoint02.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation + from cross_section_functions import get_depths +from framework import TestFramework paktest = "sfr" -ex = [ +cases = [ "sfr_npt02a", ] @@ -53,15 +53,14 @@ def flow_to_depth_wide(rwid, q): return ((q * roughness) / (conversion_fact * rwid * np.sqrt(slope))) ** 0.6 -# -def build_model(idx, ws): +def build_models(idx, test): # build MODFLOW 6 files - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", - sim_ws=ws, + sim_ws=test.workspace, ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -209,11 +208,9 @@ def build_model(idx, ws): return sim, None -def eval_npointdepth(sim): - name = sim.name - print("evaluating n-point cross-section results..." f"({name})") - - obs_pth = os.path.join(sim.simpath, f"{name}.sfr.obs.csv") +def check_output(idx, test): + name = test.name + obs_pth = os.path.join(test.workspace, f"{name}.sfr.obs.csv") obs = flopy.utils.Mf6Obs(obs_pth).get_data() assert np.allclose( @@ -242,20 +239,13 @@ def eval_npointdepth(sim): ), "sfr depth not equal to calculated depth" -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_npointdepth, - idxsim=0, - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sfr_npoint03.py b/autotest/test_gwf_sfr_npoint03.py index d7ae482e611..00eaecdec3d 100644 --- a/autotest/test_gwf_sfr_npoint03.py +++ b/autotest/test_gwf_sfr_npoint03.py @@ -3,12 +3,12 @@ import flopy import numpy as np import pytest + from cross_section_functions import calculate_rectchan_mannings_discharge from framework import TestFramework -from simulation import TestSimulation paktest = "sfr" -ex = [ +cases = [ "sfr_npt03a", "sfr_npt03b", "sfr_npt03c", @@ -69,13 +69,13 @@ # x: 0 1/3 2/3 1 # -def build_model(idx, ws, base=False): +def build_model(idx, ws, base=False): if base: ws = os.path.join(ws, "mf6") # build MODFLOW 6 files - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -269,44 +269,39 @@ def build_model(idx, ws, base=False): return sim -def build_models(idx, ws): - sim = build_model(idx, ws) - mc = build_model(idx, ws, base=True) +def build_models(idx, test): + sim = build_model(idx, test.workspace) + mc = build_model(idx, test.workspace, base=True) return sim, mc -def eval_npointdepth(sim): - print("evaluating n-point cross-section results..." f"({sim.name})") - - obs_pth0 = os.path.join(sim.simpath, f"{sim.name}.sfr.obs.csv") +def check_output(idx, test): + obs_pth0 = os.path.join(test.workspace, f"{test.name}.sfr.obs.csv") obs0 = np.genfromtxt(obs_pth0, names=True, delimiter=",") - obs_pth1 = os.path.join(sim.simpath, "mf6", f"{sim.name}.sfr.obs.csv") + obs_pth1 = os.path.join(test.workspace, "mf6", f"{test.name}.sfr.obs.csv") obs1 = np.genfromtxt(obs_pth1, names=True, delimiter=",") q0 = obs0["OUTFLOW_DOWNSTREAM"] q1 = obs1["OUTFLOW_DOWNSTREAM"] - assert np.allclose(q0, q1), f"downstream outflows not equal ('{sim.name}')" + assert np.allclose( + q0, q1 + ), f"downstream outflows not equal ('{test.name}')" d0 = obs0["DEPTH_UPSTREAM"] d1 = obs1["DEPTH_UPSTREAM"] - assert np.allclose(d0, d1), f"upstream depths are not equal ('{sim.name}')" + assert np.allclose( + d0, d1 + ), f"upstream depths are not equal ('{test.name}')" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_models, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_npointdepth, - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sfr_reorder.py b/autotest/test_gwf_sfr_reorder.py index 2010b7a24cd..5aafcf3b7a4 100644 --- a/autotest/test_gwf_sfr_reorder.py +++ b/autotest/test_gwf_sfr_reorder.py @@ -3,11 +3,11 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation paktest = "sfr" -ex = ["sfr_reorder"] +cases = ["sfr_reorder"] # spatial discretization data nlay, nrow, ncol = 1, 1, 1 @@ -29,7 +29,6 @@ def build_model(idx, ws): - # static model data # temporal discretization nper = 1 @@ -38,7 +37,7 @@ def build_model(idx, ws): ts_flows = np.array([1000.0] + [float(q) for q in range(1000, -100, -100)]) # build MODFLOW 6 files - name = ex[idx] + name = cases[idx] sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -115,11 +114,11 @@ def build_model(idx, ws): ] packagedata.append(rp) - if not ws.endswith("mf6"): + if not str(ws).endswith("mf6"): packagedata = packagedata[::-1] connectiondata = [] - if not ws.endswith("mf6"): + if not str(ws).endswith("mf6"): inflow_loc = nreaches - 1 ioutflow_loc = 0 for irch in range(inflow_loc, -1, -1): @@ -195,23 +194,18 @@ def build_model(idx, ws): return sim -def build_models(idx, base_ws): - sim = build_model(idx, base_ws) - - ws = os.path.join(base_ws, "mf6") - mc = build_model(idx, ws) - +def build_models(idx, test): + sim = build_model(idx, test.workspace) + mc = build_model(idx, os.path.join(test.workspace, "mf6")) return sim, mc -def eval_flows(sim): - name = sim.name - print("evaluating flow results..." f"({name})") - - obs_pth = os.path.join(sim.simpath, f"{name}.sfr.obs.csv") +def check_output(idx, test): + name = test.name + obs_pth = os.path.join(test.workspace, f"{name}.sfr.obs.csv") obs0 = flopy.utils.Mf6Obs(obs_pth).get_data() - obs_pth = os.path.join(sim.simpath, "mf6", f"{name}.sfr.obs.csv") + obs_pth = os.path.join(test.workspace, "mf6", f"{name}.sfr.obs.csv") obs1 = flopy.utils.Mf6Obs(obs_pth).get_data() assert np.allclose(obs0["INFLOW"], obs1["INFLOW"]), "inflows are not equal" @@ -220,16 +214,16 @@ def eval_flows(sim): obs0["OUTFLOW"], obs1["OUTFLOW"] ), "outflows are not equal" - fpth = os.path.join(sim.simpath, f"{name}.lst") + fpth = os.path.join(test.workspace, f"{name}.lst") with open(fpth, "r") as f: lines = f.read().splitlines() # check order in listing file order = np.zeros(nreaches, dtype=int) - for idx, line in enumerate(lines): + for i, line in enumerate(lines): if "SFR PACKAGE (SFR-1) REACH SOLUTION ORDER" in line: for jdx in range(nreaches): - ipos = idx + 4 + jdx + ipos = i + 4 + jdx t = lines[ipos].split() order[int(t[0]) - 1] = int(t[1]) order -= 1 @@ -241,20 +235,13 @@ def eval_flows(sim): ), "DAG did not correctly reorder reaches." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_models, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_flows, - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sfr_wetstrmbedarea.py b/autotest/test_gwf_sfr_wetstrmbedarea.py index 6b46250e5ca..d3143f29bbe 100644 --- a/autotest/test_gwf_sfr_wetstrmbedarea.py +++ b/autotest/test_gwf_sfr_wetstrmbedarea.py @@ -1,15 +1,15 @@ # Test evap in SFR reaches (no interaction with gwf) +import math import os import flopy import numpy as np import pytest -import math + from framework import TestFramework -from simulation import TestSimulation -ex = ["sfr-wetperim"] +cases = ["sfr-wetperim"] def get_x_frac(x_coord1, rwid): @@ -87,19 +87,20 @@ def get_xy_pts(x, y, rwid): ) x_sec_tab = [x_sec_tab1, x_sec_tab2, x_sec_tab3] + def calc_wp(j, stg): if j < 2: rise = 1 / 3 run = 2 - bot_wid = 1. + bot_wid = 1.0 elif j < 4: rise = 1 / 4 run = 2 - bot_wid = 2. + bot_wid = 2.0 else: rise = 1 / 6 run = 4 - bot_wid = 4. + bot_wid = 4.0 ang = math.atan2(rise, run) hyp_len = stg / math.sin(ang) @@ -107,6 +108,7 @@ def calc_wp(j, stg): return wp + # time params steady = {0: True, 1: False} transient = {0: False, 1: True} @@ -117,15 +119,11 @@ def calc_wp(j, stg): nouter, ninner = 1000, 300 hclose, rclose, relax = 1e-3, 1e-4, 0.97 -# -# MODFLOW 6 flopy GWF object -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -331,22 +329,20 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".sfr.cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) sfrobj = flopy.utils.binaryfile.CellBudgetFile(fname, precision="double") sfr_wetted_interface_area = sfrobj.get_data(text="gwf") # Retrieve simulated stage of each reach - sfr_pth0 = os.path.join(sim.simpath, f"{gwfname}.sfr.obs.csv") + sfr_pth0 = os.path.join(test.workspace, f"{gwfname}.sfr.obs.csv") sfrstg = np.genfromtxt(sfr_pth0, names=True, delimiter=",") # Extract shared wetted interfacial areas @@ -365,8 +361,9 @@ def eval_results(sim): wp = calc_wp(j, stg) wa = wp * delr msg = ( - "Wetted streambed area for reach " + str(j) + - "in stress period 1 does not match explicitly-calculated answer" + "Wetted streambed area for reach " + + str(j) + + "in stress period 1 does not match explicitly-calculated answer" ) assert np.isclose(wa, shared_area[0, j], atol=1e-4), msg @@ -378,17 +375,13 @@ def eval_results(sim): assert val == 0.0, msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sto01.py b/autotest/test_gwf_sto01.py index c5328e0b3f5..b52f551aced 100644 --- a/autotest/test_gwf_sto01.py +++ b/autotest/test_gwf_sto01.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_sto01"] +cases = ["gwf_sto01"] cmppth = "mfnwt" tops = [0.0] -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] dtol = 1e-3 budtol = 1e-2 bud_lst = ["STO-SS_IN", "STO-SS_OUT", "STO-SY_IN", "STO-SY_OUT"] @@ -17,14 +17,14 @@ # static model data # temporal discretization nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] # tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 3, 10, 10 @@ -94,12 +94,13 @@ # storage and compaction data ske = [6e-4, 3e-4, 6e-4] + # variant SUB package problem 3 -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -200,8 +201,10 @@ def build_model(idx, dir): # build MODFLOW-NWT files cpth = cmppth - ws = os.path.join(dir, cpth) - mc = flopy.modflow.Modflow(name, model_ws=ws, version=cpth) + ws = os.path.join(test.workspace, cpth) + mc = flopy.modflow.Modflow( + name, model_ws=ws, version=cpth, exe_name=test.targets["mfnwt"] + ) dis = flopy.modflow.ModflowDis( mc, nlay=nlay, @@ -255,12 +258,9 @@ def build_model(idx, dir): return sim, mc -def eval_sto(sim): - - print("evaluating storage...") - +def check_output(idx, test): # get results from listing file - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.lst") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.lst") budl = flopy.utils.Mf6ListBudget(fpth) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] @@ -272,11 +272,11 @@ def eval_sto(sim): d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 - fpth = os.path.join(sim.simpath, f"{os.path.basename(sim.name)}.cbc") + fpth = os.path.join(test.workspace, f"{os.path.basename(test.name)}.cbc") cobj = flopy.utils.CellBudgetFile(fpth, precision="double") kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -294,65 +294,57 @@ def eval_sto(sim): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary fpth = os.path.join( - sim.simpath, f"{os.path.basename(sim.name)}.bud.cmp.out" + test.workspace, f"{os.path.basename(test.name)}.bud.cmp.out" ) - f = open(fpth, "w") - for i in range(diff.shape[0]): - if i == 0: - line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): - line += f"{key + '_LST':>25s}" - line += f"{key + '_CBC':>25s}" - line += f"{key + '_DIF':>25s}" + with open(fpth, "w") as f: + for i in range(diff.shape[0]): + if i == 0: + line = f"{'TIME':>10s}" + for key in bud_lst: + line += f"{key + '_LST':>25s}" + line += f"{key + '_CBC':>25s}" + line += f"{key + '_DIF':>25s}" + f.write(line + "\n") + line = f"{d['totim'][i]:10g}" + for ii, key in enumerate(bud_lst): + line += f"{d0[key][i]:25g}" + line += f"{d[key][i]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") - line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): - line += f"{d0[key][i]:25g}" - line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" - f.write(line + "\n") - f.close() if diffmax > budtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_sto, - htol=htol[idx], - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + htol=htol[idx], ) + test.run() diff --git a/autotest/test_gwf_sto02.py b/autotest/test_gwf_sto02.py index b2dd7ea9871..da1d9f355ad 100644 --- a/autotest/test_gwf_sto02.py +++ b/autotest/test_gwf_sto02.py @@ -1,6 +1,5 @@ """ Test adaptive time step module - """ import os @@ -8,19 +7,21 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_sto02a", "gwf_sto02b"] +cases = ["gwf_sto02a", "gwf_sto02b"] ncols = [1, 2] -nlay, nrow, = ( +( + nlay, + nrow, +) = ( 1, 1, ) -def build_model(idx, dir): - +def build_models(idx, test): perlen = [10] nper = len(perlen) nstp = [1] @@ -39,11 +40,11 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] ncol = ncols[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -140,14 +141,12 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwfname = "gwf_" + name # This will fail if budget numbers cannot be read - fpth = os.path.join(sim.simpath, f"{gwfname}.lst") + fpth = os.path.join(test.workspace, f"{gwfname}.lst") mflist = flopy.utils.Mf6ListBudget(fpth) names = mflist.get_record_names() print(names) @@ -156,20 +155,13 @@ def eval_flow(sim): print(inc) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_flow, - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_sto03.py b/autotest/test_gwf_sto03.py index b626b632d5a..4e0c078ed84 100644 --- a/autotest/test_gwf_sto03.py +++ b/autotest/test_gwf_sto03.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "gwf_sto03a", "gwf_sto03b", ] @@ -15,7 +15,7 @@ True, ) cmppth = "mf6" -htol = [None for idx in range(len(ex))] +htol = [None for _ in range(len(cases))] dtol = 1e-3 budtol = 1e-2 @@ -31,8 +31,8 @@ nstp = [50 for i in range(nper)] tsmult = [1.1 for i in range(nper)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 1, 1, 1 @@ -62,12 +62,12 @@ # pumping well data absrate = 1.1 * ss * (zelev[-2] - zelev[-1]) * 90.0 well_spd = {} -for idx in range(nper): - if idx % 2 == 0: +for i in range(nper): + if i % 2 == 0: mult = 1.0 else: mult = -1.0 - well_spd[idx] = [[0, 0, 0, mult * absrate]] + well_spd[i] = [[0, 0, 0, mult * absrate]] def get_model(name, ws, newton_bool, offset=0.0): @@ -172,16 +172,17 @@ def get_model(name, ws, newton_bool, offset=0.0): # variant SUB package problem 3 -def build_model(idx, dir): - name = ex[idx] - ws = dir - - # build model with no offset - sim = get_model(name, ws, newton_bool=newton[idx]) - - # build model with offset - ws = os.path.join(dir, cmppth) - mc = get_model(name, ws, newton_bool=newton[idx], offset=cmp_offset) +def build_models(idx, test): + name = cases[idx] + # model with no offset + sim = get_model(name, test.workspace, newton_bool=newton[idx]) + # model with offset + mc = get_model( + name, + os.path.join(test.workspace, cmppth), + newton_bool=newton[idx], + offset=cmp_offset, + ) return sim, mc @@ -192,23 +193,21 @@ def eval_hmax(fpth): bv = np.zeros(ctimes.shape, dtype=float) bv[:] = b.get_data(totim=1.0)[obsname] sv = np.zeros(ctimes.shape, dtype=float) - for idx, t in enumerate(ctimes): - sv[idx] = b.get_data(totim=t)[obsname] + for i, t in enumerate(ctimes): + sv[i] = b.get_data(totim=t)[obsname] msg = ( "maximum heads in {} exceed tolerance ".format(fpth) + f"- maximum difference {(bv - sv).max()}" ) assert np.allclose(bv, sv), msg - return -def eval_sto(sim): - print("evaluating head differences...") - fpth = os.path.join(sim.simpath, "head.obs.csv") +def check_output(idx, test): + fpth = os.path.join(test.workspace, "head.obs.csv") base_obs = flopy.utils.Mf6Obs(fpth).get_data()[obsname] - fpth = os.path.join(sim.simpath, cmppth, "head.obs.csv") + fpth = os.path.join(test.workspace, cmppth, "head.obs.csv") offset_obs = flopy.utils.Mf6Obs(fpth).get_data()[obsname] offset_obs -= cmp_offset @@ -218,10 +217,9 @@ def eval_sto(sim): ) assert np.allclose(base_obs, offset_obs, atol=1e-6), msg - print("evaluating maximum heads...") - fpth = os.path.join(sim.simpath, "head.obs.csv") + fpth = os.path.join(test.workspace, "head.obs.csv") eval_hmax(fpth) - fpth = os.path.join(sim.simpath, cmppth, "head.obs.csv") + fpth = os.path.join(test.workspace, cmppth, "head.obs.csv") eval_hmax(fpth) base_obs = flopy.utils.Mf6Obs(fpth) @@ -230,8 +228,8 @@ def eval_sto(sim): base_cmp = np.zeros(cmp_times.shape, dtype=float) base_cmp[:] = base_obs.get_data(totim=1.0)[obsname] offset_cmp = np.zeros(cmp_times.shape, dtype=float) - for idx, t in enumerate(cmp_times): - offset_cmp[idx] = base_obs.get_data(totim=t)[obsname] + for i, t in enumerate(cmp_times): + offset_cmp[i] = base_obs.get_data(totim=t)[obsname] msg = ( "maximum heads exceed tolerance when offset removed " @@ -239,11 +237,10 @@ def eval_sto(sim): ) assert np.allclose(base_cmp, offset_cmp), msg - print("evaluating storage...") - name = ex[sim.idxsim] - fpth = os.path.join(sim.simpath, f"{name}.cbc") + name = cases[idx] + fpth = os.path.join(test.workspace, f"{name}.cbc") base_cbc = flopy.utils.CellBudgetFile(fpth, precision="double") - fpth = os.path.join(sim.simpath, cmppth, f"{name}.cbc") + fpth = os.path.join(test.workspace, cmppth, f"{name}.cbc") offset_cbc = flopy.utils.CellBudgetFile(fpth, precision="double") # get results from cbc file @@ -251,31 +248,24 @@ def eval_sto(sim): kk = base_cbc.get_kstpkper() times = base_cbc.get_times() max_diff = np.zeros(len(times), dtype=float) - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: base_v = base_cbc.get_data(totim=t, text=text)[0] offset_v = offset_cbc.get_data(totim=t, text=text)[0] if not np.allclose(base_v, offset_v): - max_diff[idx] = np.abs(base_v - offset_v).max() + max_diff[i] = np.abs(base_v - offset_v).max() assert max_diff.sum() == 0.0, "simulated storage is not the same" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_sto, - htol=htol[idx], - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], ) + test.run() diff --git a/autotest/test_gwf_sto_tvs01.py b/autotest/test_gwf_sto_tvs01.py index 1f0f9da6023..7ab1ada5646 100644 --- a/autotest/test_gwf_sto_tvs01.py +++ b/autotest/test_gwf_sto_tvs01.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["tvs01"] +cases = ["tvs01"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 1 perlen = [1.0, 1.0, 1.0, 1.0, 1.0] nper = len(perlen) @@ -37,10 +37,10 @@ def build_model(idx, dir): for i in range(nper): transient[i] = True - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -162,13 +162,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name # head - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata() @@ -193,29 +191,19 @@ def eval_model(sim): for kper, expected_result in enumerate(expected_results): h = head[kper, ex_lay - 1, ex_row - 1, ex_col - 1] - print(kper, h, expected_result) - - errmsg = ( - f"Expected head {expected_result} in period {kper} but found {h}" - ) - assert np.isclose(h, expected_result) - - # comment when done testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, + assert np.isclose( + h, expected_result + ), f"Expected head {expected_result} in period {kper} but found {h}" + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_tdis.py b/autotest/test_gwf_tdis.py index c7f62c7e9f2..ebb188ed0f6 100644 --- a/autotest/test_gwf_tdis.py +++ b/autotest/test_gwf_tdis.py @@ -26,7 +26,7 @@ def simple_sim(tmp_path): @pytest.mark.parametrize("tsmult", [1.0, 1.2]) -def test_tdis_tsmult(tsmult, libmf6_path, simple_sim): +def test_tdis_tsmult(tsmult, simple_sim, targets): """Check totim values to ensure they avoid accumulation errors.""" sim = simple_sim @@ -43,7 +43,7 @@ def test_tdis_tsmult(tsmult, libmf6_path, simple_sim): tdis.write() # Run within libmf6 - mf6 = XmiWrapper(lib_path=libmf6_path, working_directory=sim.sim_path) + mf6 = XmiWrapper(lib_path=targets["libmf6"], working_directory=sim.sim_path) mf6.initialize() dt_list = [] diff --git a/autotest/test_gwf_ts_lak01.py b/autotest/test_gwf_ts_lak01.py index 4a75c181cff..84b658c65c8 100644 --- a/autotest/test_gwf_ts_lak01.py +++ b/autotest/test_gwf_ts_lak01.py @@ -4,12 +4,12 @@ import numpy as np import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "lak" budtol = 1e-2 -ex = ["ts_lak01"] +cases = ["ts_lak01"] # static model data # spatial discretization @@ -313,57 +313,51 @@ def get_model(ws, name, timeseries=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with UZF package - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, timeseries=True) return sim, mc -def eval_budget(sim): - print("evaluating budgets...") - +def check_output(idx, test): # get ia/ja from binary grid file - fname = f"{os.path.basename(sim.name)}.dis.grb" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.dis.grb" + fpth = os.path.join(test.workspace, fname) grbobj = flopy.mf6.utils.MfGrdFile(fpth) ia = grbobj._datadict["IA"] - 1 - fname = f"{os.path.basename(sim.name)}.cbc" + fname = f"{os.path.basename(test.name)}.cbc" # open first cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1, ia, dtol=0.1) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_budget, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ts_maw01.py b/autotest/test_gwf_ts_maw01.py index 53a89583870..c752f71ce60 100644 --- a/autotest/test_gwf_ts_maw01.py +++ b/autotest/test_gwf_ts_maw01.py @@ -4,11 +4,11 @@ import numpy as np import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "maw" -ex = [f"ts_{paktest}01"] +cases = [f"ts_{paktest}01"] def get_model(ws, name, timeseries=False): @@ -16,7 +16,7 @@ def get_model(ws, name, timeseries=False): # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) ts_times = np.arange(0.0, 2.0, 1.0, dtype=float) @@ -399,70 +399,65 @@ def get_model(ws, name, timeseries=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with timeseries - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, timeseries=True) return sim, mc -def eval_model(sim): - print("evaluating model budgets...") +def check_output(idx, test): # get ia/ja from binary grid file - fname = f"{os.path.basename(sim.name)}.dis.grb" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.dis.grb" + fpth = os.path.join(test.workspace, fname) grbobj = flopy.mf6.utils.MfGrdFile(fpth) ia = grbobj._datadict["IA"] - 1 - fname = f"{os.path.basename(sim.name)}.cbc" + fname = f"{os.path.basename(test.name)}.cbc" # open first gwf cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second gwf cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1, ia) # evaluate the sfr package budget file - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc" + fname = f"{os.path.basename(test.name)}.{paktest}.cbc" # open first sfr cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second sfr cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.{paktest}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ts_sfr01.py b/autotest/test_gwf_ts_sfr01.py index adde4b870d4..1401b2da1ec 100644 --- a/autotest/test_gwf_ts_sfr01.py +++ b/autotest/test_gwf_ts_sfr01.py @@ -4,11 +4,11 @@ import numpy as np import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "sfr" -ex = ["ts_sfr01"] +cases = ["ts_sfr01"] def get_model(ws, name, timeseries=False): @@ -16,7 +16,7 @@ def get_model(ws, name, timeseries=False): # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) ts_times = np.arange(0.0, 2.0, 1.0, dtype=float) @@ -514,65 +514,63 @@ def get_model(ws, name, timeseries=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with timeseries - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, timeseries=True) return sim, mc -def eval_model(sim): - print("evaluating model budgets...") - +def check_result(idx, test): # get ia/ja from binary grid file - fname = f"{os.path.basename(sim.name)}.dis.grb" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.dis.grb" + fpth = os.path.join(test.workspace, fname) grbobj = flopy.mf6.utils.MfGrdFile(fpth) ia = grbobj._datadict["IA"] - 1 - fname = f"{os.path.basename(sim.name)}.cbc" + fname = f"{os.path.basename(test.name)}.cbc" # open first gwf cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second gwf cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1, ia) # evaluate the sfr package budget file - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc" + fname = f"{os.path.basename(test.name)}.{paktest}.cbc" # open first sfr cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second sfr cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.{paktest}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1) # do some spot checks on the first sfr cbc file v0 = cobj0.get_data(totim=1.0, text="FLOW-JA-FACE")[0] q = [] - for idx, node in enumerate(v0["node"]): + for i, node in enumerate(v0["node"]): if node > 5: - q.append(v0["q"][idx]) + q.append(v0["q"][i]) v0 = np.array(q) check = np.ones(v0.shape, dtype=float) * 5e-2 check[-2] = 4e-2 @@ -594,17 +592,13 @@ def eval_model(sim): assert np.allclose(v0, check), "FROM-MVR failed" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_result(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ts_sfr02.py b/autotest/test_gwf_ts_sfr02.py index 3a8442c86d0..7160f6279a8 100644 --- a/autotest/test_gwf_ts_sfr02.py +++ b/autotest/test_gwf_ts_sfr02.py @@ -4,11 +4,11 @@ import numpy as np import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "sfr" -ex = ["ts_sfr02"] +cases = ["ts_sfr02"] def get_model(ws, name, timeseries=False): @@ -16,7 +16,7 @@ def get_model(ws, name, timeseries=False): # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) ts_times = np.arange(0.0, 2.0, 1.0, dtype=float) @@ -505,57 +505,55 @@ def get_model(ws, name, timeseries=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with timeseries - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, timeseries=True) return sim, mc -def eval_model(sim): - print("evaluating model budgets...") - +def check_output(idx, test): # get ia/ja from binary grid file - fname = f"{os.path.basename(sim.name)}.dis.grb" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.dis.grb" + fpth = os.path.join(test.workspace, fname) grbobj = flopy.mf6.utils.MfGrdFile(fpth) ia = grbobj._datadict["IA"] - 1 - fname = f"{os.path.basename(sim.name)}.cbc" + fname = f"{os.path.basename(test.name)}.cbc" # open first gwf cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second gwf cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1, ia) # evaluate the sfr package budget file - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc" + fname = f"{os.path.basename(test.name)}.{paktest}.cbc" # open first sfr cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second sfr cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.{paktest}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1) # do some spot checks on the first sfr cbc file @@ -563,9 +561,9 @@ def eval_model(sim): # FLOW-JA-FACE v0 = cobj0.get_data(totim=1.0, text="FLOW-JA-FACE")[0] q = [] - for idx, node in enumerate(v0["node"]): + for i, node in enumerate(v0["node"]): if node in nodes: - q.append(v0["q"][idx]) + q.append(v0["q"][i]) v0 = np.array(q) check = np.ones(v0.shape, dtype=float) * 5e-2 check[1] = 0.76743 @@ -574,43 +572,39 @@ def eval_model(sim): v0 = cobj0.get_data(totim=1.0, text="EXT-OUTFLOW")[0] q = [] - for idx, node in enumerate(v0["node"]): + for i, node in enumerate(v0["node"]): if node in nodes: - q.append(v0["q"][idx]) + q.append(v0["q"][i]) v0 = np.array(q) check = np.array([-2.5e-2, -0.80871, -5e-2, -5e-2, -2.0e-2, -5e-2]) assert np.allclose(v0, check), "EXT-OUTFLOW failed" v0 = cobj0.get_data(totim=1.0, text="FROM-MVR")[0] q = [] - for idx, node in enumerate(v0["node"]): + for i, node in enumerate(v0["node"]): if node in nodes: - q.append(v0["q"][idx]) + q.append(v0["q"][i]) v0 = np.array(q) check = np.array([0.0, 4.5e-2, 0.0, 0.0, 0.0, 0.0]) assert np.allclose(v0, check), "FROM-MVR failed" v0 = cobj0.get_data(totim=1.0, text="TO-MVR")[0] q = [] - for idx, node in enumerate(v0["node"]): + for i, node in enumerate(v0["node"]): if node in nodes: - q.append(v0["q"][idx]) + q.append(v0["q"][i]) v0 = np.array(q) check = np.array([-2.5e-2, 0.0, 0.0, 0.0, -2.0e-2, 0.0]) assert np.allclose(v0, check), "TO-MVR failed" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_ts_uzf01.py b/autotest/test_gwf_ts_uzf01.py index 4af7b20511f..5434bb2c165 100644 --- a/autotest/test_gwf_ts_uzf01.py +++ b/autotest/test_gwf_ts_uzf01.py @@ -4,11 +4,11 @@ import numpy as np import pytest from flopy.utils.compare import eval_bud_diff + from framework import TestFramework -from simulation import TestSimulation paktest = "uzf" -ex = ["ts_uzf01"] +cases = ["ts_uzf01"] def get_model(ws, name, timeseries=False): @@ -16,7 +16,7 @@ def get_model(ws, name, timeseries=False): # temporal discretization nper = 1 tdis_rc = [] - for idx in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1.0)) ts_times = np.arange(0.0, 2.0, 1.0, dtype=float) @@ -414,7 +414,12 @@ def get_model(ws, name, timeseries=False): (7, (0, 7, 2), 1, -1, 1.0, kv, 0.2, 0.4, 0.3, 3.5), (8, (0, 7, 3), 1, -1, 1.0, kv, 0.2, 0.4, 0.3, 3.5), ] - finf, pet, extdp, extwc, = ( + ( + finf, + pet, + extdp, + extwc, + ) = ( 1e-8, 5e-9, 1.0, @@ -632,71 +637,65 @@ def get_model(ws, name, timeseries=False): return sim -def build_model(idx, dir): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = get_model(ws, name) # build MODFLOW 6 files with timeseries - ws = os.path.join(dir, "mf6") + ws = os.path.join(test.workspace, "mf6") mc = get_model(ws, name, timeseries=True) return sim, mc -def eval_model(sim): - print("evaluating model budgets...") - +def check_output(idx, test): # get ia/ja from binary grid file - fname = f"{os.path.basename(sim.name)}.dis.grb" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.dis.grb" + fpth = os.path.join(test.workspace, fname) grbobj = flopy.mf6.utils.MfGrdFile(fpth) ia = grbobj._datadict["IA"] - 1 - fname = f"{os.path.basename(sim.name)}.cbc" + fname = f"{os.path.basename(test.name)}.cbc" # open first gwf cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second gwf cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1, ia) # evaluate the sfr package budget file - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc" + fname = f"{os.path.basename(test.name)}.{paktest}.cbc" # open first sfr cbc file - fpth = os.path.join(sim.simpath, fname) + fpth = os.path.join(test.workspace, fname) cobj0 = flopy.utils.CellBudgetFile(fpth, precision="double") # open second sfr cbc file - fpth = os.path.join(sim.simpath, "mf6", fname) + fpth = os.path.join(test.workspace, "mf6", fname) cobj1 = flopy.utils.CellBudgetFile(fpth, precision="double") # define file path and evaluate difference - fname = f"{os.path.basename(sim.name)}.{paktest}.cbc.cmp.out" - fpth = os.path.join(sim.simpath, fname) + fname = f"{os.path.basename(test.name)}.{paktest}.cbc.cmp.out" + fpth = os.path.join(test.workspace, fname) eval_bud_diff(fpth, cobj0, cobj1) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_utl01_binaryinput.py b/autotest/test_gwf_utl01_binaryinput.py index a7ef3faef37..ad5df3aa573 100644 --- a/autotest/test_gwf_utl01_binaryinput.py +++ b/autotest/test_gwf_utl01_binaryinput.py @@ -1,20 +1,21 @@ -# test reading of binary initial heads (float) and also binary icelltype (int). -# 1. Have binary data in a separate record for each layer -# 2. Have binary data in a single record for all layers +""" +Test reading of binary initial heads (float) and also binary icelltype (int). +1. Have binary data in a separate record for each layer +2. Have binary data in a single record for all layers +""" import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["binary01", "binary02"] +from framework import TestFramework +cases = ["binary01", "binary02"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 5, 6, 7 nper = 1 perlen = 1.0 @@ -32,13 +33,13 @@ def build_model(idx, dir): hclose, rclose, relax = 1e-6, 1e-3, 1.0 tdis_rc = [] - for i in range(nper): + for _ in range(nper): tdis_rc.append((perlen, nstp, tsmult)) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -76,7 +77,7 @@ def build_model(idx, dir): # write top to a binary file text = "TOP" fname = "top.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -111,7 +112,7 @@ def build_model(idx, dir): for k in range(nlay): text = f"BOTM_L{k + 1}" fname = f"botm.l{k + 1:02d}.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -143,7 +144,7 @@ def build_model(idx, dir): ) elif idx == 1: fname = "botm.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") tarr = np.ones((nlay, nrow, ncol), dtype=np.float64) for k in range(nlay): @@ -177,7 +178,7 @@ def build_model(idx, dir): for k in range(nlay): text = f"IDOMAIN_L{k + 1}" fname = f"idomain.l{k + 1:02d}.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -209,7 +210,7 @@ def build_model(idx, dir): ) elif idx == 1: fname = "idomain.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -258,7 +259,7 @@ def build_model(idx, dir): for k in range(nlay): text = f"IC_L{k + 1}" fname = f"ic.strt_l{k + 1:02d}.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -290,7 +291,7 @@ def build_model(idx, dir): ) elif idx == 1: fname = "ic.strt.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="HEAD", @@ -327,7 +328,7 @@ def build_model(idx, dir): icelltype = [] for k in range(nlay): fname = f"npf.icelltype.l{k + 1}.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="head", @@ -360,7 +361,7 @@ def build_model(idx, dir): ) elif idx == 1: fname = "npf.icelltype.bin" - pth = os.path.join(dir, fname) + pth = os.path.join(test.workspace, fname) f = open(pth, "wb") header = flopy.utils.BinaryHeader.create( bintype="head", @@ -427,12 +428,12 @@ def build_model(idx, dir): return sim, None -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run(TestSimulation(name=name, exe_dict=targets), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + ) + test.run() diff --git a/autotest/test_gwf_utl02_timeseries.py b/autotest/test_gwf_utl02_timeseries.py index 3f06e46042a..cc37b394d5a 100644 --- a/autotest/test_gwf_utl02_timeseries.py +++ b/autotest/test_gwf_utl02_timeseries.py @@ -1,13 +1,12 @@ import flopy import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["ts01"] +from framework import TestFramework +cases = ["ts01"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 3, 3 nper = 2 perlen = [1.0, 14966] @@ -26,10 +25,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp, tsmult)) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -148,12 +147,12 @@ def build_model(idx, dir): return sim, None -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run(TestSimulation(name=name, exe_dict=targets), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + targets=targets, + ) + test.run() diff --git a/autotest/test_gwf_utl03_obs01.py b/autotest/test_gwf_utl03_obs01.py index a8df98865b0..85f0c504b5b 100644 --- a/autotest/test_gwf_utl03_obs01.py +++ b/autotest/test_gwf_utl03_obs01.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["utl03_obs"] +cases = ["utl03_obs"] # temporal discretization nper = 2 @@ -48,13 +48,11 @@ hclose, rclose, relax = 1e-6, 0.01, 1.0 -def build_mf6(idx, ws, exe, binaryobs=True): - name = ex[idx] +def build_mf6(idx, ws, binaryobs=True): + name = cases[idx] # build MODFLOW 6 files - sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws - ) + sim = flopy.mf6.MFSimulation(sim_name=name, version="mf6", sim_ws=ws) # create tdis package flopy.mf6.ModflowTdis( sim, time_units="DAYS", nper=nper, perioddata=tdis_rc @@ -137,14 +135,14 @@ def build_mf6(idx, ws, exe, binaryobs=True): return sim -def build_model(idx, dir, exe): +def build_model(idx, dir): ws = dir # build mf6 with ascii observation output - sim = build_mf6(idx, ws, exe=exe, binaryobs=False) + sim = build_mf6(idx, ws, binaryobs=False) # build mf6 with binary observation output wsc = os.path.join(ws, "mf6") - mc = build_mf6(idx, wsc, exe=exe, binaryobs=True) + mc = build_mf6(idx, wsc, binaryobs=True) sim.write_simulation() mc.write_simulation() @@ -153,16 +151,16 @@ def build_model(idx, dir, exe): return sim, mc -def build_models(dir, exe): - for idx, name in enumerate(ex): - sim, mc = build_model(idx, dir, exe) - sim.write_simulation() - mc.write_simulation() - hack_binary_obs(idx, dir) +def build_models(idx, test): + sim, mc = build_model(idx, test.workspace) + sim.write_simulation() + mc.write_simulation() + hack_binary_obs(idx, test.workspace) + return sim, mc def hack_binary_obs(idx, dir): - name = ex[idx] + name = cases[idx] ws = dir wsc = os.path.join(ws, "mf6") fname = name + ".obs" @@ -176,14 +174,11 @@ def hack_binary_obs(idx, dir): line += " BINARY" f.write(f"{line}\n") f.close() - return - -def eval_obs(sim): - print("evaluating observations...") +def check_output(idx, test): # get results from the observation files - pth = sim.simpath + pth = test.workspace files = [fn for fn in os.listdir(pth) if ".csv" in fn] for file in files: pth0 = os.path.join(pth, file) @@ -216,13 +211,14 @@ def eval_obs(sim): assert np.allclose(d0[name], d1[name], rtol=1e-5), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - mf6 = targets["mf6"] - test = TestFramework() - build_models(ws, mf6) - test.run(TestSimulation(name=name, exe_dict=targets, exfunc=eval_obs), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + overwrite=False, + ) + test.run() diff --git a/autotest/test_gwf_utl04_auxmult.py b/autotest/test_gwf_utl04_auxmult.py index 78ae0f8f55d..29ba94c2200 100644 --- a/autotest/test_gwf_utl04_auxmult.py +++ b/autotest/test_gwf_utl04_auxmult.py @@ -1,7 +1,5 @@ """ -MODFLOW 6 Autotest Test to make sure that auxmultcol is working when used with a time series - """ import os @@ -9,14 +7,18 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["auxmult01"] +from framework import TestFramework +cases = ["auxmult01", "auxmult02"] -def build_model(idx, dir): +wellist = [ + [(0, 2, 2), "tsq", "tsqfact"], + [(0, 2, 2), 1.0000000, "tsqfact"] +] +def build_models(idx, test): + global numstep nlay, nrow, ncol = 1, 3, 3 perlen = [1.0, 1.0, 1.0, 1.0] nstp = [10, 1, 1, 1] @@ -26,6 +28,7 @@ def build_model(idx, dir): delr = delc = lenx / float(nrow) botm = -1.0 hk = 1.0 + numstep = sum(nstp) nouter, ninner = 100, 300 hclose, rclose, relax = 1e-6, 1e-3, 1.0 @@ -34,10 +37,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -105,19 +108,28 @@ def build_model(idx, dir): ) # wel files - wellist1 = [] - wellist1.append([(0, 2, 2), "tsq", "tsqfact"]) wel = flopy.mf6.ModflowGwfwel( gwf, pname="wel", print_input=True, print_flows=True, - stress_period_data={0: wellist1}, + stress_period_data={0: [wellist[idx]]}, auxiliary=["auxmult"], auxmultname="auxmult", ) # ts_filerecord='well-rates.ts') + # wel obs + obs = { + "wel.obs.csv": [ + ["q", "wel", (0, 2, 2)] + ], + } + welobs = wel.obs.initialize( + print_input=True, + continuous=obs, + ) + # well ts package ts_recarray = [ (0.0, 0.0, 1.0), @@ -160,10 +172,9 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") - - fpth = os.path.join(sim.simpath, "auxmult01.bud") +def check_output(idx, test): + name = cases[idx] + fpth = os.path.join(test.workspace, f"{name}.bud") bobj = flopy.utils.CellBudgetFile(fpth, precision="double", verbose=False) records = bobj.get_data(text="wel") @@ -177,17 +188,26 @@ def eval_model(sim): msg = f"err {qlist} /= {answer}" assert np.allclose(qlist, answer), msg - # assert False + # MODFLOW 6 observations + fpth = os.path.join(test.workspace, "wel.obs.csv") + try: + obs = np.genfromtxt(fpth, names=True, delimiter=",") + except: + assert False, f'could not load data from "{fpth}"' + + rate = obs["Q"] + obs_answer = [1.0 if x%2==0 else 0.0 for x in range(numstep)] + msg = f"err {rate} /= {obs_answer}" + assert np.allclose(rate, obs_answer), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation(name=name, exe_dict=targets, exfunc=eval_model), ws + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_utl05_budparse.py b/autotest/test_gwf_utl05_budparse.py index 216413bf199..99001a76ab3 100644 --- a/autotest/test_gwf_utl05_budparse.py +++ b/autotest/test_gwf_utl05_budparse.py @@ -1,6 +1,5 @@ """ Test of budget table parsing - """ import os @@ -8,18 +7,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_utl05"] +cases = ["gwf_utl05"] laytyp = [1] ss = [1.0e-10] sy = [0.1] nlay, nrow, ncol = 1, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): nper = 2 perlen = [2.0, 2.0] nstp = [14, 14] @@ -35,13 +33,13 @@ def build_model(idx, dir): hclose, rclose, relax = 1e-6, 1e-6, 0.97 tdis_rc = [] - for id in range(nper): - tdis_rc.append((perlen[id], nstp[id], tsmult[id])) + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -141,13 +139,11 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - - gwfname = "gwf_" + sim.name +def check_output(idx, test): + gwfname = "gwf_" + test.name # This will fail if budget numbers cannot be read - fpth = os.path.join(sim.simpath, f"{gwfname}.lst") + fpth = os.path.join(test.workspace, f"{gwfname}.lst") mflist = flopy.utils.Mf6ListBudget(fpth) names = mflist.get_record_names() print(names) @@ -159,17 +155,13 @@ def eval_flow(sim): assert np.allclose(inc["WEL_OUT"], 0.0) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_utl06_tas.py b/autotest/test_gwf_utl06_tas.py index dbde41bec9a..17ca4fc279e 100644 --- a/autotest/test_gwf_utl06_tas.py +++ b/autotest/test_gwf_utl06_tas.py @@ -1,7 +1,5 @@ """ -MODFLOW 6 Autotest Test the time array series for the recharge package - """ import os @@ -9,10 +7,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "utl06_tas_a", "utl06_tas_b", "utl06_tas_c", @@ -31,7 +29,7 @@ idomain[0, :, :] = np.array(idomain_lay0) -def build_model(idx, dir): +def build_models(idx, test): perlen = [5.0] nstp = [5] tsmult = [1.0] @@ -54,7 +52,7 @@ def build_model(idx, dir): sim_name = "sim" # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=sim_name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -190,14 +188,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - +def check_output(idx, test): gwfname = "gwf" - idx = sim.idxsim # load concentration file - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_data() @@ -205,7 +200,7 @@ def eval_transport(sim): assert False, f'could not load data from "{fpth}"' # load gwf budget file - fpth = os.path.join(sim.simpath, f"{gwfname}.cbc") + fpth = os.path.join(test.workspace, f"{gwfname}.cbc") try: bobj = flopy.utils.CellBudgetFile( fpth, @@ -365,17 +360,13 @@ def eval_transport(sim): assert np.allclose(q, qa), f"{q} /=\n {qa}" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index 0d168da3265..d269ab11f01 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -1,7 +1,6 @@ """ -# Test the ability of a uzf to route waves through a simple 1d vertical -# column. - +Test the ability of a uzf to route waves through a simple 1d vertical +column. """ import os @@ -9,16 +8,15 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_uzf01a"] +cases = ["gwf_uzf01a"] nlay, nrow, ncol = 100, 1, 1 -def build_model(idx, exdir): - - name = ex[idx] +def build_models(idx, test): + name = cases[idx] perlen = [500.0] nper = len(perlen) @@ -36,11 +34,11 @@ def build_model(idx, exdir): sy = 0.1 tdis_rc = [] - for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) + for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # build MODFLOW 6 files - ws = exdir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -213,11 +211,9 @@ def build_model(idx, exdir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace # check binary grid file fname = os.path.join(ws, name + ".dis.grb") @@ -255,24 +251,20 @@ def eval_flow(sim): names[-1]: obs_obj.get_data(obsname=names[-1]), } cbc = uobj.get_ts(idx=[[0, 0, 1], [0, 0, 49]], text="GWF") - for idx, key in enumerate(obs.keys()): - assert np.allclose(obs[key][key], -cbc[:, idx + 1]), ( + for i, key in enumerate(obs.keys()): + assert np.allclose(obs[key][key], -cbc[:, i + 1]), ( f"observation data for {key} is not the same as " "data in the cell-by-cell file." ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf02.py b/autotest/test_gwf_uzf02.py index 03996c8efe6..57d40316d9f 100644 --- a/autotest/test_gwf_uzf02.py +++ b/autotest/test_gwf_uzf02.py @@ -1,6 +1,5 @@ """ -# Test uzf for the vs2d comparison problem in the uzf documentation - +Test uzf for the vs2d comparison problem in the uzf documentation """ import os @@ -8,15 +7,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_uzf02a"] +cases = ["gwf_uzf02a"] nlay, nrow, ncol = 1, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): perlen = [17.7] nper = len(perlen) nstp = [177] @@ -46,10 +44,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -230,10 +228,10 @@ def make_plot(sim, obsvals): # shows curves for times 2.5, 7.5, 12.6, 17.7 # which are indices 24, 74, 125, and -1 - idx = [24, 74, 125, -1] + indices = [24, 74, 125, -1] obsvals = [list(row) for row in obsvals] - obsvals = [obsvals[i] for i in idx] + obsvals = [obsvals[i] for i in indices] obsvals = np.array(obsvals) import matplotlib.pyplot as plt @@ -253,15 +251,13 @@ def make_plot(sim, obsvals): plt.legend() fname = "fig-xsect.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(sim.workspace, fname) plt.savefig(fname, bbox_inches="tight") -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace # check binary grid file fname = os.path.join(ws, name + ".dis.grb") @@ -298,26 +294,21 @@ def eval_flow(sim): assert np.allclose(uz["q"], uz_answer), "unsat ET is not correct" # Make plot of obs - fpth = os.path.join(sim.simpath, name + ".uzf.obs.csv") + fpth = os.path.join(test.workspace, name + ".uzf.obs.csv") try: obsvals = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' - if False: - make_plot(sim, obsvals) - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - ws, + # make_plot(sim, obsvals) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf03.py b/autotest/test_gwf_uzf03.py index 361036a4c01..77c5e8c76a1 100644 --- a/autotest/test_gwf_uzf03.py +++ b/autotest/test_gwf_uzf03.py @@ -1,7 +1,6 @@ """ -# Test uzf for the vs2d comparison problem in the uzf documentation except in -# this case there are 15 gwf and uzf cells, rather than just one cell. - +Test uzf for the vs2d comparison problem in the uzf documentation except in +this case there are 15 gwf and uzf cells, rather than just one cell. """ import os @@ -9,14 +8,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_uzf03a"] +cases = ["gwf_uzf03a"] nlay, nrow, ncol = 15, 1, 1 -def build_model(idx, dir): +def build_models(idx, test): perlen = [17.7] nper = len(perlen) nstp = [177] @@ -46,10 +45,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -231,10 +230,10 @@ def make_plot(sim, obsvals): # shows curves for times 2.5, 7.5, 12.6, 17.7 # which are indices 24, 74, 125, and -1 - idx = [24, 74, 125, -1] + indices = [24, 74, 125, -1] obsvals = [list(row) for row in obsvals] - obsvals = [obsvals[i] for i in idx] + obsvals = [obsvals[i] for i in indices] obsvals = np.array(obsvals) import matplotlib.pyplot as plt @@ -253,15 +252,13 @@ def make_plot(sim, obsvals): plt.legend() fname = "fig-xsect.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(sim.workspace, fname) plt.savefig(fname, bbox_inches="tight") -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace # check binary grid file fname = os.path.join(ws, name + ".dis.grb") @@ -298,26 +295,21 @@ def eval_flow(sim): assert np.allclose(uz["q"], uz_answer), "unsat ET is not correct" # Make plot of obs - fpth = os.path.join(sim.simpath, name + ".uzf.obs.csv") + fpth = os.path.join(test.workspace, name + ".uzf.obs.csv") try: obsvals = np.genfromtxt(fpth, names=True, delimiter=",") except: assert False, f'could not load data from "{fpth}"' - if False: - make_plot(sim, obsvals) - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - ws, + # make_plot(test, obsvals) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf04.py b/autotest/test_gwf_uzf04.py index 4662ea98e2d..b53cf7627db 100644 --- a/autotest/test_gwf_uzf04.py +++ b/autotest/test_gwf_uzf04.py @@ -1,12 +1,11 @@ """ -# Test uzf mass balance. One cell model with starting water table at -20 -# and GHB with stage of -25. Uzf infiltration is applied, but water table -# still falls. This test looks at the simulated unsat zone storage and -# unsat volume (stored as an auxiliary variable) and compares the results -# to calculated values. Although the Uzf unsat storage and unsat volume -# should probably be for total water instead of just mobile water (theta - -# thetar), this is not how Uzf was designed. - +Test uzf mass balance. One cell model with starting water table at -20 +and GHB with stage of -25. Uzf infiltration is applied, but water table +still falls. This test looks at the simulated unsat zone storage and +unsat volume (stored as an auxiliary variable) and compares the results +to calculated values. Although the Uzf unsat storage and unsat volume +should probably be for total water instead of just mobile water (theta - +thetar), this is not how Uzf was designed. """ import os @@ -14,10 +13,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_uzf04a"] +cases = ["gwf_uzf04a"] nlay, nrow, ncol = 1, 1, 1 thts = 0.30 # saturated water content thtr = 0.05 # residual water content @@ -25,8 +24,7 @@ strt = -20.0 -def build_model(idx, dir): - +def build_models(idx, test): perlen = [1.0] nper = len(perlen) nstp = [1] @@ -51,10 +49,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -215,11 +213,9 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace fname = os.path.join(ws, f"{name}.uzf.bin") wobj = flopy.utils.HeadFile(fname, text="WATER-CONTENT") @@ -257,17 +253,13 @@ def eval_flow(sim): ), "Simulated mobile water volume in aux does not match known result" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf05.py b/autotest/test_gwf_uzf05.py index 457ffd8b7b8..4393f4f43e9 100644 --- a/autotest/test_gwf_uzf05.py +++ b/autotest/test_gwf_uzf05.py @@ -2,7 +2,6 @@ Test uzf for case where uzf is only in top cell. There was a bug with this in the past in which case UZF would not send water to water table unless there was a uzf in each cell. - """ import os @@ -10,10 +9,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwf_uzf05a"] +cases = ["gwf_uzf05a"] nlay, nrow, ncol = 3, 1, 1 thts = 0.30 # saturated water content @@ -22,8 +21,7 @@ strt = 15.0 -def build_model(idx, dir): - +def build_models(idx, test): perlen = [1.0] nper = len(perlen) nstp = [1] @@ -48,10 +46,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -214,11 +212,9 @@ def build_model(idx, dir): return sim, None -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace fname = os.path.join(ws, f"{name}.uzf.bin") wobj = flopy.utils.HeadFile(fname, text="WATER-CONTENT") @@ -239,17 +235,13 @@ def eval_flow(sim): assert np.isclose(q, -4.0), "Flow from UZF to node 1 should be -4." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf_gwet.py b/autotest/test_gwf_uzf_gwet.py index ab7d74556d8..6c11c55e90e 100644 --- a/autotest/test_gwf_uzf_gwet.py +++ b/autotest/test_gwf_uzf_gwet.py @@ -3,16 +3,19 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["uzf_3lay"] +cases = ["uzf_3lay"] +name = "model" iuz_cell_dict = {} cell_iuz_dict = {} +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-9, 1e-3, 0.97 -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 3, 1, 10 nper = 5 perlen = [20.0, 20.0, 20.0, 500.0, 2000.0] @@ -23,17 +26,12 @@ def build_model(idx, dir): delc = 1.0 strt = -25 - nouter, ninner = 100, 300 - hclose, rclose, relax = 1e-9, 1e-3, 0.97 - tdis_rc = [] for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] - # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -98,7 +96,7 @@ def build_model(idx, dir): ) # transient uzf info - # iuzno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] + # ifno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] uzf_pkdat = [ [0, (0, 0, 1), 1, 8, 1, 1, 0.05, 0.35, 0.05, 4, "uzf01"], [1, (0, 0, 2), 1, 9, 1, 1, 0.05, 0.35, 0.05, 4, "uzf02"], @@ -257,17 +255,11 @@ def build_model(idx, dir): return sim, None -def eval_model(sim): - print("evaluating model...") +def check_output(idx, test): + ws = test.workspace + test = flopy.mf6.MFSimulation.load(sim_ws=ws) - ws = sim.simpath - sim = flopy.mf6.MFSimulation.load(sim_ws=ws) - - fpth = os.path.join(ws, "uzf_3lay.hds") - hobj = flopy.utils.HeadFile(fpth, precision="double") - hds = hobj.get_alldata() - - bpth = os.path.join(ws, "uzf_3lay.cbc") + bpth = ws / f"{name}.cbc" bobj = flopy.utils.CellBudgetFile(bpth, precision="double") bobj.get_unique_record_names() # ' STO-SS' @@ -281,7 +273,7 @@ def eval_model(sim): gwet = bobj.get_data(text="UZF-GWET") gwet = np.array(gwet) - uzpth = os.path.join(ws, "uzf_3lay.uzf.bud") + uzpth = os.path.join(ws, f"{name}.uzf.bud") uzobj = flopy.utils.CellBudgetFile(uzpth, precision="double") uzobj.get_unique_record_names() # ' FLOW-JA-FACE' @@ -296,25 +288,25 @@ def eval_model(sim): # convert ndarray to grid dimensions tot_stp = 0 - tinfo = sim.tdis.perioddata.get_data() + tinfo = test.tdis.perioddata.get_data() for itm in tinfo: tot_stp += int(itm[1]) gwet_arr = np.zeros( ( tot_stp, - sim.uzf_3lay.dis.nlay.get_data(), - sim.uzf_3lay.dis.nrow.get_data(), - sim.uzf_3lay.dis.ncol.get_data(), + test.model.dis.nlay.get_data(), + test.model.dis.nrow.get_data(), + test.model.dis.ncol.get_data(), ) ) uzet_arr = np.zeros( ( tot_stp, - sim.uzf_3lay.dis.nlay.get_data(), - sim.uzf_3lay.dis.nrow.get_data(), - sim.uzf_3lay.dis.ncol.get_data(), + test.model.dis.nlay.get_data(), + test.model.dis.nrow.get_data(), + test.model.dis.ncol.get_data(), ) ) @@ -336,7 +328,7 @@ def eval_model(sim): uzet_arr[tm, lay, row, col] = itm[2] - uzf_strsPerDat = sim.uzf_3lay.uzf.perioddata.get_data() + uzf_strsPerDat = test.model.uzf.perioddata.get_data() pet = 0 for tm in range(tot_stp): nstps = 0 @@ -345,8 +337,8 @@ def eval_model(sim): if tm < nstps: break - for i in range(sim.uzf_3lay.dis.nrow.get_data()): - for j in range(sim.uzf_3lay.dis.ncol.get_data()): + for i in range(test.model.dis.nrow.get_data()): + for j in range(test.model.dis.ncol.get_data()): if (0, i, j) in cell_iuz_dict: iuz = cell_iuz_dict[ (0, i, j) @@ -367,17 +359,14 @@ def eval_model(sim): + str(j + 1) ) - print("Finished running checks") - -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx,name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_uzf_surfdep.py b/autotest/test_gwf_uzf_surfdep.py index 824727a9fff..68a8f3d3285 100644 --- a/autotest/test_gwf_uzf_surfdep.py +++ b/autotest/test_gwf_uzf_surfdep.py @@ -7,7 +7,6 @@ def build_model(dir, exe): - nlay, nrow, ncol = 3, 1, 10 nper = 1 perlen = [20.0] @@ -98,7 +97,7 @@ def build_model(dir, exe): ) # transient uzf info - # iuzno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] + # ifno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] uzf_pkdat = [ [0, (0, 0, 1), 1, 8, 6, 1, 0.05, 0.35, 0.05, 4, "uzf01"], [1, (0, 0, 2), 1, 9, 6, 1, 0.05, 0.35, 0.05, 4, "uzf02"], @@ -187,7 +186,7 @@ def build_model(dir, exe): def test_mf6model(function_tmpdir, targets): # build and run the test model - mf6 = targets.mf6 + mf6 = targets["mf6"] sim = build_model(str(function_tmpdir), mf6) sim.write_simulation() sim.run_simulation() @@ -196,10 +195,8 @@ def test_mf6model(function_tmpdir, targets): f = open(str(function_tmpdir / "mfsim.lst"), "r") lines = f.readlines() error_count = 0 - expected_msg = False for line in lines: if "SURFDEP" and "cannot" in line: - expected_msg = True error_count += 1 assert error_count == 8, ( diff --git a/autotest/test_gwf_uzf_wc_output.py b/autotest/test_gwf_uzf_wc_output.py index bd43193ace4..b27d978674c 100644 --- a/autotest/test_gwf_uzf_wc_output.py +++ b/autotest/test_gwf_uzf_wc_output.py @@ -4,12 +4,12 @@ import flopy.utils.binaryfile as bf import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation include_NWT = False -ex = ["uzf_3lay_wc_chk"] +cases = ["uzf_3lay_wc_chk"] iuz_cell_dict = {} cell_iuz_dict = {} @@ -49,7 +49,7 @@ 3: [[(2, 0, 0), ghbelv2, ghbcond], [(2, 0, ncol - 1), ghbelv2, ghbcond]], } -# iuzno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] +# ifno cellid landflg ivertcn surfdp vks thtr thts thti eps [bndnm] surfdep1 = 1.0 surfdep2 = 0.001 vks = 0.5 @@ -223,12 +223,11 @@ def build_mf6_model(idx, ws): - tdis_rc = [] for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( @@ -343,8 +342,7 @@ def build_mf6_model(idx, ws): def build_mfnwt_model(idx, ws): - - name = ex[idx] + name = cases[idx] # build MODFLOW-NWT files ws = os.path.join(ws, "mfnwt") @@ -435,25 +433,22 @@ def build_mfnwt_model(idx, ws): return mf -def build_model(idx, ws): +def build_models(idx, test): # Start by building the MF6 model - sim = build_mf6_model(idx, ws) + sim = build_mf6_model(idx, test.workspace) # Construct MF-NWT model for comparing water contents # Commented out to avoid NWT dependency, but left behind for # local testing if needed in the future. if include_NWT: - mc = build_mfnwt_model(idx, ws) + mc = build_mfnwt_model(idx, test.workspace) else: mc = None return sim, mc -def eval_model(sim): - print("evaluating model...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + ws = test.workspace # Get the MF6 heads fpth = os.path.join(ws, "uzf_3lay_wc_chk.hds") @@ -461,7 +456,7 @@ def eval_model(sim): hds = hobj.get_alldata() # Get the MF6 water contents - wcpth = os.path.join(ws, ex[0] + ".uzfwc.bin") + wcpth = os.path.join(ws, cases[0] + ".uzfwc.bin") mf6_wc_obj = bf.HeadFile(wcpth, text=" water-content") ckstpkper_wc = mf6_wc_obj.get_kstpkper() @@ -541,20 +536,13 @@ def eval_model(sim): print("Finished running checks") -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=eval_model, - idxsim=0, - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index 5b27cebda76..4abc3c1bf80 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -1,10 +1,9 @@ -# ## Test problem for VSC -# -# Uses constant head and general-head boundaries on the left and right -# sides of the model domain, respectively, to drive flow from left to -# right. Tests that head-dependent boundary conditions are properly -# accounting for viscosity when VSC is active. -# +""" +Uses constant head and general-head boundaries on the left and right +sides of the model domain, respectively, to drive flow from left to +right. Tests that head-dependent boundary conditions are properly +accounting for viscosity when VSC is active. +""" # Imports @@ -14,11 +13,11 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["no-vsc01-bnd", "vsc01-bnd", "no-vsc01-k"] hyd_cond = [1205.49396942506, 864.0] # Hydraulic conductivity (m/d) -ex = ["no-vsc01-bnd", "vsc01-bnd", "no-vsc01-k"] viscosity_on = [False, True, False] hydraulic_conductivity = [hyd_cond[0], hyd_cond[1], hyd_cond[1]] @@ -57,15 +56,11 @@ nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 -# -# MODFLOW 6 flopy GWF simulation object (sim) is returned -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -253,15 +248,13 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") outbud = budobj.get_data(text=" GHB") @@ -269,14 +262,14 @@ def eval_results(sim): # Establish known answer: stored_ans = -151.63446156218242 - if sim.idxsim == 0: + if idx == 0: no_vsc_bud_last = np.array(outbud[-1].tolist()) sim_val_1 = no_vsc_bud_last[:, 2].sum() # Ensure latest simulated value hasn't changed from stored answer assert np.allclose( sim_val_1, stored_ans, atol=1e-4 - ), "Flow in the " + ex[ + ), "Flow in the " + cases[ 0 ] + " test problem (doesn't simulate " "viscosity) has changed,\n should be " + str( stored_ans @@ -284,14 +277,14 @@ def eval_results(sim): sim_val_1 ) - elif sim.idxsim == 1: + elif idx == 1: with_vsc_bud_last = np.array(outbud[-1].tolist()) sim_val_2 = with_vsc_bud_last[:, 2].sum() # Ensure latest simulated value hasn't changed from stored answer assert np.allclose( sim_val_2, stored_ans, atol=1e-4 - ), "Flow in the " + ex[ + ), "Flow in the " + cases[ 1 ] + " test problem (simulates " "viscosity) has changed,\n should be " + str( stored_ans @@ -299,32 +292,41 @@ def eval_results(sim): sim_val_2 ) - elif sim.idxsim == 2: + elif idx == 2: no_vsc_low_k_bud_last = np.array(outbud[-1].tolist()) sim_val_3 = no_vsc_low_k_bud_last[:, 2].sum() # Ensure the flow leaving model 3 is less than what leaves model 2 assert abs(stored_ans) > abs(sim_val_3), ( "Exit flow from model " - + ex[1] + + cases[1] + " should be greater than flow exiting " - + ex[2] + + cases[2] + ", but it is not." ) + # Ensure that binary output file is readable (has the correct header) + vsc_filerecord = "{}.vsc.bin".format(gwfname) + fname = os.path.join(test.workspace, vsc_filerecord) + if os.path.isfile(fname): + vscobj = flopy.utils.HeadFile( + fname, precision="double", text="VISCOSITY" + ) + try: + data = vscobj.get_alldata() + print(data.shape) + data.shape == (500, 1, 10, 80) + except: + print("Binary viscosity output file was not read successfully") + -# - No need to change any code below -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_vsc02.py b/autotest/test_gwf_vsc02.py index a3fb061646e..3598a10cb4a 100644 --- a/autotest/test_gwf_vsc02.py +++ b/autotest/test_gwf_vsc02.py @@ -1,11 +1,10 @@ -# ## Test problem for VSC -# -# Uses general-head and drain boundaries on the left and right -# sides of the model domain, respectively, to drive flow from left to -# right. Tests that head-dependent boundary conditions are properly -# accounting for viscosity when VSC is active. Similar to gwf-vsc01-bnd -# but employs head-dependent boundary on the left and right side of the -# model +"""Uses general-head and drain boundaries on the left and right +sides of the model domain, respectively, to drive flow from left to +right. Tests that head-dependent boundary conditions are properly +accounting for viscosity when VSC is active. Similar to gwf-vsc01-bnd +but employs head-dependent boundary on the left and right side of the +model +""" # Imports @@ -15,12 +14,12 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation # Setup scenario input +cases = ["no-vsc02-bnd", "vsc02-bnd", "no-vsc02-k"] hyd_cond = [1205.49396942506, 864.0] # Hydraulic conductivity (m/d) -ex = ["no-vsc02-bnd", "vsc02-bnd", "no-vsc02-k"] viscosity_on = [False, True, False] hydraulic_conductivity = [hyd_cond[0], hyd_cond[1], hyd_cond[1]] @@ -59,15 +58,11 @@ nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 -# -# MODFLOW 6 flopy GWF simulation object (sim) is returned -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -256,15 +251,13 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") outbud = budobj.get_data(text=" GHB") @@ -272,14 +265,14 @@ def eval_results(sim): # Establish known answer: stored_ans = 452.5316256451224 - if sim.idxsim == 0: + if idx == 0: no_vsc_bud_last = np.array(outbud[-1].tolist()) sim_val_1 = no_vsc_bud_last[:, 2].sum() # Ensure latest simulated value hasn't changed from stored answer assert np.allclose( sim_val_1, stored_ans, atol=1e-4 - ), "Flow in the " + ex[ + ), "Flow in the " + cases[ 0 ] + " test problem (doesn't simulate " "viscosity) has changed,\n should be " + str( stored_ans @@ -287,14 +280,14 @@ def eval_results(sim): sim_val_1 ) - elif sim.idxsim == 1: + elif idx == 1: with_vsc_bud_last = np.array(outbud[-1].tolist()) sim_val_2 = with_vsc_bud_last[:, 2].sum() # Ensure latest simulated value hasn't changed from stored answer assert np.allclose( sim_val_2, stored_ans, atol=1e-4 - ), "Flow in the " + ex[ + ), "Flow in the " + cases[ 1 ] + " test problem (simulates " "viscosity) has changed,\n should be " + str( stored_ans @@ -302,31 +295,27 @@ def eval_results(sim): sim_val_2 ) - elif sim.idxsim == 2: + elif idx == 2: no_vsc_low_k_bud_last = np.array(outbud[-1].tolist()) sim_val_3 = no_vsc_low_k_bud_last[:, 2].sum() # Ensure the flow leaving model 3 is less than what leaves model 2 assert abs(stored_ans) > abs(sim_val_3), ( "Exit flow from model " - + ex[1] + + cases[1] + " should be greater than flow existing " - + ex[2] + + cases[2] + ", but it is not." ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_vsc03_sfr.py b/autotest/test_gwf_vsc03_sfr.py index 97e0148e148..44a1b7bebe7 100644 --- a/autotest/test_gwf_vsc03_sfr.py +++ b/autotest/test_gwf_vsc03_sfr.py @@ -1,26 +1,26 @@ -# Scenario envisioned by this test is a river running through a V-shaped -# valley that loses water to the aquifer at the upper end until it goes -# dry, then begins to gain flow again in the lower reaches. River water -# enters the simulation at 8 deg C. Aquifer water starts out at 35 deg C. -# Reference viscosity temperature is 20 deg C. With the VSC package active, -# the simulation should predict less loss of river water to the aquifer -# and more discharge of gw to the stream, compared to the same simulation -# with the VSC package inactive. - -# Imports +""" +Scenario envisioned by this test is a river running through a V-shaped +valley that loses water to the aquifer at the upper end until it goes +dry, then begins to gain flow again in the lower reaches. River water +enters the simulation at 8 deg C. Aquifer water starts out at 35 deg C. +Reference viscosity temperature is 20 deg C. With the VSC package active, +the simulation should predict less loss of river water to the aquifer +and more discharge of gw to the stream, compared to the same simulation +with the VSC package inactive. +""" import os -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["no-vsc-sfr01", "vsc-sfr01"] +cases = ["no-vsc-sfr01", "vsc-sfr01"] viscosity_on = [False, True] + # Equation for determining land surface elevation with a stream running down the middle def topElev_sfrCentered(x, y): return ((-0.003 * x) + 260.0) + ( @@ -85,17 +85,11 @@ def topElev_sfrCentered(x, y): rhob = (1 - porosity) * rho_solids # Bulk density ($kg/m^3$) K_d = C_s / (rho_water * C_p_w) # Partitioning coefficient ($m^3/kg$) -# -# MODFLOW 6 flopy GWF & GWT simulation object (sim) is returned -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] - - print("Building model...{}".format(name)) + ws = test.workspace + name = cases[idx] # generate names for each model gwfname = "gwf-" + name @@ -315,7 +309,8 @@ def build_model(idx, dir): print_flows=True, print_input=False, auxiliary=["VDUMMY", "TEMPERATURE"], - unit_conversion=1.486 * 86400, + length_conversion=3.28084, + time_conversion=86400.0, budget_filerecord=budpth, mover=False, nreaches=nreaches, @@ -434,15 +429,13 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".sfr.cbc" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") outbud = budobj.get_data(text=" GWF") @@ -478,7 +471,7 @@ def eval_results(sim): ] ) - if sim.idxsim == 0: + if idx == 0: # convert np.array to list no_vsc_bud_last = np.array(outbud[-1].tolist()) @@ -507,7 +500,7 @@ def eval_results(sim): " problem." ) - elif sim.idxsim == 1: + elif idx == 1: with_vsc_bud_last = np.array(outbud[-1].tolist()) # sum up total losses and total gains in the first 10 reaches @@ -530,17 +523,13 @@ def eval_results(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_vsc04_lak.py b/autotest/test_gwf_vsc04_lak.py index 912b2772f5e..af738585aee 100644 --- a/autotest/test_gwf_vsc04_lak.py +++ b/autotest/test_gwf_vsc04_lak.py @@ -1,27 +1,28 @@ -# Simple single lake model. Lake cut into top two layers of a 5 layer -# model. Model is loosely based on the first example problem in -# Merritt and Konikow (2000) which also is one of the MT3D-USGS test -# problems. This test developed to isolate lake-aquifer interaction; -# no SFR or other advanced packages. Problem set up to have groundwater -# pass through the lake: gw inflow on the left side, gw outflow on the -# right side of the lake. Uses constant stage boundary in the lake to -# ensure desired flow conditions for testing budget changes with and -# without VSC active. -# -# starting groundwater temperature: 30.0 -# left chd boundary inflow temperature: 30.0 -# starting lake temperature: 4.0 -# +""" +Simple single lake model. Lake cut into top two layers of a 5 layer +model. Model is loosely based on the first example problem in +Merritt and Konikow (2000) which also is one of the MT3D-USGS test +problems. This test developed to isolate lake-aquifer interaction; +no SFR or other advanced packages. Problem set up to have groundwater +pass through the lake: gw inflow on the left side, gw outflow on the +right side of the lake. Uses constant stage boundary in the lake to +ensure desired flow conditions for testing budget changes with and +without VSC active. + +starting groundwater temperature: 30.0 +left chd boundary inflow temperature: 30.0 +starting lake temperature: 4.0 +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["no-vsc04-lak", "vsc04-lak"] +cases = ["no-vsc04-lak", "vsc04-lak"] viscosity_on = [False, True] # Model units @@ -157,16 +158,12 @@ # Viscosity related parameters tviscref = 20.0 -# -# MODFLOW 6 flopy GWF & GWT simulation object (sim) is returned -# - -def build_model(idx, ws): +def build_models(idx, test): global lak_lkup_dict # Base simulation and model name and workspace - name = ex[idx] + name = cases[idx] print("Building model...{}".format(name)) @@ -175,7 +172,7 @@ def build_model(idx, ws): gwtname = "gwt-" + name sim = flopy.mf6.MFSimulation( - sim_name=name, sim_ws=ws, exe_name="mf6", version="mf6" + sim_name=name, sim_ws=test.workspace, exe_name="mf6", version="mf6" ) tdis_rc = [] @@ -331,7 +328,7 @@ def build_model(idx, ws): # by setting belev==telev, MF6 will automatically # re-assign elevations based on cell dimensions h = [ - ilak, # + ilak, # ilakconn, # (k, i - 1, j), # "horizontal", # @@ -614,15 +611,13 @@ def build_model(idx, ws): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".lak.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") outbud = budobj.get_data(text=" GWF") @@ -699,24 +694,24 @@ def eval_results(sim): left_chk_with_vsc = [] right_chk_with_vsc = [] - if sim.idxsim == 0: + if idx == 0: no_vsc_bud_last = np.array(outbud[-1].tolist()) no_vsc_bud_np = np.array(no_vsc_bud_last.tolist()) - for idx in np.arange(stored_ans.shape[0]): - k, i, j = lak_lkup_dict[idx] + for ii in np.arange(stored_ans.shape[0]): + k, i, j = lak_lkup_dict[ii] # left side of lake if j < 7: - if no_vsc_bud_np[idx, 2] > 0 and stored_ans[idx, 2] > 0: - left_chk_no_vsc.append(no_vsc_bud_np[idx, 2]) - left_chk_ans.append(stored_ans[idx, 2]) + if no_vsc_bud_np[ii, 2] > 0 and stored_ans[ii, 2] > 0: + left_chk_no_vsc.append(no_vsc_bud_np[ii, 2]) + left_chk_ans.append(stored_ans[ii, 2]) # right side of lake if j > 9: - if no_vsc_bud_np[idx, 2] < 0 and stored_ans[idx, 2] < 0: - right_chk_no_vsc.append(no_vsc_bud_np[idx, 2]) - right_chk_ans.append(stored_ans[idx, 2]) + if no_vsc_bud_np[ii, 2] < 0 and stored_ans[ii, 2] < 0: + right_chk_no_vsc.append(no_vsc_bud_np[ii, 2]) + right_chk_ans.append(stored_ans[ii, 2]) # Check that all the flows entering the lak in the 'with vsc' model are greater # than their 'no vsc' counterpart @@ -737,24 +732,24 @@ def eval_results(sim): "solution." ) - elif sim.idxsim == 1: + elif idx == 1: with_vsc_bud_last = np.array(outbud[-1].tolist()) with_vsc_bud_np = np.array(with_vsc_bud_last.tolist()) - for idx in np.arange(stored_ans.shape[0]): - k, i, j = lak_lkup_dict[idx] + for ii in np.arange(stored_ans.shape[0]): + k, i, j = lak_lkup_dict[ii] # left side of lake if j < 7: - if stored_ans[idx, 2] > 0 and with_vsc_bud_np[idx, 2] > 0: - left_chk_no_vsc.append(stored_ans[idx, 2]) - left_chk_with_vsc.append(with_vsc_bud_np[idx, 2]) + if stored_ans[ii, 2] > 0 and with_vsc_bud_np[ii, 2] > 0: + left_chk_no_vsc.append(stored_ans[ii, 2]) + left_chk_with_vsc.append(with_vsc_bud_np[ii, 2]) # right side of lake if j > 9: - if stored_ans[idx, 2] < 0 and with_vsc_bud_np[idx, 2] < 0: - right_chk_no_vsc.append(stored_ans[idx, 2]) - right_chk_with_vsc.append(with_vsc_bud_np[idx, 2]) + if stored_ans[ii, 2] < 0 and with_vsc_bud_np[ii, 2] < 0: + right_chk_no_vsc.append(stored_ans[ii, 2]) + right_chk_with_vsc.append(with_vsc_bud_np[ii, 2]) # Check that all the flows entering the lak in the 'with vsc' model are greater # than their 'no vsc' counterpart @@ -774,17 +769,13 @@ def eval_results(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_vsc05_hfb.py b/autotest/test_gwf_vsc05_hfb.py index 490139b73e6..16d62c121a9 100644 --- a/autotest/test_gwf_vsc05_hfb.py +++ b/autotest/test_gwf_vsc05_hfb.py @@ -1,36 +1,32 @@ -# ## Test problem for VSC and HFB -# -# Uses constant head and general-head boundaries on the left and right -# sides of a 10 row by 10 column by 1 layer model to drive flow from left to -# right. Tests that a horizontal flow barrier accounts for changes in -# viscosity when temperature is simulated. Barrier is between middle two -# columns, but only cuts across the bottom 5 rows. -# Model 1: VSC inactive, uses a higher speified K that matches what the VSC -# package will come up with -# Model 2: VSC active, uses a lower K so that when VSC is applied, resulting -# K's match model 1 and should result in the same flows across the -# model domain -# Model 3: VSC inactive, uses the lower K of model 2 and checks that flows -# in model 3 are indeed lower than in model 2 when turning VSC off. -# Model simulates hot groundwater with lower viscosity resulting in -# more gw flow through the model domain.Flows that are checked are -# the row-wise flows between columns 5 and 6 (e.g., cell 5 to 6, 15 -# to 16, etc.) -# - -# Imports +""" +Uses constant head and general-head boundaries on the left and right +sides of a 10 row by 10 column by 1 layer model to drive flow from left to +right. Tests that a horizontal flow barrier accounts for changes in +viscosity when temperature is simulated. Barrier is between middle two +columns, but only cuts across the bottom 5 rows. +Model 1: VSC inactive, uses a higher speified K that matches what the VSC + package will come up with +Model 2: VSC active, uses a lower K so that when VSC is applied, resulting + K's match model 1 and should result in the same flows across the + model domain +Model 3: VSC inactive, uses the lower K of model 2 and checks that flows + in model 3 are indeed lower than in model 2 when turning VSC off. + Model simulates hot groundwater with lower viscosity resulting in + more gw flow through the model domain.Flows that are checked are + the row-wise flows between columns 5 and 6 (e.g., cell 5 to 6, 15 + to 16, etc.) +""" import os -import sys import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation +cases = ["no-vsc05-hfb", "vsc05-hfb", "no-vsc05-k"] hyd_cond = [1205.49396942506, 864.0] # Hydraulic conductivity (m/d) -ex = ["no-vsc05-hfb", "vsc05-hfb", "no-vsc05-k"] viscosity_on = [False, True, False] hydraulic_conductivity = [hyd_cond[0], hyd_cond[1], hyd_cond[1]] @@ -68,15 +64,11 @@ nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 -# -# MODFLOW 6 flopy GWF simulation object (sim) is returned -# - -def build_model(idx, dir): +def build_models(idx, test): # Base simulation and model name and workspace - ws = dir - name = ex[idx] + ws = test.workspace + name = cases[idx] print("Building model...{}".format(name)) @@ -282,22 +274,22 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # read flow results from model - name = ex[sim.idxsim] + name = cases[idx] gwfname = "gwf-" + name - sim1 = flopy.mf6.MFSimulation.load(sim_ws=sim.simpath, load_only=["dis"]) + sim1 = flopy.mf6.MFSimulation.load( + sim_ws=test.workspace, load_only=["dis"] + ) gwf = sim1.get_model(gwfname) # Get grid data grdname = gwfname + ".dis.grb" - bgf = flopy.mf6.utils.MfGrdFile(os.path.join(sim.simpath, grdname)) + bgf = flopy.mf6.utils.MfGrdFile(os.path.join(test.workspace, grdname)) ia, ja = bgf.ia, bgf.ja fname = gwfname + ".bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") outbud = budobj.get_data(text=" FLOW-JA-FACE")[-1].squeeze() @@ -330,7 +322,7 @@ def eval_results(sim): if cellm == celln - 1: vals_to_store.append([cellm, celln, outbud[ipos]]) - if sim.idxsim == 0: + if idx == 0: no_vsc_bud_last = np.array(vals_to_store) # Ensure with and without VSC simulations give nearly identical flow results @@ -339,24 +331,24 @@ def eval_results(sim): no_vsc_bud_last[:, 2], stored_ans[:, 2], atol=1e-3 ), ( "Flow in models " - + ex[0] + + cases[0] + " and the established answer should be approximately " "equal, but are not." ) - elif sim.idxsim == 1: + elif idx == 1: with_vsc_bud_last = np.array(vals_to_store) assert np.allclose( with_vsc_bud_last[:, 2], stored_ans[:, 2], atol=1e-3 ), ( "Flow in models " - + ex[1] + + cases[1] + " and the established answer should be approximately " "equal, but are not." ) - elif sim.idxsim == 2: + elif idx == 2: no_vsc_low_k_bud_last = np.array(vals_to_store) # Ensure the cell-to-cell flow between columns 5 and 6 in model @@ -364,23 +356,19 @@ def eval_results(sim): assert np.less(no_vsc_low_k_bud_last[:, 2], stored_ans[:, 2]).all(), ( "Exit flow from model the established answer " "should be greater than flow existing " - + ex[2] + + cases[2] + ", but it is not." ) # - No need to change any code below -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, ) + test.run() diff --git a/autotest/test_gwf_wel01.py b/autotest/test_gwf_wel01.py index 6217184b4de..f1984e99300 100644 --- a/autotest/test_gwf_wel01.py +++ b/autotest/test_gwf_wel01.py @@ -8,10 +8,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["wel01"] +cases = ["wel01"] # set static data nper = 1 @@ -31,15 +31,15 @@ hclose, rclose, relax = 1e-9, 1e-6, 1.0 -def build_model(idx, ws): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", - sim_ws=ws, + sim_ws=test.workspace, ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -142,16 +142,14 @@ def build_model(idx, ws): return sim, None -def eval_obs(sim): - print("evaluating well observations...") - +def check_output(idx, test): # MODFLOW 6 observations dtol = 1e-9 for file_name in ( "wel.obs.csv", "wel.obs.dup.csv", ): - fpth = os.path.join(sim.simpath, file_name) + fpth = os.path.join(test.workspace, file_name) try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -165,15 +163,15 @@ def eval_obs(sim): msg = f"maximum absolute well rates ({diffmax}) " if diffmax > dtol: - sim.success = False + test.success = False msg += f"exceeds {dtol}" assert diffmax < dtol, msg else: - sim.success = True + test.success = True print(" " + msg) # MODFLOW 6 AFR CSV output file - fpth = os.path.join(sim.simpath, "wel01.afr.csv") + fpth = os.path.join(test.workspace, "wel01.afr.csv") try: afroutput = np.genfromtxt( fpth, names=True, delimiter=",", deletechars="" @@ -188,17 +186,13 @@ def eval_obs(sim): assert np.allclose(a1, a2), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_obs, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwf_zb01.py b/autotest/test_gwf_zb01.py index dd29209ac9c..33b67b5732b 100644 --- a/autotest/test_gwf_zb01.py +++ b/autotest/test_gwf_zb01.py @@ -1,14 +1,13 @@ import os -from pathlib import Path import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["zbud6_zb01"] -htol = [None for idx in range(len(ex))] +cases = ["zbud6_zb01"] +htol = [None for _ in range(len(cases))] dtol = 1e-3 budtol = 1e-2 bud_lst = [ @@ -31,14 +30,14 @@ # static model data # temporal discretization nper = 31 -perlen = [1.0] + [365.2500000 for i in range(nper - 1)] -nstp = [1] + [6 for i in range(nper - 1)] -tsmult = [1.0] + [1.3 for i in range(nper - 1)] -# tsmult = [1.0] + [1.0 for i in range(nper - 1)] -steady = [True] + [False for i in range(nper - 1)] +perlen = [1.0] + [365.2500000 for _ in range(nper - 1)] +nstp = [1] + [6 for _ in range(nper - 1)] +tsmult = [1.0] + [1.3 for _ in range(nper - 1)] +# tsmult = [1.0] + [1.0 for _ in range(nper - 1)] +steady = [True] + [False for _ in range(nper - 1)] tdis_rc = [] -for idx in range(nper): - tdis_rc.append((perlen[idx], nstp[idx], tsmult[idx])) +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # spatial discretization data nlay, nrow, ncol = 3, 10, 10 @@ -111,13 +110,13 @@ # variant SUB package problem 3 -def build_model(idx, dir, exe): - name = ex[idx] +def build_models(idx, test): + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -217,21 +216,18 @@ def build_model(idx, dir, exe): return sim, None -def eval_zb6(sim, exe): - print("evaluating zonebudget...") - simpath = Path(sim.simpath) - +def check_output(idx, test): # build zonebudget files zones = [-1000000, 1000000, 9999999] nzones = len(zones) - with open(simpath / "zonebudget.nam", "w") as f: + with open(test.workspace / "zonebudget.nam", "w") as f: f.write("BEGIN ZONEBUDGET\n") - f.write(f" BUD {os.path.basename(sim.name)}.cbc\n") - f.write(f" ZON {os.path.basename(sim.name)}.zon\n") - f.write(f" GRB {os.path.basename(sim.name)}.dis.grb\n") + f.write(f" BUD {os.path.basename(test.name)}.cbc\n") + f.write(f" ZON {os.path.basename(test.name)}.zon\n") + f.write(f" GRB {os.path.basename(test.name)}.dis.grb\n") f.write("END ZONEBUDGET\n") - with open(simpath / f"{os.path.basename(sim.name)}.zon", "w") as f: + with open(test.workspace / f"{os.path.basename(test.name)}.zon", "w") as f: f.write("BEGIN DIMENSIONS\n") f.write(f" NCELLS {size3d}\n") f.write("END DIMENSIONS\n\n") @@ -243,18 +239,23 @@ def eval_zb6(sim, exe): # run zonebudget success, buff = flopy.run_model( - exe, + test.targets["zbud6"], "zonebudget.nam", - model_ws=sim.simpath, + model_ws=test.workspace, silent=False, report=True, ) assert success - sim.success = success + test.success = success # read data from csv file - zbd = np.genfromtxt(simpath / "zonebudget.csv", names=True, delimiter=",", deletechars="") + zbd = np.genfromtxt( + test.workspace / "zonebudget.csv", + names=True, + delimiter=",", + deletechars="", + ) # sum the data for all zones nentries = int(zbd.shape[0] / nzones) @@ -276,7 +277,9 @@ def eval_zb6(sim, exe): ion = 0 # get results from listing file - budl = flopy.utils.Mf6ListBudget(simpath / f"{os.path.basename(sim.name)}.lst") + budl = flopy.utils.Mf6ListBudget( + test.workspace / f"{os.path.basename(test.name)}.lst" + ) names = list(bud_lst) d0 = budl.get_budget(names=names)[0] dtype = d0.dtype @@ -288,11 +291,12 @@ def eval_zb6(sim, exe): for key in bud_lst: d[key] = 0.0 cobj = flopy.utils.CellBudgetFile( - simpath / f"{os.path.basename(sim.name)}.cbc", - precision="double") + test.workspace / f"{os.path.basename(test.name)}.cbc", + precision="double", + ) kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -310,89 +314,84 @@ def eval_zb6(sim, exe): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary - with open(simpath / f"{os.path.basename(sim.name)}.bud.cmp.out", "w") as f: + with open( + test.workspace / f"{os.path.basename(test.name)}.bud.cmp.out", "w" + ) as f: for i in range(diff.shape[0]): if i == 0: line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): + for key in bud_lst: line += f"{key + '_LST':>25s}" line += f"{key + '_CBC':>25s}" line += f"{key + '_DIF':>25s}" f.write(line + "\n") line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): + for ii, key in enumerate(bud_lst): line += f"{d0[key][i]:25g}" line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") # compare zone budget to cbc output diffzb = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, (key0, key) in enumerate(zip(zone_lst, bud_lst)): - diffzb[:, idx] = zbsum[key0] - d[key] + for i, (key0, key) in enumerate(zip(zone_lst, bud_lst)): + diffzb[:, i] = zbsum[key0] - d[key] diffzbmax = np.abs(diffzb).max() msg += ( f"\nmaximum absolute zonebudget-cell by cell difference ({diffzbmax}) " ) # write summary - with open(simpath / f"{os.path.basename(sim.name)}.zbud.cmp.out", "w") as f: + with open( + test.workspace / f"{os.path.basename(test.name)}.zbud.cmp.out", "w" + ) as f: for i in range(diff.shape[0]): if i == 0: line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): + for i, key in enumerate(bud_lst): line += f"{key + '_ZBUD':>25s}" line += f"{key + '_CBC':>25s}" line += f"{key + '_DIF':>25s}" f.write(line + "\n") line = f"{d['totim'][i]:10g}" - for idx, (key0, key) in enumerate(zip(zone_lst, bud_lst)): + for i, (key0, key) in enumerate(zip(zone_lst, bud_lst)): line += f"{zbsum[key0][i]:25g}" line += f"{d[key][i]:25g}" - line += f"{diffzb[i, idx]:25g}" + line += f"{diffzb[i, i]:25g}" f.write(line + "\n") if diffmax > budtol or diffzbmax > budtol: - sim.success = False + test.success = False msg += f"\n...exceeds {budtol}" assert diffmax < budtol and diffzbmax < budtol, msg else: - sim.success = True + test.success = True print(" " + msg) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - mf6 = targets.mf6 - zb6 = targets.zbud6 - test = TestFramework() - test.build(lambda i, w: build_model(i, w, mf6), idx, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=lambda s: eval_zb6(s, zb6), - htol=htol[idx], - idxsim=idx, - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol[idx], ) + test.run() diff --git a/autotest/test_gwfgwf.py b/autotest/test_gwfgwf.py new file mode 100644 index 00000000000..f29e05d7ce8 --- /dev/null +++ b/autotest/test_gwfgwf.py @@ -0,0 +1,218 @@ +""" +Test a constant head boundary assigned to one model as +also functioning as a constant head boundary assigned to +a connected model. The constant head term for model 1 +should be calculated to include the flow from model 2. +Also, the flowja budget term for the constant head cell +should have a correct residual of zero in the diagonal +position. + + 1 1 -1 gwf1 + - - - + 1 1 1 gwf2 + +We assert equality on qresidual being less than tolerance and +also that total constant head flow is correct. +""" + +import os +import pathlib as pl +import math +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["gwfgwf01", "gwfgwf01ifmod"] +ifmod = [False, True] + + +def build_models(idx, test): + sim = get_sim(idx, test.workspace) + return sim, None + + +def get_sim(idx, dir): + name = cases[idx] + + # solver data + nouter, ninner = 100, 300 + hclose, rclose, relax = 1.e-8, 1e-8, 0.97 + + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir + ) + + tdis = flopy.mf6.ModflowTdis( + sim, + time_units="DAYS", + nper=1, + perioddata=[(1.0, 1, 1)], + ) + + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="DBD", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + relaxation_factor=relax, + ) + + gwf0 = add_model(sim, "gwf1", top=0., add_chd=True, add_rch=True) + gwf1 = add_model(sim, "gwf2", top=-1., add_chd=False, add_rch=False) + gwfgwf = add_gwfexchange(sim, idx) + + return sim + + +def add_model(sim, modelname, top, add_chd, add_rch): + + nlay, nrow, ncol = 1, 1, 3 + botm = top - 1.0 + gwf = flopy.mf6.ModflowGwf(sim, modelname=modelname, save_flows=True) + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=1.0, + delc=1.0, + top=top, + botm=botm, + ) + ic = flopy.mf6.ModflowGwfic(gwf, strt=0.) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=True, + save_flows=True, + icelltype=0, + k=1.0, + ) + + if add_chd: + chdlist = [(0, 0, ncol-1, 0.)] + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdlist) + + if add_rch: + rch = flopy.mf6.ModflowGwfrcha(gwf, recharge=0.001) + + oc = flopy.mf6.ModflowGwfoc( + gwf, + head_filerecord=f"{modelname}.hds", + budget_filerecord=f"{modelname}.cbc", + budgetcsv_filerecord=f"{modelname}.cbc.csv", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + return gwf + + +def add_gwfexchange(sim, idx): + ncol = 3 + delr = 1. + delc = 1. + dz = 1. + angldegx = 0.0 + cdist = 1.0 + gwfgwf_data = [ + [ + (0, 0, icol), + (0, 0, icol), + 0, + dz / 2.0, + dz / 2.0, + delr * delc, + angldegx, + cdist, + ] + for icol in range(ncol) + ] + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + save_flows=True, + print_flows=True, + nexg=len(gwfgwf_data), + exgmnamea="gwf1", + exgmnameb="gwf2", + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + dev_interfacemodel_on=ifmod[idx], + ) + return gwfgwf + + +def check_output(idx, test): + sim = test.sims[0] + check_model(sim, 0) + check_model(sim, 1) + + +def check_model(sim, model_number): + print (f"Checking model output (gwf{model_number})") + gwf = sim.gwf[model_number] + sim_ws = pl.Path(sim.sim_path) + fpth = sim_ws / f"gwf{model_number + 1}.dis.grb" + grb = flopy.mf6.utils.MfGrdFile(fpth) + ia = grb.ia + + bobj = gwf.output.budget() + # print(bobj.list_records()) + budget_records = bobj.get_data(kstpkper=(0, 0)) + nrecords = len(budget_records) + print(f"detected {nrecords} items in budget file.") + for idx in range(nrecords): + budget_record = bobj.get_data(idx=idx)[0] + print(budget_record) + + model_budget = gwf.output.budgetcsv().data + pd = model_budget["PERCENT_DIFFERENCE"][0] + print("percent difference: ", model_budget["PERCENT_DIFFERENCE"]) + errmsg = f"Model percent difference is too large (pd)" + assert pd < 1.e-6, errmsg + + # check residual budget term in flowja diagonal position + fja = bobj.get_data(text="FLOW-JA-FACE")[0].flatten() + success = True + atol = 1.e-7 + for ipos in ia[:-1]: + print(ipos, fja[ipos]) + if fja[ipos] > atol: + success = False + assert success, f"flowja residual larger than tolerance ({atol})" + + # ensure that the constant head outflow is equal to the + # specified recharge + if model_number == 0: + chdflows = bobj.get_data(text="chd")[0] + vchd = -chdflows["q"][0] + vexgchd = model_budget["FLOW-JA-FACE-CHD(GWF-GWF_1)_OUT"][0] + v = vchd + vexgchd + errmsg = ( + f"Constant head outflow ({v}) is not equal to the " + f"specified recharge inflow (0.002)." + ) + assert math.isclose(v, 0.002), errmsg + + return + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +@pytest.mark.developmode +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwfgwf_lgr.py b/autotest/test_gwfgwf_lgr.py index 2ac991d04e5..6292114b406 100644 --- a/autotest/test_gwfgwf_lgr.py +++ b/autotest/test_gwfgwf_lgr.py @@ -28,20 +28,19 @@ ensure that vertical flows and horizontal flows are added correctly to each model flowja diagonal terms. This diagonal term contains the flow residual for the cell. - """ + import os import flopy import numpy as np import pytest from flopy.utils.lgrutil import Lgr + from framework import TestFramework -from simulation import TestSimulation -ex = ["gwfgwf_lgr_classic", "gwfgwf_lgr_ifmod"] +cases = ["gwfgwf_lgr_classic", "gwfgwf_lgr_ifmod"] ifmod = [False, True] - parent_name = "parent" child_name = "child" h_left = 1.0 @@ -52,11 +51,11 @@ k33 = 1.0 -def get_model(idx, dir): +def get_model(idx, test): global child_domain global hclose - name = ex[idx] + name = cases[idx] # tdis period data nper = 1 @@ -109,7 +108,7 @@ def get_model(idx, dir): chd_spd = {0: chd_data} # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -238,30 +237,30 @@ def get_model(idx, dir): return sim -def build_model(idx, exdir): +def build_models(idx, exdir): sim = get_model(idx, exdir) return sim, None -def eval_heads(sim): +def check_output(idx, test): print("comparing heads for child model to analytical result...") - fpth = os.path.join(sim.simpath, f"{child_name}.hds") + fpth = os.path.join(test.workspace, f"{child_name}.hds") hds_c = flopy.utils.HeadFile(fpth) heads_c = hds_c.get_data() - fpth = os.path.join(sim.simpath, f"{child_name}.dis.grb") + fpth = os.path.join(test.workspace, f"{child_name}.dis.grb") grb_c = flopy.mf6.utils.MfGrdFile(fpth) # check flowja residual for mname in [parent_name, child_name]: print(f"Checking flowja residual for model {mname}") - fpth = os.path.join(sim.simpath, f"{mname}.dis.grb") + fpth = os.path.join(test.workspace, f"{mname}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) ia = grb._datadict["IA"] - 1 - fpth = os.path.join(sim.simpath, f"{mname}.cbc") + fpth = os.path.join(test.workspace, f"{mname}.cbc") assert os.path.isfile(fpth) cbb = flopy.utils.CellBudgetFile(fpth, precision="double") flow_ja_face = cbb.get_data(idx=0) @@ -276,18 +275,14 @@ def eval_heads(sim): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_heads, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv01.py b/autotest/test_gwt_adv01.py index 7132f16d38e..62c41a4649d 100644 --- a/autotest/test_gwt_adv01.py +++ b/autotest/test_gwt_adv01.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for a one-dimensional model grid of square cells. - """ import os @@ -10,14 +8,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv01a", "adv01b", "adv01c"] +cases = ["adv01a", "adv01b", "adv01c"] scheme = ["upstream", "central", "tvd"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -42,10 +40,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -241,13 +239,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -585,21 +581,17 @@ def eval_transport(sim): creslist = [cres1, cres2, cres3] assert np.allclose( - creslist[sim.idxsim], conc + creslist[idx], conc ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv01_fmi.py b/autotest/test_gwt_adv01_fmi.py index 84faee0f9a0..d40dd4cf7b1 100644 --- a/autotest/test_gwt_adv01_fmi.py +++ b/autotest/test_gwt_adv01_fmi.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for a one-dimensional model grid of square cells. - """ import os @@ -12,14 +10,14 @@ import pytest from flopy.utils.binaryfile import write_budget, write_head from flopy.utils.gridutil import uniform_flow_field + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv01a_fmi", "adv01b_fmi", "adv01c_fmi"] +cases = ["adv01a_fmi", "adv01b_fmi", "adv01c_fmi"] scheme = ["upstream", "central", "tvd"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -41,10 +39,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -217,13 +215,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -561,21 +557,17 @@ def eval_transport(sim): creslist = [cres1, cres2, cres3] assert np.allclose( - creslist[sim.idxsim], conc + creslist[idx], conc ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv01_gwtgwt.py b/autotest/test_gwt_adv01_gwtgwt.py index 29624b7054a..f003beb121e 100644 --- a/autotest/test_gwt_adv01_gwtgwt.py +++ b/autotest/test_gwt_adv01_gwtgwt.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for a one-dimensional model grid of square cells. - """ import os @@ -10,13 +8,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv01a_gwtgwt", "adv01b_gwtgwt", "adv01c_gwtgwt"] +cases = ["adv01a_gwtgwt", "adv01b_gwtgwt", "adv01c_gwtgwt"] scheme = ["upstream", "central", "tvd"] gdelr = 1.0 +# solver settings +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-6, 1e-6, 1.0 + def get_gwf_model(sim, gwfname, gwfpath, modelshape, chdspd=None, welspd=None): nlay, nrow, ncol, xshift, yshift = modelshape @@ -33,8 +35,6 @@ def get_gwf_model(sim, gwfname, gwfpath, modelshape, chdspd=None, welspd=None): modelname=gwfname, save_flows=True, ) - # this doesn't work here - # gwf.set_model_relative_path(gwfname) dis = flopy.mf6.ModflowGwfdis( gwf, @@ -177,8 +177,7 @@ def get_gwt_model( return gwt -def build_model(idx, dir): - +def build_models(idx, test): # temporal discretization nper = 1 perlen = [5.0] @@ -189,7 +188,7 @@ def build_model(idx, dir): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=ws, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -198,10 +197,6 @@ def build_model(idx, dir): sim, time_units="DAYS", nper=nper, perioddata=tdis_rc, pname="sim.tdis" ) - # solver settings - nouter, ninner = 100, 300 - hclose, rclose, relax = 1e-6, 1e-6, 1.0 - # grid information nlay, nrow, ncol = 1, 1, 50 @@ -335,12 +330,10 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - +def check_output(idx, test): gwtname = "transport1" - fpth = os.path.join(sim.simpath, gwtname, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, gwtname, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -351,7 +344,7 @@ def eval_transport(sim): gwtname = "transport2" - fpth = os.path.join(sim.simpath, gwtname, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, gwtname, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -689,12 +682,12 @@ def eval_transport(sim): creslist = [cres1, cres2, cres3] assert np.allclose( - creslist[sim.idxsim], conc + creslist[idx], conc ), "simulated concentrations do not match with known solution." # check budget for mname in ["transport1", "transport2"]: - fpth = os.path.join(sim.simpath, mname, f"{mname}.lst") + fpth = os.path.join(test.workspace, mname, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -706,13 +699,13 @@ def eval_transport(sim): # get grid data (from GWF) gwfname = "flow1" if mname == "transport1" else "flow2" - fpth = os.path.join(sim.simpath, gwfname, f"{gwfname}.dis.grb") + fpth = os.path.join(test.workspace, gwfname, f"{gwfname}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) # Check on residual, which is stored in diagonal position of # flow-ja-face. Residual should be less than convergence tolerance, # or this means the residual term is not added correctly. - fpth = os.path.join(sim.simpath, mname, f"{mname}.cbc") + fpth = os.path.join(test.workspace, mname, f"{mname}.cbc") cbb = flopy.utils.CellBudgetFile(fpth) flow_ja_face = cbb.get_data(text="FLOW-JA-FACE") ia = grb._datadict["IA"] - 1 @@ -726,18 +719,14 @@ def eval_transport(sim): # assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv02.py b/autotest/test_gwt_adv02.py index 4d0a5ba635b..1252d353ce9 100644 --- a/autotest/test_gwt_adv02.py +++ b/autotest/test_gwt_adv02.py @@ -1,10 +1,8 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for a one-dimensional model grid of triangular cells. The cells are created by starting with a regular grid of squares and then cutting every cell into a triangle, except the first and last. - """ import os @@ -13,10 +11,10 @@ import flopy.utils.cvfdutil import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv02a", "adv02b", "adv02c"] +cases = ["adv02a", "adv02b", "adv02c"] scheme = ["upstream", "central", "tvd"] @@ -65,7 +63,7 @@ def cvfd_to_cell2d(verts, iverts): return vertices, cell2d -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -87,10 +85,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -300,13 +298,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -938,21 +934,17 @@ def eval_transport(sim): creslist = [cres1, cres2, cres3] assert np.allclose( - creslist[sim.idxsim], conc + creslist[idx], conc ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv03.py b/autotest/test_gwt_adv03.py index 5134fe038f7..562e2567b43 100644 --- a/autotest/test_gwt_adv03.py +++ b/autotest/test_gwt_adv03.py @@ -1,10 +1,8 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for a three-dimensional model grid of triangular cells. The cells are created by starting with a regular grid of squares and then cutting every cell into a triangle, except the first and last. - """ import os @@ -13,10 +11,10 @@ import flopy.utils.cvfdutil import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv03a", "adv03b", "adv03c"] +cases = ["adv03a", "adv03b", "adv03c"] scheme = ["upstream", "central", "tvd"] @@ -65,7 +63,7 @@ def cvfd_to_cell2d(verts, iverts): return vertices, cell2d -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 5, 10, 20 nper = 1 delr = 1.0 @@ -93,10 +91,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -331,13 +329,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -482,29 +478,25 @@ def eval_transport(sim): # dimensional creslist = [cres1, cres2, cres3] ncellsperrow = cres1.shape[0] - assert np.allclose(creslist[sim.idxsim], conc[0, 0, 0:ncellsperrow]), ( + assert np.allclose(creslist[idx], conc[0, 0, 0:ncellsperrow]), ( "simulated concentrations do not match with known solution.", - creslist[sim.idxsim], + creslist[idx], conc[0, 0, -ncellsperrow:], ) - assert np.allclose(creslist[sim.idxsim], conc[0, 0, -ncellsperrow:]), ( + assert np.allclose(creslist[idx], conc[0, 0, -ncellsperrow:]), ( "simulated concentrations do not match with known solution.", - creslist[sim.idxsim], + creslist[idx], conc[0, 0, -ncellsperrow:], ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_adv04.py b/autotest/test_gwt_adv04.py index 49c1ca45690..40d1b76ff25 100644 --- a/autotest/test_gwt_adv04.py +++ b/autotest/test_gwt_adv04.py @@ -1,9 +1,7 @@ """ -MODFLOW 6 Autotest Test the advection schemes in the gwt advection package for two-dimensional injection of solute into the middle of a square grid. The test will pass if the results are symmetric. - """ import os @@ -11,14 +9,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["adv04a", "adv04b", "adv04c"] +cases = ["adv04a", "adv04b", "adv04c"] scheme = ["upstream", "central", "tvd"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 21, 21 nper = 1 perlen = [5.0] @@ -55,10 +53,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -228,13 +226,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -257,17 +253,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_buy_solute_heat.py b/autotest/test_gwt_buy_solute_heat.py index 173dfd60b04..d8f4c52740a 100644 --- a/autotest/test_gwt_buy_solute_heat.py +++ b/autotest/test_gwt_buy_solute_heat.py @@ -3,14 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["gwtbuy"] +from framework import TestFramework +cases = ["gwtbuy"] -def build_model(idx, dir): +def build_models(idx, test): lx = 2000.0 lz = 1000.0 @@ -35,10 +34,10 @@ def build_model(idx, dir): nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -331,7 +330,7 @@ def build_model(idx, dir): def make_plot(sim): print("making plots...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "flow" gwtsname = "salinity" @@ -410,14 +409,12 @@ def make_plot(sim): return -def eval_transport(sim): - print("evaluating transport...") - +def check_output(idx, test): makeplot = False if makeplot: - make_plot(sim) + make_plot(test) - ws = sim.simpath + ws = test.workspace gwfname = "flow" gwtsname = "salinity" gwthname = "temperature" @@ -448,7 +445,6 @@ def eval_transport(sim): densecalculated = 1000.0 + 0.7 * c - 0.375 * (t - 25.0) if not np.allclose(d, densecalculated): - print("density is not correct") fname = os.path.join(ws, "a-dense.txt") np.savetxt(fname, d.reshape(200, 100)) @@ -462,17 +458,13 @@ def eval_transport(sim): @pytest.mark.slow -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_disu01.py b/autotest/test_gwt_disu01.py index a9aad3dfdf6..1a457e402a7 100644 --- a/autotest/test_gwt_disu01.py +++ b/autotest/test_gwt_disu01.py @@ -1,9 +1,7 @@ """ -MODFLOW 6 Autotest Two-dimensional injection of solute into the middle of a square grid. The test will pass if the results are symmetric. Based on test_gwt_adv04, this tests the disu package, which represents a regular MODFLOW grid. - """ import os @@ -12,13 +10,13 @@ import numpy as np import pytest from flopy.utils.gridutil import get_disu_kwargs + from framework import TestFramework -from simulation import TestSimulation -ex = ["disu01a"] +cases = ["disu01a"] -def build_model(idx, dir, exe): +def build_models(idx, test): nlay, nrow, ncol = 1, 21, 21 nper = 1 perlen = [5.0] @@ -59,12 +57,12 @@ def get_nn(k, i, j): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -220,13 +218,11 @@ def get_nn(k, i, j): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -250,18 +246,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - mf6 = targets.mf6 - test = TestFramework() - test.build(lambda i, w: build_model(i, w, mf6), 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp01.py b/autotest/test_gwt_dsp01.py index 7d392cb225d..871871c89c5 100644 --- a/autotest/test_gwt_dsp01.py +++ b/autotest/test_gwt_dsp01.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp01a", "dsp01b"] +cases = ["dsp01a", "dsp01b"] xt3d = [False, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -38,10 +38,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -240,13 +240,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -370,33 +368,26 @@ def eval_transport(sim): # load the gwt observation file fname = gwtname + ".obs.csv" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) gwtobs = np.genfromtxt(fname, names=True, delimiter=",", deletechars="") # load the cnc observation file fname = gwtname + ".cnc.obs.csv" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cncobs = np.genfromtxt(fname, names=True, delimiter=",", deletechars="") # ensure flow right face for first cell is equal to cnc flows errmsg = f"observations not equal:\n{gwtobs}\n{cncobs}" assert np.allclose(gwtobs["FLOW1"], -cncobs["CNC000"]), errmsg - # comment when done testing - # assert False - -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp01_fmi.py b/autotest/test_gwt_dsp01_fmi.py index 424d467a702..8c09530efab 100644 --- a/autotest/test_gwt_dsp01_fmi.py +++ b/autotest/test_gwt_dsp01_fmi.py @@ -4,14 +4,14 @@ import numpy as np import pytest from flopy.utils.binaryfile import write_budget, write_head + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp01a_fmi", "dsp01b_fmi"] +cases = ["dsp01a_fmi", "dsp01b_fmi"] xt3d = [False, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -39,10 +39,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -191,13 +191,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -320,17 +318,13 @@ def eval_transport(sim): ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp01_gwtgwt.py b/autotest/test_gwt_dsp01_gwtgwt.py index ab29408fa09..912bbdcf329 100644 --- a/autotest/test_gwt_dsp01_gwtgwt.py +++ b/autotest/test_gwt_dsp01_gwtgwt.py @@ -1,7 +1,5 @@ """ -MODFLOW 6 Autotest Test basic dispersion for two coupled gwt models. - """ import os @@ -9,12 +7,16 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp01_gwtgwt"] +cases = ["dsp01_gwtgwt"] gdelr = 1.0 +# solver settings +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-6, 1e-6, 1.0 + def get_gwf_model(sim, gwfname, gwfpath, modelshape): nlay, nrow, ncol, xshift, yshift = modelshape @@ -31,8 +33,6 @@ def get_gwf_model(sim, gwfname, gwfpath, modelshape): modelname=gwfname, save_flows=True, ) - # this doesn't work here - # gwf.set_model_relative_path(gwfname) dis = flopy.mf6.ModflowGwfdis( gwf, @@ -139,8 +139,7 @@ def get_gwt_model(sim, gwtname, gwtpath, modelshape): return gwt -def build_model(idx, dir): - +def build_models(idx, test): # temporal discretization nper = 1 perlen = [5.0] @@ -151,7 +150,7 @@ def build_model(idx, dir): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=ws, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -268,10 +267,9 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - +def check_output(idx, test): gwtname = "transport1" - fpth = os.path.join(sim.simpath, "transport1", f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, "transport1", f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -281,7 +279,7 @@ def eval_transport(sim): assert False, f'could not load data from "{fpth}"' gwtname = "transport2" - fpth = os.path.join(sim.simpath, "transport2", f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, "transport2", f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -298,18 +296,14 @@ def eval_transport(sim): assert abs(np.sum(conc1) + np.sum(conc2) - 100.0) < 1e-6 -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) @pytest.mark.developmode def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp01_noadv.py b/autotest/test_gwt_dsp01_noadv.py index b5864f0bb19..f7577b073af 100644 --- a/autotest/test_gwt_dsp01_noadv.py +++ b/autotest/test_gwt_dsp01_noadv.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp01a_noadv", "dsp01b_noadv"] +cases = ["dsp01a_noadv", "dsp01b_noadv"] xt3d = [False, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -38,10 +38,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -135,13 +135,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -264,17 +262,13 @@ def eval_transport(sim): ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp02.py b/autotest/test_gwt_dsp02.py index 0b245e78058..192cafc8367 100644 --- a/autotest/test_gwt_dsp02.py +++ b/autotest/test_gwt_dsp02.py @@ -1,10 +1,8 @@ """ -MODFLOW 6 Autotest Test the dispersion schemes in the gwt dispersion package for a one-dimensional model grid of triangular cells. The cells are created by starting with a regular grid of squares and then cutting every cell into a triangle, except the first and last. - """ import os @@ -13,10 +11,10 @@ import flopy.utils.cvfdutil import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp02a", "dsp02b"] +cases = ["dsp02a", "dsp02b"] xt3d = [True, False] @@ -65,7 +63,7 @@ def cvfd_to_cell2d(verts, iverts): return vertices, cell2d -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -87,10 +85,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -277,13 +275,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -709,21 +705,17 @@ def eval_transport(sim): creslist = [cres1, cres2] assert np.allclose( - creslist[sim.idxsim], conc + creslist[idx], conc ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp03.py b/autotest/test_gwt_dsp03.py index 7eb77075c88..7714e1e1f87 100644 --- a/autotest/test_gwt_dsp03.py +++ b/autotest/test_gwt_dsp03.py @@ -1,10 +1,8 @@ """ -MODFLOW 6 Autotest Test the dispersion schemes in the gwt dispersion package for a three-dimensional model grid of triangular cells. The cells are created by starting with a regular grid of squares and then cutting every cell into a triangle, except the first and last. - """ import os @@ -13,10 +11,10 @@ import flopy.utils.cvfdutil import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp03a", "dsp03b"] +cases = ["dsp03a", "dsp03b"] xt3d = [False, True] @@ -65,7 +63,7 @@ def cvfd_to_cell2d(verts, iverts): return vertices, cell2d -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 5, 10, 20 nper = 1 delr = 1.0 @@ -93,10 +91,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -318,13 +316,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -427,30 +423,26 @@ def eval_transport(sim): # dimensional creslist = [cres1, cres2] ncellsperrow = cres1.shape[0] - assert np.allclose(creslist[sim.idxsim], conc[0, 0, 0:ncellsperrow]), ( + assert np.allclose(creslist[idx], conc[0, 0, 0:ncellsperrow]), ( "simulated concentrations do not match with known solution.", - creslist[sim.idxsim], + creslist[idx], conc[0, 0, -ncellsperrow:], ) - assert np.allclose(creslist[sim.idxsim], conc[0, 0, -ncellsperrow:]), ( + assert np.allclose(creslist[idx], conc[0, 0, -ncellsperrow:]), ( "simulated concentrations do not match with known solution.", - creslist[sim.idxsim], + creslist[idx], conc[0, 0, -ncellsperrow:], ) @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp04.py b/autotest/test_gwt_dsp04.py index aa9d1b02206..ab14cfb8022 100644 --- a/autotest/test_gwt_dsp04.py +++ b/autotest/test_gwt_dsp04.py @@ -3,15 +3,15 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation # test dispersion without and with xt3d -ex = ["dsp04a", "dsp04b"] +cases = ["dsp04a", "dsp04b"] xt3d = [None, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 21, 21 nper = 1 perlen = [5.0] @@ -45,10 +45,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -222,13 +222,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -251,17 +249,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_dsp05_noadv.py b/autotest/test_gwt_dsp05_noadv.py index 93af5361d4d..e5a2f0675f8 100644 --- a/autotest/test_gwt_dsp05_noadv.py +++ b/autotest/test_gwt_dsp05_noadv.py @@ -1,23 +1,21 @@ """ -MODFLOW 6 Autotest Test variable layer thicknesses with a diffusion problem and constant concentrations on the top and bottom to make sure the resulting concentration field is linear from top to bottom. - """ import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["dsp05a_noadv", "dsp01b_noadv"] +cases = ["dsp05a_noadv", "dsp01b_noadv"] xt3d = [False, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 5, 1, 1 nper = 1 perlen = [5.0] @@ -36,10 +34,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -133,13 +131,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -161,17 +157,13 @@ def eval_transport(sim): assert np.allclose(cres, conc.flatten()), msg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_fmi01.py b/autotest/test_gwt_fmi01.py index fcf6a9e0251..93d6a344b06 100644 --- a/autotest/test_gwt_fmi01.py +++ b/autotest/test_gwt_fmi01.py @@ -5,14 +5,14 @@ import pytest from flopy.utils.binaryfile import write_budget, write_head from flopy.utils.gridutil import uniform_flow_field + from framework import TestFramework -from simulation import TestSimulation -ex = ["fmi01a_fc"] +cases = ["fmi01a_fc"] xt3d = [False, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 3 nper = 1 perlen = [1.0] @@ -38,10 +38,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -173,13 +173,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() @@ -191,17 +189,13 @@ def eval_transport(sim): assert np.allclose(cres, conc), errmsg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_fmi02.py b/autotest/test_gwt_fmi02.py index 545428e55e9..6271c115ae5 100644 --- a/autotest/test_gwt_fmi02.py +++ b/autotest/test_gwt_fmi02.py @@ -1,4 +1,4 @@ -# tests to ability to run flow model first followed by transport model +"""Tests to ability to run flow model first followed by transport model""" import os diff --git a/autotest/test_gwt_henry.py b/autotest/test_gwt_henry.py index 19d3e93fd40..2bbc4b71fc9 100644 --- a/autotest/test_gwt_henry.py +++ b/autotest/test_gwt_henry.py @@ -3,14 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["henry01"] +from framework import TestFramework +cases = ["henry01"] -def build_model(idx, dir): +def build_models(idx, test): lx = 2.0 lz = 1.0 @@ -35,10 +34,10 @@ def build_model(idx, dir): nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -231,13 +230,11 @@ def chd_value(k): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -289,17 +286,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_henry_gwtgwt.py b/autotest/test_gwt_henry_gwtgwt.py new file mode 100644 index 00000000000..362f627f525 --- /dev/null +++ b/autotest/test_gwt_henry_gwtgwt.py @@ -0,0 +1,439 @@ +import os + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["henry01-gwtgwt-ups", "henry01-gwtgwt-cen", "henry01-gwtgwt-tvd"] +advection_scheme = ["UPSTREAM", "CENTRAL", "TVD"] + +lx = 2.0 +lz = 1.0 + +nlay = 10 +nrow = 1 +ncol = 20 +ncol_sub = 10 +nper = 1 +delr = lx / ncol +delc = 1.0 +top = 1.0 +delz = lz / nlay +botm = list(top - np.arange(delz, nlay * delz + delz, delz)) + +perlen = [0.5] +nstp = [500] +tsmult = [1.0] +steady = [True] +tdis_rc = [] +for i in range(nper): + tdis_rc.append((perlen[i], nstp[i], tsmult[i])) + +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-10, 1e-9, 0.97 + +# tolerance for concentrations, relate to hclose and rclose +conc_tol = 1e-06 + +hc = 864.0 + + +def get_gwf_model(sim, model_shape, model_desc): + nlay, nrow, ncol = model_shape + + # create gwf model + gwfname = "gwf_" + model_desc + gwtname = "gwt_" + model_desc + + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname) + + xoff = 0.0 + yoff = 0.0 + if model_desc == "right": + xoff = ncol * delr + + _ = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + xorigin=xoff, + yorigin=yoff, + ) + + # initial conditions + _ = flopy.mf6.ModflowGwfic(gwf, strt=1.0) + + # node property flow + _ = flopy.mf6.ModflowGwfnpf( + gwf, + xt3doptions=False, + save_flows=True, + save_specific_discharge=True, + icelltype=0, + k=hc, + ) + + pd = [(0, 0.7, 0.0, gwtname, "none")] + _ = flopy.mf6.ModflowGwfbuy( + gwf, + packagedata=pd, + ) + + def chd_value(k): + # depth = k * delz + 0.5 * delz + # hf = top + 0.025 * depth + hf = top + return hf + + # chd files for right model + if not model_desc == "left": + chdlist1 = [] + for k in range(nlay): + chdlist1.append([(k, 0, ncol - 1), chd_value(k), 35.0]) + _ = flopy.mf6.ModflowGwfchd( + gwf, + stress_period_data=chdlist1, + print_input=True, + print_flows=True, + save_flows=False, + pname="CHD-1", + auxiliary="CONCENTRATION", + filename=f"{gwfname}.chd", + ) + + # WEL for left model + if not model_desc == "right": + wellist1 = [] + qwell = 5.7024 / nlay + for k in range(nlay): + wellist1.append([(k, 0, 0), qwell, 0.0]) + _ = flopy.mf6.ModflowGwfwel( + gwf, + stress_period_data=wellist1, + print_input=True, + print_flows=True, + save_flows=False, + pname="WEL-1", + auxiliary="CONCENTRATION", + filename=f"{gwfname}.wel", + ) + + # output control + _ = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwfname}.cbc", + head_filerecord=f"{gwfname}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + return gwf + + +def get_gwt_model(sim, model_shape, model_desc, adv_scheme): + nlay, nrow, ncol = model_shape + + # create gwf model + gwtname = "gwt_" + model_desc + + # create gwt model + gwt = flopy.mf6.ModflowGwt(sim, modelname=gwtname) + + xoff = 0.0 + yoff = 0.0 + if model_desc == "right": + xoff = ncol * delr + + _ = flopy.mf6.ModflowGwtdis( + gwt, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + xorigin=xoff, + yorigin=yoff, + ) + + # initial conditions + _ = flopy.mf6.ModflowGwtic(gwt, strt=35.0, filename=f"{gwtname}.ic") + + # advection + _ = flopy.mf6.ModflowGwtadv( + gwt, scheme=adv_scheme, filename=f"{gwtname}.adv" + ) + + # dispersion + diffc = 0.57024 + _ = flopy.mf6.ModflowGwtdsp( + gwt, + xt3d_off=True, + diffc=diffc, + # alh=0., alv=0., ath=0., atv=0., + filename=f"{gwtname}.dsp", + ) + + # mass storage and transfer + porosity = 0.35 + _ = flopy.mf6.ModflowGwtmst( + gwt, porosity=porosity, filename=f"{gwtname}.sto" + ) + + # sources + if model_desc == "right": + sourcerecarray = [ + ("CHD-1", "AUX", "CONCENTRATION"), + ] + elif model_desc == "left": + sourcerecarray = [ + ("WEL-1", "AUX", "CONCENTRATION"), + ] + elif model_desc == "ref": + sourcerecarray = [ + ("WEL-1", "AUX", "CONCENTRATION"), + ("CHD-1", "AUX", "CONCENTRATION"), + ] + + _ = flopy.mf6.ModflowGwtssm( + gwt, sources=sourcerecarray, filename=f"{gwtname}.ssm" + ) + + # output control + _ = flopy.mf6.ModflowGwtoc( + gwt, + budget_filerecord=f"{gwtname}.cbc", + concentration_filerecord=f"{gwtname}.ucn", + concentrationprintrecord=[ + ("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL") + ], + saverecord=[("CONCENTRATION", "ALL")], + printrecord=[("CONCENTRATION", "LAST"), ("BUDGET", "LAST")], + ) + + return gwt + + +def build_models(idx, test): + name = cases[idx] + print("RUINNING: ", name, advection_scheme[idx]) + + # build MODFLOW 6 files + ws = test.workspace + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, + ) + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create flow models and GWF-GWF exchange + gwf_ref = get_gwf_model(sim, (nlay, nrow, ncol), "ref") + gwf_left = get_gwf_model(sim, (nlay, nrow, ncol_sub), "left") + gwf_right = get_gwf_model(sim, (nlay, nrow, ncol_sub), "right") + + imsgwf_ref = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + filename="gwf.ims", + ) + sim.register_ims_package( + imsgwf_ref, [gwf_ref.name, gwf_left.name, gwf_right.name] + ) + + angldegx = 0.0 + cdist = delr + gwfgwf_data = [ + [ + (ilay, 0, ncol_sub - 1), + (ilay, 0, 0), + 1, + 0.5 * delr, + 0.5 * delr, + delc, + angldegx, + cdist, + ] + for ilay in range(nlay) + ] + _ = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(gwfgwf_data), + exgmnamea=gwf_left.name, + exgmnameb=gwf_right.name, + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + filename="leftright.gwfgwf", + dev_interfacemodel_on=True, + ) + + # create transport models and GWT-GWT exchange + gwt_ref = get_gwt_model( + sim, (nlay, nrow, ncol), "ref", advection_scheme[idx] + ) + gwt_left = get_gwt_model( + sim, (nlay, nrow, ncol_sub), "left", advection_scheme[idx] + ) + gwt_right = get_gwt_model( + sim, (nlay, nrow, ncol_sub), "right", advection_scheme[idx] + ) + + imsgwt_ref = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + outer_dvclose=hclose, + outer_maximum=nouter, + under_relaxation="NONE", + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + scaling_method="NONE", + reordering_method="NONE", + relaxation_factor=relax, + filename="gwt.ims", + ) + sim.register_ims_package( + imsgwt_ref, [gwt_ref.name, gwt_left.name, gwt_right.name] + ) + + _ = flopy.mf6.ModflowGwtgwt( + sim, + exgtype="GWT6-GWT6", + gwfmodelname1=gwf_left.name, + gwfmodelname2=gwf_right.name, + adv_scheme=advection_scheme[idx], + nexg=len(gwfgwf_data), + exgmnamea=gwt_left.name, + exgmnameb=gwt_right.name, + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + filename="leftright.gwtgwt", + ) + + # Finally connect flow to transport: GWF GWT exchange + _ = flopy.mf6.ModflowGwfgwt( + sim, + exgtype="GWF6-GWT6", + exgmnamea=gwf_ref.name, + exgmnameb=gwt_ref.name, + filename="ref.gwfgwt", + ) + + _ = flopy.mf6.ModflowGwfgwt( + sim, + exgtype="GWF6-GWT6", + exgmnamea=gwf_left.name, + exgmnameb=gwt_left.name, + filename="left.gwfgwt", + ) + + _ = flopy.mf6.ModflowGwfgwt( + sim, + exgtype="GWF6-GWT6", + exgmnamea=gwf_right.name, + exgmnameb=gwt_right.name, + filename="right.gwfgwt", + ) + + return sim, None + + +def check_output(idx, test): + fpth = os.path.join(test.workspace, "gwf_ref.hds") + hds = flopy.utils.HeadFile(fpth) + heads = hds.get_data() + + fpth = os.path.join(test.workspace, "gwf_left.hds") + hds = flopy.utils.HeadFile(fpth) + heads_left = hds.get_data() + + fpth = os.path.join(test.workspace, "gwf_right.hds") + hds = flopy.utils.HeadFile(fpth) + heads_right = hds.get_data() + + heads_gwfgwf = np.append(heads_left, heads_right, axis=2) + + # compare heads + maxdiff = np.amax(abs(heads - heads_gwfgwf)) + assert ( + maxdiff < 10 * hclose + ), "Max. head diff. {} should \ + be within solver tolerance (x10): {}".format( + maxdiff, 10 * hclose + ) + + fpth = os.path.join(test.workspace, f"gwt_ref.ucn") + try: + cobj = flopy.utils.HeadFile( + fpth, precision="double", text="CONCENTRATION" + ) + conc_ref = cobj.get_data() + except: + assert False, f'could not load data from "{fpth}"' + + fpth = os.path.join(test.workspace, f"gwt_left.ucn") + try: + cobj = flopy.utils.HeadFile( + fpth, precision="double", text="CONCENTRATION" + ) + conc_left = cobj.get_data() + except: + assert False, f'could not load data from "{fpth}"' + + fpth = os.path.join(test.workspace, f"gwt_right.ucn") + try: + cobj = flopy.utils.HeadFile( + fpth, precision="double", text="CONCENTRATION" + ) + conc_right = cobj.get_data() + except: + assert False, f'could not load data from "{fpth}"' + + # merge left and right concentrations for bottom layer: + conc_gwtgwt = np.append(conc_left, conc_right, axis=2) + + maxdiff = np.amax(abs(conc_gwtgwt - conc_ref)) + assert ( + maxdiff < conc_tol + ), "Max. concentration diff. {} should \ + be within solver tolerance (x10): {}".format( + maxdiff, conc_tol + ) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +@pytest.mark.developmode +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index 3c652cd7ae0..e7dac23d84e 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -1,19 +1,21 @@ -# This is the Henry, Newton-Raphson problem described by Langevin et al (2020) -# with a 20 by 40 grid instead of the 40 by 80 grid described in the paper. -# There is freshwater inflow on the left and a sloping sea boundary on the -# right with moves up and down according to a simple sine function. GHBs -# and DRNs alternate and move up and down along the boundary to represent -# the effects of tides on the aquifer. +""" +This is the Henry, Newton-Raphson problem described by Langevin et al (2020) +with a 20 by 40 grid instead of the 40 by 80 grid described in the paper. +There is freshwater inflow on the left and a sloping sea boundary on the +right with moves up and down according to a simple sine function. GHBs +and DRNs alternate and move up and down along the boundary to represent +the effects of tides on the aquifer. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["henrynr01"] +cases = ["henrynr01"] # global model variables nlay = 20 @@ -66,10 +68,9 @@ def sinfunc(a, b, c, d, x): return a * np.sin(b * (x - c)) + d -def build_model(idx, dir): - - ws = dir - name = ex[idx] +def build_models(idx, test): + ws = test.workspace + name = cases[idx] nrow = 1 delr = lx / ncol @@ -377,7 +378,7 @@ def make_plot(sim, headall, concall): print("making plots...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -461,11 +462,9 @@ def make_plot(sim, headall, concall): plt.savefig(fname, bbox_inches="tight") -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name - ws = sim.simpath +def check_output(idx, test): + name = test.name + ws = test.workspace gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -523,22 +522,18 @@ def eval_transport(sim): makeplot = False if makeplot: - make_plot(sim, head, conc) + make_plot(test, head, conc) assert False @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_henry_openclose.py b/autotest/test_gwt_henry_openclose.py index 86d8ff5b075..bdc1c6e3725 100644 --- a/autotest/test_gwt_henry_openclose.py +++ b/autotest/test_gwt_henry_openclose.py @@ -3,14 +3,13 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["henry_ext"] +from framework import TestFramework +cases = ["henry_ext"] -def build_model(idx, dir): +def build_models(idx, test): lx = 2.0 lz = 1.0 @@ -35,10 +34,10 @@ def build_model(idx, dir): nouter, ninner = 100, 300 hclose, rclose, relax = 1e-10, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -234,13 +233,11 @@ def chd_value(k): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -292,17 +289,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ims_issue655.py b/autotest/test_gwt_ims_issue655.py index 497c2585bad..7cbb8b42122 100644 --- a/autotest/test_gwt_ims_issue655.py +++ b/autotest/test_gwt_ims_issue655.py @@ -3,7 +3,6 @@ side GWT boundary conditions. Versions 6.2.1 and earlier failed because of a divide by zero error in IMS. This test confirms the fix implemented as part of the version 6.2.2 release that addressed Issue 655. - """ import os @@ -11,10 +10,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["issue655a", "issue655b"] +cases = ["issue655a", "issue655b"] newton = [ False, True, @@ -25,7 +24,7 @@ nlay, nrow, ncol = 1, 11, 11 -def build_model(idx, ws): +def build_models(idx, test): nper = 1 perlen = [1000.0] nstp = [5] @@ -65,11 +64,11 @@ def build_model(idx, ws): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -249,21 +248,19 @@ def build_model(idx, ws): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name gwfname = "gwf_" + name - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") try: hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata().flatten() except: assert False, f'could not load data from "{fpth}"' - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -292,17 +289,13 @@ def eval_transport(sim): # vold = v -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ist01.py b/autotest/test_gwt_ist01.py index 6587941a2d3..b9fd366206c 100644 --- a/autotest/test_gwt_ist01.py +++ b/autotest/test_gwt_ist01.py @@ -1,7 +1,6 @@ """ Test the IST Package with a one cell model with water added and then removed. - """ import os @@ -9,10 +8,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ist01"] +cases = ["ist01"] laytyp = [1] ss = [1.0e-10] sy = [0.1] @@ -22,8 +21,7 @@ nlay, nrow, ncol = 1, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): perlen = [ 2.0, ] @@ -44,10 +42,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -222,25 +220,23 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name gwfname = "gwf_" + name # head - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata().flatten() # mobile concentration - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_alldata().flatten() # immobile concentration - fpth = os.path.join(sim.simpath, f"{gwtname}.ist.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ist.ucn") try: cobj = flopy.utils.HeadFile(fpth, precision="double", text="CIM") cim = cobj.get_alldata().flatten() @@ -248,7 +244,7 @@ def eval_transport(sim): assert False, f'could not load data from "{fpth}"' # budget - fpth = os.path.join(sim.simpath, f"{gwtname}.cbc") + fpth = os.path.join(test.workspace, f"{gwtname}.cbc") try: bobj = flopy.utils.CellBudgetFile(fpth, precision="double") print(bobj.get_unique_record_names()) @@ -267,17 +263,13 @@ def eval_transport(sim): assert np.allclose(rate_sim, rate_calc), msg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ist02.py b/autotest/test_gwt_ist02.py index 927ee082f39..17cb6741890 100644 --- a/autotest/test_gwt_ist02.py +++ b/autotest/test_gwt_ist02.py @@ -16,10 +16,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ist02"] +cases = ["ist02"] nlay, nrow, ncol = 1, 1, 300 mt3d_times = np.arange(1.0, 51.0, 1.0) @@ -79,7 +79,7 @@ ) -def build_model(idx, dir): +def build_models(idx, test): perlen = [20.0, 30.0] nper = len(perlen) nstp = [100, 100] @@ -98,10 +98,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -321,7 +321,7 @@ def build_model(idx, dir): def make_plot(sim): print("making plots...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -344,22 +344,18 @@ def make_plot(sim): fname = os.path.join(ws, gwtname + ".png") plt.savefig(fname) - return - - -def eval_transport(sim): - print("evaluating transport...") +def check_output(idx, test): makeplot = False if makeplot: - make_plot(sim) + make_plot(test) - name = sim.name + name = test.name gwtname = "gwt_" + name gwfname = "gwf_" + name # load the observed concentrations in column 300 - fname = os.path.join(sim.simpath, gwtname + ".obs.csv") + fname = os.path.join(test.workspace, gwtname + ".obs.csv") assert os.path.isfile(fname), f"file not found: {fname}" simvals = np.genfromtxt(fname, names=True, delimiter=",", deletechars="") @@ -380,17 +376,13 @@ def eval_transport(sim): assert success, "Conc difference between mf6 and mt3d > 0.05" -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_lkt01.py b/autotest/test_gwt_lkt01.py index 4971e5c9412..f066f47b394 100644 --- a/autotest/test_gwt_lkt01.py +++ b/autotest/test_gwt_lkt01.py @@ -1,20 +1,22 @@ -# Simple one-layer model with a lak. Purpose is to test a constant -# stage and constant concentration lake with a value of 100. The aquifer -# starts with a concentration of zero, but the values grow as the lake -# leaks into the aquifer. +""" +Simple one-layer model with a lak. Purpose is to test a constant +stage and constant concentration lake with a value of 100. The aquifer +starts with a concentration of zero, but the values grow as the lake +leaks into the aquifer. +""" import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["lkt_01"] +from framework import DNODATA, TestFramework +cases = ["lkt_01"] -def build_model(idx, dir): + +def build_models(idx, test): lx = 5.0 lz = 1.0 nlay = 1 @@ -45,10 +47,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -127,20 +129,20 @@ def build_model(idx, dir): ) nlakeconn = 3 # note: this is the number of connectiosn for a lake, not total number of connections - # pak_data = [lakeno, strt, nlakeconn, CONC, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, CONC, dense, boundname] pak_data = [(0, -0.4, nlakeconn, 0.0, 1025.0)] connlen = connwidth = delr / 2.0 con_data = [] - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) con_data.append( - (0, 0, (0, 0, 1), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (0, 0, (0, 0, 1), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (0, 1, (0, 0, 3), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (0, 1, (0, 0, 3), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (0, 2, (0, 0, 2), "VERTICAL", "None", 10, 10, connlen, connwidth) + (0, 2, (0, 0, 2), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) p_data = [ (0, "STATUS", "CONSTANT"), @@ -334,7 +336,7 @@ def build_model(idx, dir): def get_mfsim(testsim): - ws = testsim.simpath + ws = testsim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) return sim @@ -355,17 +357,15 @@ def eval_csv_information(testsim): ), f"Lake package does not have zero mass balance error: {result}" -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # eval csv files - eval_csv_information(sim) + eval_csv_information(test) # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".lkt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are 100. @@ -376,7 +376,7 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_alldata() answer = np.array( @@ -387,7 +387,7 @@ def eval_results(sim): ), f"{caq[-1].flatten()} {answer}" # lkt observation results - fpth = os.path.join(sim.simpath, gwtname + ".lkt.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".lkt.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -429,21 +429,14 @@ def eval_results(sim): answer = np.ones(10) * -216.3934 assert np.allclose(res, answer), f"{res} {answer}" - # uncomment when testing - # assert False - -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_lkt02.py b/autotest/test_gwt_lkt02.py index 616fb514397..a4368b16f95 100644 --- a/autotest/test_gwt_lkt02.py +++ b/autotest/test_gwt_lkt02.py @@ -1,18 +1,20 @@ -# Simple one-layer model with a lak. Purpose is to test outlets that -# move solute from one lake to another. +""" +Simple one-layer model with a lak. Purpose is to test outlets that +move solute from one lake to another. +""" import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["lkt_02"] +from framework import DNODATA, TestFramework +cases = ["lkt_02"] -def build_model(idx, dir): + +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -43,10 +45,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -124,7 +126,7 @@ def build_model(idx, dir): filename=f"{gwfname}.chd", ) - # pak_data = [lakeno, strt, nlakeconn, CONC, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, CONC, dense, boundname] pak_data = [ (0, -0.4, 2, 0.0, 1025.0), (1, -0.4, 1, 0.0, 1025.0), @@ -133,24 +135,24 @@ def build_model(idx, dir): connlen = connwidth = delr / 2.0 con_data = [] - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) # lake 1 con_data.append( - (0, 0, (0, 0, 1), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (0, 0, (0, 0, 1), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (0, 1, (0, 0, 2), "VERTICAL", "None", 10, 10, connlen, connwidth) + (0, 1, (0, 0, 2), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) # lake 2 con_data.append( - (1, 0, (0, 0, 3), "VERTICAL", "None", 10, 10, connlen, connwidth) + (1, 0, (0, 0, 3), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) # lake 3 con_data.append( - (2, 0, (0, 0, 4), "VERTICAL", "None", 10, 10, connlen, connwidth) + (2, 0, (0, 0, 4), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (2, 1, (0, 0, 5), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (2, 1, (0, 0, 5), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) p_data = [ @@ -352,14 +354,12 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".lkt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are correct @@ -370,7 +370,7 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_data() answer = np.array( @@ -387,7 +387,7 @@ def eval_results(sim): assert np.allclose(caq, answer), f"{caq.flatten()} {answer}" # lkt observation results - fpth = os.path.join(sim.simpath, gwtname + ".lkt.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".lkt.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -455,7 +455,7 @@ def eval_results(sim): # load the lake budget file fname = gwtname + ".lkt.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) # check the flow-ja-face terms @@ -482,21 +482,14 @@ def eval_results(sim): for dtname, dttype in dt: assert np.allclose(res[dtname], answer[dtname]), f"{res} {answer}" - # uncomment when testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - ws, + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_lkt03.py b/autotest/test_gwt_lkt03.py index efd98105085..43272fda679 100644 --- a/autotest/test_gwt_lkt03.py +++ b/autotest/test_gwt_lkt03.py @@ -1,18 +1,20 @@ -# Simple one-layer model with a lak. Purpose is to test the lak flow terms -# such as rainfall to make sure mixing is calculated correctly. +""" +Simple one-layer model with a lak. Purpose is to test the lak flow terms +such as rainfall to make sure mixing is calculated correctly. +""" import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["lkt_03"] +from framework import DNODATA, TestFramework +cases = ["lkt_03"] -def build_model(idx, dir): + +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -41,10 +43,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -122,7 +124,7 @@ def build_model(idx, dir): filename=f"{gwfname}.chd", ) - # pak_data = [lakeno, strt, nlakeconn, CONC, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, CONC, dense, boundname] pak_data = [ (0, 0.0, 1, 0.0, 1025.0), (1, 0.0, 1, 0.0, 1025.0), @@ -131,18 +133,18 @@ def build_model(idx, dir): connlen = connwidth = delr / 2.0 con_data = [] - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) # lake 1 con_data.append( - (0, 0, (0, 0, 2), "VERTICAL", "None", 10, 10, connlen, connwidth) + (0, 0, (0, 0, 2), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) # lake 2 con_data.append( - (1, 0, (0, 0, 3), "VERTICAL", "None", 10, 10, connlen, connwidth) + (1, 0, (0, 0, 3), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) # lake 3 con_data.append( - (2, 0, (0, 0, 4), "VERTICAL", "None", 10, 10, connlen, connwidth) + (2, 0, (0, 0, 4), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) p_data = [ @@ -332,14 +334,12 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".lkt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are correct @@ -350,7 +350,7 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_data() answer = np.zeros((7,)) @@ -358,7 +358,7 @@ def eval_results(sim): # load the lake budget file fname = gwtname + ".lkt.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) @@ -378,21 +378,14 @@ def eval_results(sim): for dtname, dttype in dt: assert np.allclose(res[dtname], answer[dtname]), f"{res} {answer}" - # uncomment when testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - ws, + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_lkt04.py b/autotest/test_gwt_lkt04.py index f8bb2cf2c65..bc90cd82ab0 100644 --- a/autotest/test_gwt_lkt04.py +++ b/autotest/test_gwt_lkt04.py @@ -1,21 +1,23 @@ -# Simple one-layer model with a lak. Purpose is to test a lake -# with a variable stage and variable concentration. The lake -# starts at a concentration of 100. and slowly decreases as -# fresh groundwater flows into it. Concentrations in the aquifer -# should remain at zero. +""" +Simple one-layer model with a lak. Purpose is to test a lake +with a variable stage and variable concentration. The lake +starts at a concentration of 100. and slowly decreases as +fresh groundwater flows into it. Concentrations in the aquifer +should remain at zero. +""" import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -ex = ["lkt_04"] +from framework import DNODATA, TestFramework +cases = ["lkt_04"] -def build_model(idx, dir, exe): + +def build_models(idx, test): lx = 5.0 lz = 1.0 nlay = 1 @@ -46,11 +48,11 @@ def build_model(idx, dir, exe): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=dir + sim_name=name, version="mf6", exe_name="mf6", sim_ws=test.workspace ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -127,20 +129,20 @@ def build_model(idx, dir, exe): ) nlakeconn = 3 # note: this is the number of connectiosn for a lake, not total number of connections - # pak_data = [lakeno, strt, nlakeconn, CONC, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, CONC, dense, boundname] pak_data = [(0, -0.4, nlakeconn, 0.0, 1025.0)] connlen = connwidth = delr / 2.0 con_data = [] - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) con_data.append( - (0, 0, (0, 0, 1), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (0, 0, (0, 0, 1), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (0, 1, (0, 0, 3), "HORIZONTAL", "None", 10, 10, connlen, connwidth) + (0, 1, (0, 0, 3), "HORIZONTAL", DNODATA, 10, 10, connlen, connwidth) ) con_data.append( - (0, 2, (0, 0, 2), "VERTICAL", "None", 10, 10, connlen, connwidth) + (0, 2, (0, 0, 2), "VERTICAL", DNODATA, 10, 10, connlen, connwidth) ) p_data = [ (0, "STATUS", "ACTIVE"), @@ -334,7 +336,7 @@ def build_model(idx, dir, exe): def get_mfsim(testsim): - ws = testsim.simpath + ws = testsim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) return sim @@ -371,17 +373,15 @@ def eval_csv_information(testsim): assert success, f"One or more errors encountered in budget checks" -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # eval csv files - eval_csv_information(sim) + eval_csv_information(test) # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".lkt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are 100. @@ -405,7 +405,7 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_alldata() answer = np.zeros(5) @@ -414,7 +414,7 @@ def eval_results(sim): ), f"{caq[-1].flatten()} {answer}" # lkt observation results - fpth = os.path.join(sim.simpath, gwtname + ".lkt.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".lkt.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -469,22 +469,14 @@ def eval_results(sim): answer = np.zeros(10) assert np.allclose(res, answer), f"{res} {answer}" - # uncomment when testing - # assert False - -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - mf6 = targets["mf6"] - test = TestFramework() - test.build(lambda i, w: build_model(i, w, mf6), idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_moc3d01.py b/autotest/test_gwt_moc3d01.py index f9a084e5160..27deccbff9e 100644 --- a/autotest/test_gwt_moc3d01.py +++ b/autotest/test_gwt_moc3d01.py @@ -3,10 +3,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "moc3d01a", "moc3d01b", "moc3d01c", @@ -23,7 +23,7 @@ decay = 7 * [None] + [0.01] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 122, 1 nper = 1 perlen = perlens[idx] # [120.] @@ -50,10 +50,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -271,13 +271,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -344,24 +342,20 @@ def eval_transport(sim): tsrescd = np.array(tsrescd) tsreslist = [tsresab, tsresab, tsrescd, tsrescd, None, None, None, None] - tsres = tsreslist[sim.idxsim] + tsres = tsreslist[idx] if tsres is not None: assert np.allclose( tsres, tssim ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_moc3d01_zod.py b/autotest/test_gwt_moc3d01_zod.py index 1597ff67bc8..70d1733e87a 100644 --- a/autotest/test_gwt_moc3d01_zod.py +++ b/autotest/test_gwt_moc3d01_zod.py @@ -1,18 +1,20 @@ -# This autotest is based on the MOC3D problem 1 autotest except that it -# tests the zero-order decay for a simple one-dimensional flow problem. -# The test ensures that concentrations do not go below zero (they do go -# slightly negative but, it does ensure that the decay rate shuts off -# where concentrations are zero. +""" +This autotest is based on the MOC3D problem 1 autotest except that it +tests the zero-order decay for a simple one-dimensional flow problem. +The test ensures that concentrations do not go below zero (they do go +slightly negative but, it does ensure that the decay rate shuts off +where concentrations are zero. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "moc3d01zoda", "moc3d01zodb", "moc3d01zodc", @@ -23,7 +25,7 @@ ist_package = [False, False, True, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 122, 1 nper = 1 perlen = [120] @@ -51,10 +53,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -214,15 +216,15 @@ def build_model(idx, dir): ) # storage - theta_mobile = 0.1 # vol mobile voids per cell volume - volfrac_immobile = 0. - theta_immobile = 0. + theta_mobile = 0.1 # vol mobile voids per cell volume + volfrac_immobile = 0.0 + theta_immobile = 0.0 if ist_package[idx]: # if dual domain, then assume half of cell is mobile and other half is immobile volfrac_immobile = 0.5 theta_immobile = theta_mobile porosity_immobile = theta_immobile / volfrac_immobile - volfrac_mobile = 1. - volfrac_immobile + volfrac_mobile = 1.0 - volfrac_immobile porosity_mobile = theta_mobile / volfrac_mobile rtd = retardation[idx] @@ -362,14 +364,12 @@ def make_plot_cd(cobj, fname=None): return -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name # get mobile domain concentration object - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -382,15 +382,15 @@ def eval_transport(sim): makeplot = False if makeplot: fname = "fig-ct.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) make_plot_ct(tssim, fname) fname = "fig-cd.pdf" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) make_plot_cd(cobj, fname) # get mobile domain budget object - fpth = os.path.join(sim.simpath, f"{gwtname}.cbc") + fpth = os.path.join(test.workspace, f"{gwtname}.cbc") bobj = flopy.utils.CellBudgetFile(fpth, precision="double") # Check to make sure decay rates in budget file are correct. If there is @@ -402,7 +402,7 @@ def eval_transport(sim): delt = 0.5 vcell = 0.1 * 0.1 * 1.0 porosity = 0.1 - decay_rate = decay[sim.idxsim] + decay_rate = decay[idx] for i in range(122): if conc[i] / delt > decay_rate: qknown = -decay_rate * vcell * porosity @@ -414,7 +414,7 @@ def eval_transport(sim): # print(i, qdecay_budfile[i], conc[i]) # get immobile domain concentration object - fpth = os.path.join(sim.simpath, f"{gwtname}.ist.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ist.ucn") cimobj = None if os.path.isfile(fpth): try: @@ -560,7 +560,7 @@ def eval_transport(sim): tsresc = np.array(tsresc) tsresd = np.array(tsresd) tsreslist = [tsresa, tsresb, tsresc, tsresd] - tsres = tsreslist[sim.idxsim] + tsres = tsreslist[idx] errmsg = ( "Simulated concentrations do not match with known solution.\n" "{} /= {}".format(tssim, tsres) @@ -569,17 +569,13 @@ def eval_transport(sim): assert np.allclose(tsres, tssim), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_moc3d02.py b/autotest/test_gwt_moc3d02.py index 4d2b476c3dc..729cdcba760 100644 --- a/autotest/test_gwt_moc3d02.py +++ b/autotest/test_gwt_moc3d02.py @@ -3,14 +3,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["moc3d02a", "moc3d02b"] +cases = ["moc3d02a", "moc3d02b"] xt3d = [None, True] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 40, 12, 30 nper = 1 perlen = [400] @@ -42,10 +42,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -240,13 +240,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -310,17 +308,13 @@ def eval_transport(sim): @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_moc3d03.py b/autotest/test_gwt_moc3d03.py index f236107ad1d..cedfebfdf8e 100644 --- a/autotest/test_gwt_moc3d03.py +++ b/autotest/test_gwt_moc3d03.py @@ -3,13 +3,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["moc3d03"] +cases = ["moc3d03"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 30, 30 nper = 1 perlen = [1000] @@ -41,10 +41,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -234,13 +234,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -292,17 +290,13 @@ def eval_transport(sim): @pytest.mark.slow -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst01.py b/autotest/test_gwt_mst01.py index d1f53e59118..2eadf4b2036 100644 --- a/autotest/test_gwt_mst01.py +++ b/autotest/test_gwt_mst01.py @@ -3,18 +3,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst01"] +cases = ["mst01"] laytyp = [1] ss = [0.0] sy = [0.1] nlay, nrow, ncol = 4, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): nper = 1 perlen = [3.0] nstp = [3] @@ -35,10 +34,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -216,13 +215,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc1 = cobj.get_data(totim=3.0) @@ -233,17 +230,13 @@ def eval_transport(sim): ) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst02.py b/autotest/test_gwt_mst02.py index 18a2a1e33b6..8a7ee63d18c 100644 --- a/autotest/test_gwt_mst02.py +++ b/autotest/test_gwt_mst02.py @@ -1,16 +1,16 @@ """ Test the GWT Sorption (RCT) Package by running a ... - """ + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst02a", "mst02b"] +cases = ["mst02a", "mst02b"] distcoef = [0.0, 1.0] nlay, nrow, ncol = 1, 1, 2 @@ -46,8 +46,7 @@ tsanswers = [ts1, ts2] -def build_model(idx, dir): - +def build_models(idx, test): nper = 1 perlen = [1.0] nstp = [10] @@ -71,10 +70,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -227,14 +226,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - idx = sim.idxsim - name = ex[idx] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -249,7 +245,7 @@ def eval_transport(sim): ) # Check budget file - fpth = os.path.join(sim.simpath, f"{gwtname}.bud") + fpth = os.path.join(test.workspace, f"{gwtname}.bud") try: bobj = flopy.utils.CellBudgetFile(fpth, precision="double") ra = bobj.get_data(totim=1.0) @@ -257,17 +253,13 @@ def eval_transport(sim): assert False, f'could not load data from "{fpth}"' -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst03.py b/autotest/test_gwt_mst03.py index 036cfa4f296..20c90911186 100644 --- a/autotest/test_gwt_mst03.py +++ b/autotest/test_gwt_mst03.py @@ -2,7 +2,6 @@ Test the MST Package and its ability to calculate simple mixing for a one-cell model. Patterned after the simple test presented in the MT3D-USGS manual on pages 9-10. - """ import os @@ -10,18 +9,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst03"] +cases = ["mst03"] laytyp = [1] ss = [1.0e-10] sy = [0.1] nlay, nrow, ncol = 1, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): nper = 2 perlen = [2.0, 2.0] nstp = [14, 14] @@ -40,10 +38,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -215,18 +213,16 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name gwfname = "gwf_" + name - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata().flatten() - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_alldata().flatten() @@ -285,17 +281,13 @@ def eval_transport(sim): assert np.allclose(conc, canswer, atol=1.0e-8), errmsg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst04_noadv.py b/autotest/test_gwt_mst04_noadv.py index 14d711d7b16..9e438805627 100644 --- a/autotest/test_gwt_mst04_noadv.py +++ b/autotest/test_gwt_mst04_noadv.py @@ -1,21 +1,19 @@ """ -MODFLOW 6 Autotest Test zero-order decay by running a one-cell model with ten 1-day time steps with a decay rate of -1. Result should be 10 at the end. - """ import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst04_noadv"] +cases = ["mst04_noadv"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 1 nper = 1 perlen = [10.0] @@ -33,10 +31,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -109,13 +107,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() @@ -125,17 +121,13 @@ def eval_transport(sim): assert np.allclose(cres, conc.flatten()), msg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst05.py b/autotest/test_gwt_mst05.py index c305d3ff3f7..dba4a1975b7 100644 --- a/autotest/test_gwt_mst05.py +++ b/autotest/test_gwt_mst05.py @@ -1,7 +1,5 @@ """ -MODFLOW 6 Autotest Test isotherms. - """ import os @@ -11,10 +9,10 @@ import pytest from flopy.utils.binaryfile import write_budget, write_head from flopy.utils.gridutil import uniform_flow_field + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst05a", "mst05b"] +cases = ["mst05a", "mst05b"] isotherm = ["freundlich", "langmuir"] distcoef = [0.3, 100.0] sp2 = [0.7, 0.003] @@ -22,7 +20,7 @@ ymax_plot = [0.5, 1.0] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 101 perlen = [160.0, 1340.0] nper = len(perlen) @@ -48,10 +46,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -267,13 +265,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = ex[sim.idxsim] +def check_output(idx, test): + name = cases[idx] gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") try: cobj = flopy.utils.HeadFile( fpth, precision="double", text="CONCENTRATION" @@ -282,7 +278,7 @@ def eval_transport(sim): except: assert False, f'could not load data from "{fpth}"' - fpth = os.path.join(sim.simpath, "conc_obs.csv") + fpth = os.path.join(test.workspace, "conc_obs.csv") try: obs = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -290,8 +286,8 @@ def eval_transport(sim): cnorm = obs["X008"] / 0.05 cnorm_max = [0.32842034, 0.875391418] - msg = f"{cnorm_max[sim.idxsim]} /= {cnorm.max()}" - assert np.allclose(cnorm_max[sim.idxsim], cnorm.max(), atol=0.001), msg + msg = f"{cnorm_max[idx]} /= {cnorm.max()}" + assert np.allclose(cnorm_max[idx], cnorm.max(), atol=0.001), msg savefig = False if savefig: @@ -299,26 +295,22 @@ def eval_transport(sim): fig = plt.figure() plt.plot(obs["time"], obs["X008"] / 0.05, "bo-") - plt.xlim(0, xmax_plot[sim.idxsim]) - plt.ylim(0, ymax_plot[sim.idxsim]) + plt.xlim(0, xmax_plot[idx]) + plt.ylim(0, ymax_plot[idx]) plt.xlabel("Time, in seconds") plt.ylabel("Normalized Concentration") - plt.title(isotherm[sim.idxsim]) - fname = os.path.join(sim.simpath, "results.png") + plt.title(isotherm[idx]) + fname = os.path.join(test.workspace, "results.png") plt.savefig(fname) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mst06_noadv.py b/autotest/test_gwt_mst06_noadv.py index 95dcc8882e2..b2fef2ad877 100644 --- a/autotest/test_gwt_mst06_noadv.py +++ b/autotest/test_gwt_mst06_noadv.py @@ -1,22 +1,20 @@ """ -MODFLOW 6 Autotest Test zero-order decay by running a one-cell model with ten 1-day time steps with a decay rate of 1. And a starting concentration of 8. Result should be 0 at the end and decay should shot off once concentration is zero. - """ import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mst06_noadv"] +cases = ["mst06_noadv"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 1 nper = 1 perlen = [10.0] @@ -34,10 +32,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -119,13 +117,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_ts((0, 0, 0)) @@ -139,7 +135,7 @@ def eval_transport(sim): assert np.allclose(cres, conc[:, 1]), msg # Check budget file - fpth = os.path.join(sim.simpath, f"{gwtname}.bud") + fpth = os.path.join(test.workspace, f"{gwtname}.bud") try: bobj = flopy.utils.CellBudgetFile(fpth, precision="double") except: @@ -165,17 +161,13 @@ def eval_transport(sim): assert np.allclose(decay_rate, decay_rate_answer), msg -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mt3dms_p01.py b/autotest/test_gwt_mt3dms_p01.py index bd163a76202..3b19a6c1f44 100644 --- a/autotest/test_gwt_mt3dms_p01.py +++ b/autotest/test_gwt_mt3dms_p01.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test to compare MODFLOW 6 groundwater transport simulation results to MT3DMS results. This test was first documented in Zheng and Wang (1999) (MT3DMS: A Modular Three-Dimensional Multispecies Transport Model for Simulation of @@ -20,9 +19,14 @@ """ import os +from pathlib import Path +from typing import Tuple import flopy import numpy as np +import pytest + +from conftest import try_get_target testgroup = "mt3dms_p01" @@ -383,7 +387,6 @@ def p01mf6( theta_immobile = prsity2 porosity_immobile = theta_immobile / volfrac_immobile porosity_mobile = prsity / volfrac_mobile - first_order_decay = True if zero_order_decay: @@ -470,6 +473,14 @@ def p01mf6( return sim, conc +def get_binaries(targets) -> Tuple[Path, Path, Path]: + return ( + targets["mf6"], + try_get_target(targets, "mf2005s"), + try_get_target(targets, "mt3dms"), + ) + + def test_mt3dmsp01a(function_tmpdir, targets): longitudinal_dispersivity = 0.0 retardation = 1.0 @@ -478,8 +489,10 @@ def test_mt3dmsp01a(function_tmpdir, targets): zeta = None prsity2 = None - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "a")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}a" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -491,9 +504,6 @@ def test_mt3dmsp01a(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -506,8 +516,9 @@ def test_mt3dmsp01a(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-4), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-4 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" # load transport budget # budget text: @@ -543,8 +554,10 @@ def test_mt3dmsp01b(function_tmpdir, targets): zeta = None prsity2 = None - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "b")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}b" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -556,9 +569,6 @@ def test_mt3dmsp01b(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -571,8 +581,9 @@ def test_mt3dmsp01b(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-4), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-4 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" def test_mt3dmsp01c(function_tmpdir, targets): @@ -583,8 +594,10 @@ def test_mt3dmsp01c(function_tmpdir, targets): zeta = None prsity2 = None - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "c")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}c" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -596,9 +609,6 @@ def test_mt3dmsp01c(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -611,8 +621,9 @@ def test_mt3dmsp01c(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-4), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-4 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" def test_mt3dmsp01d(function_tmpdir, targets): @@ -623,8 +634,10 @@ def test_mt3dmsp01d(function_tmpdir, targets): zeta = None prsity2 = None - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "d")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}d" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -636,9 +649,6 @@ def test_mt3dmsp01d(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -651,8 +661,9 @@ def test_mt3dmsp01d(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-4), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-4 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" def test_mt3dmsp01e(function_tmpdir, targets): @@ -663,8 +674,10 @@ def test_mt3dmsp01e(function_tmpdir, targets): zeta = 0.1 prsity2 = 0.05 - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "e")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}e" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -676,9 +689,6 @@ def test_mt3dmsp01e(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -691,8 +701,9 @@ def test_mt3dmsp01e(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-1), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-1 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" def test_mt3dmsp01f(function_tmpdir, targets): @@ -703,8 +714,10 @@ def test_mt3dmsp01f(function_tmpdir, targets): zeta = 0.1 prsity2 = 0.05 - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "f")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}f" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -717,9 +730,6 @@ def test_mt3dmsp01f(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -732,8 +742,9 @@ def test_mt3dmsp01f(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1e-1), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1e-1 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" def test_mt3dmsp01g(function_tmpdir, targets): @@ -744,8 +755,10 @@ def test_mt3dmsp01g(function_tmpdir, targets): zeta = None prsity2 = None - mf6 = targets["mf6"] - mf6_ws = str(function_tmpdir / (testgroup + "g")) + mf6, mf2005, mt3dms = get_binaries(targets) + mf6_ws = function_tmpdir / f"{testgroup}g" + mt3d_ws = mf6_ws / "mt3d" + sim, conc_mf6 = p01mf6( mf6_ws, longitudinal_dispersivity, @@ -758,9 +771,6 @@ def test_mt3dmsp01g(function_tmpdir, targets): exe=mf6, ) - mf2005 = targets["mf2005s"] - mt3dms = targets["mt3dms"] - mt3d_ws = os.path.join(mf6_ws, "mt3d") mf, mt, conc_mt3d, cvt, mvt = p01mt3d( mt3d_ws, longitudinal_dispersivity, @@ -775,5 +785,6 @@ def test_mt3dmsp01g(function_tmpdir, targets): mt3dms=mt3dms, ) - msg = f"concentrations not equal {conc_mt3d} {conc_mf6}" - assert np.allclose(conc_mt3d, conc_mf6, atol=1.0e-4), msg + assert np.allclose( + conc_mt3d, conc_mf6, atol=1.0e-4 + ), f"concentrations not equal {conc_mt3d} {conc_mf6}" diff --git a/autotest/test_gwt_mvt01.py b/autotest/test_gwt_mvt01.py index 1818b8f5724..a38091b9063 100644 --- a/autotest/test_gwt_mvt01.py +++ b/autotest/test_gwt_mvt01.py @@ -1,21 +1,23 @@ -# Simple one-layer model with a lak and sfr network on top. Purpose is to -# test movement of solute between advanced packages. In this case water -# from a lake outlet is moved into the first sfr reach. The test confirms -# that the solute from the lake is moved into the sfr reach. -# There is no flow between the stream and the aquifer. +""" +Simple one-layer model with a lak and sfr network on top. Purpose is to +test movement of solute between advanced packages. In this case water +from a lake outlet is moved into the first sfr reach. The test confirms +that the solute from the lake is moved into the sfr reach. +There is no flow between the stream and the aquifer. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mvt_01"] +cases = ["mvt_01"] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -46,10 +48,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -142,7 +144,7 @@ def build_model(idx, dir): ) nlakeconn = 1 # note: this is the number of connectiosn for a lake, not total number of connections - # pak_data = [lakeno, strt, nlakeconn, CONC, dense, boundname] + # pak_data = [ifno, strt, nlakeconn, CONC, dense, boundname] pak_data = [ (0, 1.0, nlakeconn, 0.0, 1025.0), (1, 1.0, nlakeconn, 0.0, 1025.0), @@ -150,7 +152,7 @@ def build_model(idx, dir): connlen = connwidth = delr / 2.0 con_data = [] - # con_data=(lakeno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) + # con_data=(ifno,iconn,(cellid),claktype,bedleak,belev,telev,connlen,connwidth ) con_data.append( (0, 0, (0, 0, 0), "VERTICAL", 0.0, 0, 0, connlen, connwidth) ) @@ -481,14 +483,12 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".sft.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are correct @@ -497,14 +497,14 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_data().flatten() assert np.allclose(csft, caq), f"{csft} {caq}" # sft observation results - fpth = os.path.join(sim.simpath, gwtname + ".sft.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".sft.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -518,7 +518,7 @@ def eval_results(sim): # load the sft budget file fname = gwtname + ".sft.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) # check the flow-ja-face terms @@ -532,7 +532,7 @@ def eval_results(sim): # get mvt results from listing file bud_lst = ["SFR-1_IN", "SFR-1_OUT", "LAK-1_IN", "LAK-1_OUT"] fname = gwtname + ".lst" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) budl = flopy.utils.Mf6ListBudget( fname, budgetkey="TRANSPORT MOVER BUDGET FOR ENTIRE MODEL" ) @@ -543,21 +543,14 @@ def eval_results(sim): ) assert np.allclose(d0["SFR-1_OUT"], d0["LAK-1_IN"]) - # uncomment when testing so files aren't deleted - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - ws, + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mvt02.py b/autotest/test_gwt_mvt02.py index 20dfa5e4762..cc49f432d35 100644 --- a/autotest/test_gwt_mvt02.py +++ b/autotest/test_gwt_mvt02.py @@ -1,21 +1,23 @@ -# Simple one-layer model with a drn and sfr network on top. Purpose is to -# test movement of solute between stress and advanced packages. In this case -# water from a drain is moved into the first sfr reach. The test confirms -# that the solute from the drain is moved into the sfr reach. -# There is no flow between the stream and the aquifer. +""" +Simple one-layer model with a drn and sfr network on top. Purpose is to +test movement of solute between stress and advanced packages. In this case +water from a drain is moved into the first sfr reach. The test confirms +that the solute from the drain is moved into the sfr reach. +There is no flow between the stream and the aquifer. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mvt_02"] +cases = ["mvt_02"] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -44,10 +46,10 @@ def build_model(idx, dir): nouter, ninner = 20, 10 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", @@ -245,7 +247,6 @@ def build_model(idx, dir): transport = True if transport: - # create gwt model gwtname = "gwt_" + name gwt = flopy.mf6.MFModel( @@ -384,14 +385,13 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name # Load csv budget and make sure names are correct fname = f"{gwtname}.bud.csv" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) budcsv = np.genfromtxt(fname, names=True, delimiter=",", deletechars="") answer = [ "time", @@ -414,19 +414,19 @@ def eval_results(sim): # ensure sfr concentrations were saved fname = gwtname + ".sft.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") csft = cobj.get_data().flatten() # load the aquifer concentrations fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_data().flatten() # sft observation results - fpth = os.path.join(sim.simpath, gwtname + ".sft.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".sft.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -457,13 +457,13 @@ def eval_results(sim): # load the mvt budget file fname = gwtname + ".mvt.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) mobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) # load the sft budget file fname = gwtname + ".sft.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) # check the flow-ja-face terms @@ -474,21 +474,14 @@ def eval_results(sim): res = bobj.get_data(text="storage")[-1] # print(res) - # uncomment when testing so files aren't deleted - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - ws, + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mvt02fmi.py b/autotest/test_gwt_mvt02fmi.py index 702b9a80697..4ed60955133 100644 --- a/autotest/test_gwt_mvt02fmi.py +++ b/autotest/test_gwt_mvt02fmi.py @@ -1,8 +1,10 @@ -# Simple one-layer model with a drn and sfr network on top. Purpose is to -# test movement of solute between stress and advanced packages. In this case -# water from a drain is moved into the first sfr reach. The test confirms -# that the solute from the drain is moved into the sfr reach. -# There is no flow between the stream and the aquifer. +""" +Simple one-layer model with a drn and sfr network on top. Purpose is to +test movement of solute between stress and advanced packages. In this case +water from a drain is moved into the first sfr reach. The test confirms +that the solute from the drain is moved into the sfr reach. +There is no flow between the stream and the aquifer. +""" import os from os.path import join @@ -11,7 +13,7 @@ import numpy as np testgroup = "mvt02fmi" -ex = ["mvt02fmi"] +cases = ["mvt02fmi"] # parameters lx = 7.0 @@ -390,8 +392,6 @@ def run_transport_model(dir, exe): errmsg = f"transport model did not terminate successfully\n{buff}" assert success, errmsg - print("evaluating results...") - # Load csv budget and make sure names are correct fname = f"{gwtname}.bud.csv" fname = os.path.join(gwt.model_ws, fname) @@ -470,6 +470,5 @@ def run_transport_model(dir, exe): def test_mvt02fmi(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(str(function_tmpdir), mf6) - run_transport_model(str(function_tmpdir), mf6) + run_flow_model(str(function_tmpdir), targets["mf6"]) + run_transport_model(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_mwt01.py b/autotest/test_gwt_mwt01.py index bf70531e86f..d637b1fa631 100644 --- a/autotest/test_gwt_mwt01.py +++ b/autotest/test_gwt_mwt01.py @@ -1,20 +1,22 @@ -# Simple 3-layer model with a maw. Purpose is to test pumping -# with concentration being drawn in from edge. The aquifer -# starts with a concentration of zero, but the values grow as the boundary -# flows into the aquifer. +""" +Simple 3-layer model with a maw. Purpose is to test pumping +with concentration being drawn in from edge. The aquifer +starts with a concentration of zero, but the values grow as the boundary +flows into the aquifer. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mwt_01"] +cases = ["mwt_01"] -def build_model(idx, dir): +def build_models(idx, test): lx = 5.0 lz = 3.0 nlay = 3 @@ -44,10 +46,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -309,7 +311,7 @@ def build_model(idx, dir): def check_obs(sim): print("checking obs...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -375,35 +377,29 @@ def check_obs(sim): assert success, "One or more MWT obs checks did not pass" -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # ensure mwt concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".mwt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # ensure gwt concentrations were saved fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) - check_obs(sim) + check_obs(test) -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_mwt02.py b/autotest/test_gwt_mwt02.py index 37129a329a1..db886b0ca0a 100644 --- a/autotest/test_gwt_mwt02.py +++ b/autotest/test_gwt_mwt02.py @@ -1,18 +1,17 @@ -# This is the reinjection problem described in the MT3D supplementary -# information. +"""This is the reinjection problem described in the MT3D supplementary information.""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["mwt_02"] +cases = ["mwt_02"] -def build_model(idx, dir): +def build_models(idx, test): nlay = 1 nrow = 31 ncol = 46 @@ -38,10 +37,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -121,7 +120,7 @@ def build_model(idx, dir): # MAW opth = f"{name}.maw.obs" - # [] [] + # [] [] wellbottom = 0.0 wellradius = 0.1 ngwfnodes = 1 @@ -130,7 +129,7 @@ def build_model(idx, dir): [iwell, wellradius, wellbottom, strt, "THIEM", ngwfnodes, concwell] for iwell in range(4) ] - # + # wellconnectionsrecarray = [ [0, 0, (0, 15, 15), 10.0, 0.0, 10.0, 0.1], [1, 0, (0, 15, 20), 10.0, 0.0, 10.0, 0.1], @@ -395,7 +394,7 @@ def build_model(idx, dir): def make_plot(sim): print("making plots...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -428,18 +427,16 @@ def make_plot(sim): return -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): makeplot = False if makeplot: - make_plot(sim) + make_plot(test) # ensure concentrations were saved - name = ex[sim.idxsim] + name = cases[idx] gwtname = "gwt_" + name fname = gwtname + ".mwt.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load and check the well concentrations @@ -450,12 +447,12 @@ def eval_results(sim): # make sure concentrations can be loaded fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_alldata() # make sure observations can be loaded - fpth = os.path.join(sim.simpath, gwtname + ".mwt.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".mwt.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -474,17 +471,15 @@ def eval_results(sim): answer = np.ones(res.shape) * 1000.0 assert np.allclose(res, answer), f"{res} {answer}" - # uncomment when testing - # assert False - @pytest.mark.slow -@pytest.mark.parametrize("name", ex) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation(name, exe_dict=targets, exfunc=eval_results, idxsim=0), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_obs01.py b/autotest/test_gwt_obs01.py index 97416f1d721..eab65a96a4a 100644 --- a/autotest/test_gwt_obs01.py +++ b/autotest/test_gwt_obs01.py @@ -1,7 +1,5 @@ """ -MODFLOW 6 Autotest Test that the obs concentrations match the oc concentrations - """ import os @@ -9,16 +7,16 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = [ +cases = [ "gwt_obs01a", ] scheme = ["upstream"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [5.0] @@ -43,10 +41,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -242,19 +240,17 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name # MODFLOW 6 output control concentrations - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_alldata() # MODFLOW 6 observation package concentrations - fpth = os.path.join(sim.simpath, "conc_obs.csv") + fpth = os.path.join(test.workspace, "conc_obs.csv") tc = np.genfromtxt(fpth, names=True, delimiter=",") assert np.allclose( @@ -266,17 +262,13 @@ def eval_transport(sim): ), "obs concentrations do not match oc concentrations." -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_prudic2004t2.py b/autotest/test_gwt_prudic2004t2.py index 6c052338a59..697a1b819bb 100644 --- a/autotest/test_gwt_prudic2004t2.py +++ b/autotest/test_gwt_prudic2004t2.py @@ -1,8 +1,10 @@ -# Second problem described by Prudic et al (2004) -# This problem involves transport through an aquifers, lakes and streams. -# It requires the use of the Water Mover Package to send water from a stream, -# into a lake, and then back into another stream. Solute is also transport -# through the system. +""" +Second problem described by Prudic et al (2004) +This problem involves transport through an aquifers, lakes and streams. +It requires the use of the Water Mover Package to send water from a stream, +into a lake, and then back into another stream. Solute is also transport +through the system. +""" import os import sys @@ -10,21 +12,20 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation -ex = ["prudic2004t2"] +cases = ["prudic2004t2"] data_path = project_root_path / "autotest" / "data" model_path = data_path / "prudic2004test2" fname = str(model_path / "lakibd.dat") lakibd = np.loadtxt(fname, dtype=int) -def build_model(idx, dir): - - ws = dir - name = ex[idx] +def build_models(idx, test): + ws = test.workspace + name = cases[idx] gwfname = "gwf_" + name gwtname = "gwt_" + name sim = flopy.mf6.MFSimulation( @@ -211,7 +212,8 @@ def build_model(idx, dir): budget_filerecord=gwfname + ".sfr.bud", mover=True, pname="SFR-1", - unit_conversion=128390.00, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=True, nreaches=len(rivlist), packagedata=sfrpackagedata, @@ -356,7 +358,6 @@ def build_model(idx, dir): transport = True if transport: - gwt = flopy.mf6.ModflowGwt(sim, modelname=gwtname) # ims @@ -586,7 +587,7 @@ def build_model(idx, dir): def make_concentration_vs_time(sim): print("making plot of concentration versus time...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -645,7 +646,7 @@ def make_concentration_map(sim): ] name = sim.name - ws = sim.simpath + ws = sim.workspace simfp = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -684,7 +685,7 @@ def make_concentration_map(sim): def check_obs(sim): print("checking obs...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -813,27 +814,23 @@ def check_obs(sim): assert success, "One or more SFT-LKT obs checks did not pass" - return - - -def eval_results(sim): - print("evaluating results...") +def check_output(idx, test): makeplot = False - for idx, arg in enumerate(sys.argv): + for arg in sys.argv: if arg.lower() == "--makeplot": makeplot = True if makeplot: - make_concentration_vs_time(sim) - make_concentration_map(sim) + make_concentration_vs_time(test) + make_concentration_map(test) # ensure concentrations were saved - ws = sim.simpath - name = sim.name + ws = test.workspace + name = test.name gwtname = "gwt_" + name - check_obs(sim) + check_obs(test) fname = gwtname + ".lkt.bin" fname = os.path.join(ws, fname) @@ -967,22 +964,15 @@ def eval_results(sim): # fname = os.path.join(ws, f"result_conc_sfr4.txt") # np.savetxt(fname, res_sfr4) - # uncomment when testing - # assert False - @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_prudic2004t2fmi.py b/autotest/test_gwt_prudic2004t2fmi.py index 94378e064d0..5b7c51b7ea2 100644 --- a/autotest/test_gwt_prudic2004t2fmi.py +++ b/autotest/test_gwt_prudic2004t2fmi.py @@ -1,4 +1,4 @@ -# tests to ability to run flow model first followed by transport model +"""Tests to ability to run flow model first followed by transport model""" import os from os.path import join @@ -6,6 +6,7 @@ import flopy import numpy as np import pytest + from conftest import project_root_path data_path = project_root_path / "autotest" / "data" @@ -208,7 +209,8 @@ def run_flow_model(dir, exe): budget_filerecord=gwfname + ".sfr.bud", mover=True, pname="SFR-1", - unit_conversion=128390.00, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=True, nreaches=len(rivlist), packagedata=sfrpackagedata, @@ -783,6 +785,5 @@ def run_transport_model(dir, exe): @pytest.mark.slow def test_prudic2004t2fmi(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(str(function_tmpdir), mf6) - run_transport_model(str(function_tmpdir), mf6) + run_flow_model(str(function_tmpdir), targets["mf6"]) + run_transport_model(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_prudic2004t2fmiats.py b/autotest/test_gwt_prudic2004t2fmiats.py index 446aec445e8..6efdfe672f8 100644 --- a/autotest/test_gwt_prudic2004t2fmiats.py +++ b/autotest/test_gwt_prudic2004t2fmiats.py @@ -1,8 +1,10 @@ -# tests ats on the prudic transport model. With these ATS settings, the -# solver should fail on time step 19 in period 2, and should converge on the -# second try with a smaller time step. This test will not pass if the states -# are not restored properly for the advanced transport packages when the -# failure occurs. +""" +Tests ATS on the prudic transport model. With these ATS settings, the +solver should fail on time step 19 in period 2, and should converge on the +second try with a smaller time step. This test will not pass if the states +are not restored properly for the advanced transport packages when the +failure occurs. +""" import os from os.path import join @@ -10,12 +12,12 @@ import flopy import numpy as np import pytest + from conftest import project_root_path data_path = project_root_path / "autotest" / "data" model_path = str(data_path / "prudic2004test2") testgroup = "prudic2004t2fmiats" - nlay = 8 nrow = 36 ncol = 23 @@ -212,7 +214,8 @@ def run_flow_model(dir, exe): budget_filerecord=gwfname + ".sfr.bud", mover=True, pname="SFR-1", - unit_conversion=128390.00, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=True, nreaches=len(rivlist), packagedata=sfrpackagedata, @@ -850,6 +853,5 @@ def run_transport_model(dir, exe): @pytest.mark.slow def test_prudic2004t2fmiats(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(dir=str(function_tmpdir), exe=mf6) - run_transport_model(dir=str(function_tmpdir), exe=mf6) + run_flow_model(dir=str(function_tmpdir), exe=targets["mf6"]) + run_transport_model(dir=str(function_tmpdir), exe=targets["mf6"]) diff --git a/autotest/test_gwt_prudic2004t2gwtgwt.py b/autotest/test_gwt_prudic2004t2gwtgwt.py index 71577f18af4..a9ae64c41c7 100644 --- a/autotest/test_gwt_prudic2004t2gwtgwt.py +++ b/autotest/test_gwt_prudic2004t2gwtgwt.py @@ -1,8 +1,10 @@ -# Second problem described by Prudic et al (2004) -# This problem involves transport through an aquifers, lakes and streams. -# It requires the use of the Water Mover Package to send water from a stream, -# into a lake, and then back into another stream. Solute is also transport -# through the system. +""" +Second problem described by Prudic et al (2004) +This problem involves transport through an aquifers, lakes and streams. +It requires the use of the Water Mover Package to send water from a stream, +into a lake, and then back into another stream. Solute is also transport +through the system. +""" import os import sys @@ -10,13 +12,13 @@ import flopy import numpy as np import pytest + from conftest import project_root_path from framework import TestFramework -from simulation import TestSimulation +cases = ["prudic2004t2gwtgwt"] data_path = project_root_path / "autotest" / "data" model_path = str(data_path / "prudic2004test2gwtgwt") -ex = ["prudic2004t2gwtgwt"] gwfnames = ["flow1", "flow2"] gwtnames = ["transport1", "transport2"] @@ -56,14 +58,13 @@ lakibd = np.loadtxt(fname, dtype=int) -def build_model(idx, ws): - +def build_models(idx, test): name = "mf6sim" sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", - sim_ws=ws, + sim_ws=test.workspace, continue_=False, ) tdis_rc = [(1.0, 1, 1.0), (365.25 * 25, 25, 1.0)] @@ -247,7 +248,7 @@ def sfr_packagedata_to_list( dt[14] = ("boundname", "S40") ra = np.genfromtxt(fname, dtype=dt) if convert_to_zero_base: - ra["rno"] -= 1 + ra["ifno"] -= 1 ra["layer"] -= 1 ra["row"] -= 1 ra["column"] -= 1 @@ -274,7 +275,6 @@ def sfr_connectiondata_to_list(fname, convert_to_zero_base=True): def build_gwfgwt_combo( sim, gwfname, gwtname, idomain, imodelcombo, icombo, imsgwf, imsgwt ): - # number of time steps for period 2 are reduced from 12 * 25 to 25 in # order to speed up this autotest @@ -388,7 +388,8 @@ def build_gwfgwt_combo( mover=True, pname=f"SFR-{isfrseg}", filename=f"{gwfname}.sfr{isfrseg}", - unit_conversion=128390.00, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=False, nreaches=nreaches, packagedata=sfrpd, @@ -407,7 +408,6 @@ def build_gwfgwt_combo( if lakibd[i, j] not in lakeibd_list: continue else: - ilak = lakibd[i, j] - 1 ilak = 0 # back @@ -524,7 +524,6 @@ def build_gwfgwt_combo( ) if within_model_mvr_on: - if icombo == 1: maxmvr, maxpackages = 1, 2 mvrpack = [["SFR-1"], ["LAK-1"]] @@ -548,7 +547,6 @@ def build_gwfgwt_combo( ) if transport_on: - gwt = flopy.mf6.ModflowGwt(sim, modelname=gwtname) sim.register_ims_package(imsgwt, [gwt.name]) @@ -636,7 +634,6 @@ def build_gwfgwt_combo( # if sft_on: - if icombo == 1: isfrseglist = [1] else: @@ -648,8 +645,8 @@ def build_gwfgwt_combo( sfrpack = gwf.get_package(pname) nreaches = sfrpack.nreaches.get_data() sftpackagedata = [] - for irno in range(nreaches): - t = (irno, 0.0, 99.0, 999.0, f"myreach{irno + 1}") + for ifno in range(nreaches): + t = (ifno, 0.0, 99.0, 999.0, f"myreach{ifno + 1}") sftpackagedata.append(t) sft_obs = { @@ -724,7 +721,6 @@ def make_concentration_vs_time(sim, ws, ans_lak1, ans_sfr3, ans_sfr4): sft3outflowconc = None sft4outflowconc = None if sft_on: - # get southern model gwt = sim.get_model(gwtnames[1]) sftpack = gwt.get_package(f"sft-3") @@ -765,8 +761,6 @@ def make_concentration_vs_time(sim, ws, ans_lak1, ans_sfr3, ans_sfr4): print(f"Creating {fname}") plt.savefig(fname) - return - def make_head_map(sim, ws): print("making head map...") @@ -880,9 +874,7 @@ def make_concentration_map(sim, ws): plt.savefig(fname) -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # these answer files are results from autotest/prudic2004test2 fname = os.path.join(model_path, "result_conc_lak1.txt") ans_lak1 = np.loadtxt(fname) @@ -892,11 +884,11 @@ def eval_results(sim): ans_sfr4 = np.loadtxt(fname) makeplot = False - for idx, arg in enumerate(sys.argv): + for arg in sys.argv: if arg.lower() == "--makeplot": makeplot = True - ws = sim.simpath + ws = test.workspace simfp = flopy.mf6.MFSimulation.load(sim_ws=ws, strict=False) if makeplot: @@ -906,7 +898,7 @@ def eval_results(sim): make_concentration_map(simfp, ws) # ensure concentrations were saved - ws = sim.simpath + ws = test.workspace gwfname = gwfnames[0] gwtname = gwtnames[0] @@ -921,7 +913,6 @@ def eval_results(sim): sft3outflowconc = None sft4outflowconc = None if sft_on and transport_on: - # get southern model gwt = simfp.get_model(gwtnames[1]) sftpack = gwt.get_package(f"sft-3") @@ -957,22 +948,15 @@ def eval_results(sim): msg = f"{res_sfr4} {ans_sfr4} {d}" assert np.allclose(res_sfr4, ans_sfr4, atol=atol), msg - # uncomment when testing - # assert False - @pytest.mark.slow -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_sft01.py b/autotest/test_gwt_sft01.py index 69228d1abcc..ef6d2f744e7 100644 --- a/autotest/test_gwt_sft01.py +++ b/autotest/test_gwt_sft01.py @@ -1,22 +1,24 @@ -# Simple one-layer model with sfr on top. Purpose is to test transport in a -# one-d sfr network. Flows in the sfr network were specified to exactly -# match flows in the aquifer. A constant concentration boundary is -# specified upgradient for both the stream and aquifer, so concentrations -# in the stream should exactly equal the concentrations in the aquifer. -# There is no flow between the stream and the aquifer. +""" +Simple one-layer model with sfr on top. Purpose is to test transport in a +one-d sfr network. Flows in the sfr network were specified to exactly +match flows in the aquifer. A constant concentration boundary is +specified upgradient for both the stream and aquifer, so concentrations +in the stream should exactly equal the concentrations in the aquifer. +There is no flow between the stream and the aquifer. +""" import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["sft_01"] +cases = ["sft_01"] -def build_model(idx, dir): +def build_models(idx, test): lx = 7.0 lz = 1.0 nlay = 1 @@ -46,10 +48,10 @@ def build_model(idx, dir): nouter, ninner = 700, 300 hclose, rclose, relax = 1e-8, 1e-6, 0.97 - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -365,14 +367,12 @@ def build_model(idx, dir): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # ensure lake concentrations were saved - name = sim.name + name = test.name gwtname = "gwt_" + name fname = gwtname + ".sft.bin" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) # load the lake concentrations and make sure all values are correct @@ -381,14 +381,14 @@ def eval_results(sim): # load the aquifer concentrations and make sure all values are correct fname = gwtname + ".ucn" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) cobj = flopy.utils.HeadFile(fname, text="CONCENTRATION") caq = cobj.get_data().flatten() assert np.allclose(csft, caq), f"{csft} {caq}" # sft observation results - fpth = os.path.join(sim.simpath, gwtname + ".sft.obs.csv") + fpth = os.path.join(test.workspace, gwtname + ".sft.obs.csv") try: tc = np.genfromtxt(fpth, names=True, delimiter=",") except: @@ -402,7 +402,7 @@ def eval_results(sim): # load the sft budget file fname = gwtname + ".sft.bud" - fname = os.path.join(sim.simpath, fname) + fname = os.path.join(test.workspace, fname) assert os.path.isfile(fname) bobj = flopy.utils.CellBudgetFile(fname, precision="double", verbose=False) @@ -421,21 +421,14 @@ def eval_results(sim): msg = f"{qs} /= {qa}" assert np.allclose(qs, qa), msg - # uncomment when testing - # assert False - - -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=0 - ), - ws, + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_sft01gwtgwt.py b/autotest/test_gwt_sft01gwtgwt.py index ba63d36a3a2..7ee5c4c1e1d 100644 --- a/autotest/test_gwt_sft01gwtgwt.py +++ b/autotest/test_gwt_sft01gwtgwt.py @@ -1,28 +1,30 @@ -# Based on sft01, but split into two gwf models and two gwt models -# in order to test gwf-gwf and gwt-gwt. There are sfr and sft models -# for flow and transport. The sfr flows and the sft concentrations -# should match exactly with the gwf flows and the gwf concentrations. - -# flow1 flow2 -# sfr 1 2 3 4 5 6 7 gwfgwf-mvr => 1 2 3 4 5 6 7 -# ------------- ------------- (sfr leakance is zero so no flow between sfr and gwf) -# gwf 1 2 3 4 5 6 7 gwfgwf => 1 2 3 4 5 6 7 -# | | -# gwfgwt (flow1-transport1) gwfgwt (flow2-transport2) -# | | -# transport1 transport2 -# sft 1 2 3 4 5 6 7 gwtgwt-mvt => 1 2 3 4 5 6 7 -# ------------- ------------- -# gwt 1 2 3 4 5 6 7 gwtgwt => 1 2 3 4 5 6 7 +""" +Based on sft01, but split into two gwf models and two gwt models +in order to test gwf-gwf and gwt-gwt. There are sfr and sft models +for flow and transport. The sfr flows and the sft concentrations +should match exactly with the gwf flows and the gwf concentrations. + + flow1 flow2 + sfr 1 2 3 4 5 6 7 gwfgwf-mvr => 1 2 3 4 5 6 7 + ------------- ------------- (sfr leakance is zero so no flow between sfr and gwf) + gwf 1 2 3 4 5 6 7 gwfgwf => 1 2 3 4 5 6 7 + | | + gwfgwt (flow1-transport1) gwfgwt (flow2-transport2) + | | + transport1 transport2 + sft 1 2 3 4 5 6 7 gwtgwt-mvt => 1 2 3 4 5 6 7 + ------------- ------------- + gwt 1 2 3 4 5 6 7 gwtgwt => 1 2 3 4 5 6 7 +""" import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["sft01gwtgwt"] +cases = ["sft01gwtgwt"] # properties for each model combination lx = 7.0 @@ -59,14 +61,13 @@ across_model_mvt_on = True and across_model_mvr_on -def build_model(idx, ws): - +def build_models(idx, test): name = "mf6sim" sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", - sim_ws=ws, + sim_ws=test.workspace, continue_=False, ) @@ -180,8 +181,7 @@ def build_model(idx, ws): mvrspd = [ ["flow1", "sfr-1", ncol - 1, "flow2", "sfr-1", 0, "FACTOR", 1.00] ] - mvr = flopy.mf6.ModflowMvr( - sim, + gwfgwf.mvr.initialize( modelnames=True, maxmvr=maxmvr, print_flows=True, @@ -212,14 +212,13 @@ def build_model(idx, ws): # simulation GWT-GWT Mover if across_model_mvt_on: - mvt = flopy.mf6.modflow.ModflowGwtmvt(sim, filename=mvt_filerecord) + gwtgwt.mvt.initialize(filename=mvt_filerecord) regression = None return sim, regression def build_gwfgwt_combo(sim, gwfname, gwtname, icombo): - # create gwf model gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname) @@ -481,18 +480,16 @@ def build_gwfgwt_combo(sim, gwfname, gwtname, icombo): return sim, None -def eval_results(sim): - print("evaluating results...") - +def check_output(idx, test): # load the simulations - ws = sim.simpath - sim = flopy.mf6.MFSimulation.load(sim_ws=ws) + ws = test.workspace + test = flopy.mf6.MFSimulation.load(sim_ws=ws) # construct head and conc for combined models - gwf1 = sim.gwf[0] - gwf2 = sim.gwf[1] - gwt1 = sim.gwt[0] - gwt2 = sim.gwt[1] + gwf1 = test.gwf[0] + gwf2 = test.gwf[1] + gwt1 = test.gwt[0] + gwt2 = test.gwt[1] head = list(gwf1.output.head().get_data().flatten()) + list( gwf2.output.head().get_data().flatten() ) @@ -513,17 +510,13 @@ def eval_results(sim): ), "aquifer concentration does not equal sfr concentration" -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_results, idxsim=idx - ), - ws, + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_src01.py b/autotest/test_gwt_src01.py index 1535cdbd909..7f3f5ceb905 100644 --- a/autotest/test_gwt_src01.py +++ b/autotest/test_gwt_src01.py @@ -4,21 +4,20 @@ on the right side. The simulation time is set to be large so that the result is a linear gradient in concentration that can be calculated from a simple diffusion equation of the form, F = D * (c1 - c0) / L. - """ import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["src01a"] +cases = ["src01a"] xt3d = [False] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 1, 1, 100 nper = 1 perlen = [1.0e10] @@ -46,10 +45,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -238,13 +237,11 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() @@ -256,17 +253,13 @@ def eval_transport(sim): ), "simulated concentrations do not match with known solution." -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ssm01fmi.py b/autotest/test_gwt_ssm01fmi.py index f25cb062679..6da7ac1a95c 100644 --- a/autotest/test_gwt_ssm01fmi.py +++ b/autotest/test_gwt_ssm01fmi.py @@ -1,7 +1,9 @@ -# multiple ssm sources and sinks using a flow model followed by a -# transport model. Initial conditions and all inflows and outflows are -# assigned a concentration of 100.0 so the simulated concentration must also -# be 100. +""" +multiple ssm sources and sinks using a flow model followed by a +transport model. Initial conditions and all inflows and outflows are +assigned a concentration of 100.0 so the simulated concentration must also +be 100. +""" import os from os.path import join @@ -310,6 +312,5 @@ def run_transport_model(dir, exe): def test_ssm01fmi(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(str(function_tmpdir), mf6) - run_transport_model(str(function_tmpdir), mf6) + run_flow_model(str(function_tmpdir), targets["mf6"]) + run_transport_model(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_ssm02.py b/autotest/test_gwt_ssm02.py index 251bd3dc49c..03e8b73dcc0 100644 --- a/autotest/test_gwt_ssm02.py +++ b/autotest/test_gwt_ssm02.py @@ -4,7 +4,6 @@ will cause the concentration to increase. Then for the second stress period add recharge water with a concentration of zero which will dilute the solute concentration. Simulation results are compared against a simple calculation. - """ import os @@ -12,18 +11,17 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ssm02"] +cases = ["ssm02"] laytyp = [1] ss = [1.0e-10] sy = [0.1] nlay, nrow, ncol = 1, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): nper = 2 perlen = [2.0, 2.0] nstp = [14, 14] @@ -42,10 +40,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -217,18 +215,16 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name gwfname = "gwf_" + name - fpth = os.path.join(sim.simpath, f"{gwfname}.hds") + fpth = os.path.join(test.workspace, f"{gwfname}.hds") hobj = flopy.utils.HeadFile(fpth, precision="double") head = hobj.get_alldata().flatten() - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_alldata().flatten() @@ -252,17 +248,13 @@ def eval_transport(sim): vold = v -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ssm03.py b/autotest/test_gwt_ssm03.py index 02f8c05fad9..150e392be45 100644 --- a/autotest/test_gwt_ssm03.py +++ b/autotest/test_gwt_ssm03.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest Test the SSM FILEINPUT option for specifying source and sink concentrations. - """ import os @@ -10,13 +8,13 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ssm03"] +cases = ["ssm03"] -def build_model(idx, dir): +def build_models(idx, test): nlay, nrow, ncol = 3, 5, 5 perlen = [5.0] nstp = [5] @@ -37,10 +35,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -229,19 +227,17 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name # load concentration file - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() # load transport budget file - fpth = os.path.join(sim.simpath, f"{gwtname}.cbc") + fpth = os.path.join(test.workspace, f"{gwtname}.cbc") bobj = flopy.utils.CellBudgetFile( fpth, precision="double", @@ -249,7 +245,6 @@ def eval_transport(sim): ssmbudall = bobj.get_data(text="SOURCE-SINK MIX") for ssmbud in ssmbudall: - node, node2, q = ssmbud[0] assert node == 25, "node location for well must be 25 (GWT cell 25)" assert node2 == 1, "node2 location for well must be 1 (first well)" @@ -261,17 +256,13 @@ def eval_transport(sim): assert q < 0.0, "mass flux for chd must be less than zero" -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ssm04.py b/autotest/test_gwt_ssm04.py index df3b02ebdda..2448c7b437d 100644 --- a/autotest/test_gwt_ssm04.py +++ b/autotest/test_gwt_ssm04.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the SSM FILEINPUT option for specifying source and sink concentrations. @@ -8,7 +7,6 @@ 2. array-based recharge, no time array series 3. list-based recharge with time series 4. array-based recharge with time array series - """ import os @@ -16,10 +14,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ssm04"] +cases = ["ssm04"] nlay, nrow, ncol = 3, 5, 5 idomain_lay0 = [ @@ -33,7 +31,7 @@ idomain[0, :, :] = np.array(idomain_lay0) -def build_model(idx, dir): +def build_models(idx, test): perlen = [5.0, 5.0, 5.0] nstp = [5, 5, 5] tsmult = [1.0, 1.0, 1.0] @@ -53,10 +51,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -168,7 +166,7 @@ def build_model(idx, dir): nodeu = i * nrow + j tsnames.append(f"rch-{nodeu + 1}") ts_data = [] - totim = 0. + totim = 0.0 for kper in range(nper): totim += perlen[kper] for t in [0, totim]: @@ -330,7 +328,7 @@ def build_model(idx, dir): nodeu = i * ncol + j tsnames.append(f"crch-{nodeu + 1}") ts_data = [tuple([0.0] + list(range(1, nrow * ncol + 1)))] - for t in [5., 10., 15.]: + for t in [5.0, 10.0, 15.0]: ts = tuple([float(t)] + list(range(1, nrow * ncol + 1))) ts_data.append(ts) ts_dict = { @@ -360,7 +358,7 @@ def build_model(idx, dir): # for now write the recharge concentration to a dat file because there # is a bug in flopy that will not correctly write this array as internal tas_array = { - 0.0: f"{gwtname}.rch4.spc.tas.dat", + 0.0: f"{gwtname}.rch4.spc.tas.dat", 5.0: f"{gwtname}.rch4.spc.tas.dat", 10.0: f"{gwtname}.rch4.spc.tas.dat", 15.0: f"{gwtname}.rch4.spc.tas.dat", @@ -419,19 +417,17 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name # load concentration file - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() # load transport budget file - fpth = os.path.join(sim.simpath, f"{gwtname}.cbc") + fpth = os.path.join(test.workspace, f"{gwtname}.cbc") bobj = flopy.utils.CellBudgetFile( fpth, precision="double", @@ -505,17 +501,13 @@ def eval_transport(sim): istart = istop -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ssm04fmi.py b/autotest/test_gwt_ssm04fmi.py index 5950d5b3a64..a43c9074f29 100644 --- a/autotest/test_gwt_ssm04fmi.py +++ b/autotest/test_gwt_ssm04fmi.py @@ -1,5 +1,4 @@ """ -MODFLOW 6 Autotest Test the SSM FILEINPUT option for specifying source and sink concentrations. @@ -8,7 +7,6 @@ 2. array-based recharge, no time array series 3. list-based recharge with time series 4. array-based recharge with time array series - """ import os @@ -17,8 +15,6 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation testgroup = "ssm04fmi" @@ -50,8 +46,8 @@ recharge_package_3 = False recharge_package_4 = False -def run_flow_model(dir, exe): +def run_flow_model(dir, exe): name = "flow" gwfname = name wsf = join(dir, testgroup, name) @@ -175,7 +171,7 @@ def run_flow_model(dir, exe): nodeu = i * nrow + j tsnames.append(f"rch-{nodeu + 1}") ts_data = [] - totim = 0. + totim = 0.0 for kper in range(nper): totim += perlen[kper] for t in [0, totim]: @@ -226,7 +222,9 @@ def run_flow_model(dir, exe): interpolation_methodrecord=interpolation_methodrecord, ) np.savetxt( - os.path.join(wsf, f"{gwfname}.rch4.tas.dat"), recharge_rate, fmt="%7.1f" + os.path.join(wsf, f"{gwfname}.rch4.tas.dat"), + recharge_rate, + fmt="%7.1f", ) # output control @@ -246,7 +244,6 @@ def run_flow_model(dir, exe): def run_transport_model(dir, exe): - name = "transport" gwtname = name wst = join(dir, testgroup, name) @@ -368,7 +365,7 @@ def run_transport_model(dir, exe): nodeu = i * ncol + j tsnames.append(f"crch-{nodeu + 1}") ts_data = [tuple([0.0] + list(range(1, nrow * ncol + 1)))] - for t in [5., 10., 15.]: + for t in [5.0, 10.0, 15.0]: ts = tuple([float(t)] + list(range(1, nrow * ncol + 1))) ts_data.append(ts) ts_dict = { @@ -400,7 +397,7 @@ def run_transport_model(dir, exe): # for now write the recharge concentration to a dat file because there # is a bug in flopy that will not correctly write this array as internal tas_array = { - 0.0: f"{gwtname}.rch4.spc.tas.dat", + 0.0: f"{gwtname}.rch4.spc.tas.dat", 5.0: f"{gwtname}.rch4.spc.tas.dat", 10.0: f"{gwtname}.rch4.spc.tas.dat", 15.0: f"{gwtname}.rch4.spc.tas.dat", @@ -413,7 +410,9 @@ def run_transport_model(dir, exe): time_series_namerecord=time_series_namerecord, interpolation_methodrecord=interpolation_methodrecord, ) - recharge_concentration = np.arange(nrow * ncol).reshape((nrow, ncol)) + 1 + recharge_concentration = ( + np.arange(nrow * ncol).reshape((nrow, ncol)) + 1 + ) np.savetxt( os.path.join(wst, f"{gwtname}.rch4.spc.tas.dat"), recharge_concentration, @@ -464,8 +463,8 @@ def run_transport_model(dir, exe): eval_transport(wst) return + def eval_transport(wst): - print("evaluating transport...") gwtname = "transport" # load concentration file @@ -490,7 +489,7 @@ def eval_transport(wst): # Check records for each of the four recharge packages ssmbud = ssmbudall[itime] istart = 0 - for irchpak in [2]: # [1, 2, 3, 4]: + for irchpak in [2]: # [1, 2, 3, 4]: print(f" Checking records for recharge package {irchpak}") istop = istart + 23 @@ -551,6 +550,5 @@ def eval_transport(wst): def test_ssm04fmi(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(str(function_tmpdir), mf6) - run_transport_model(str(function_tmpdir), mf6) + run_flow_model(str(function_tmpdir), targets["mf6"]) + run_transport_model(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_ssm05.py b/autotest/test_gwt_ssm05.py index 0945813cbd9..229b14bd757 100644 --- a/autotest/test_gwt_ssm05.py +++ b/autotest/test_gwt_ssm05.py @@ -1,8 +1,6 @@ """ -MODFLOW 6 Autotest Test the SSM package auxiliary variables for specifying source and sink concentrations for array based recharge. - """ import os @@ -10,10 +8,10 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["ssm05"] +cases = ["ssm05"] nlay, nrow, ncol = 3, 5, 5 idomain_lay0 = [ @@ -27,7 +25,7 @@ idomain[0, :, :] = np.array(idomain_lay0) -def build_model(idx, dir): +def build_models(idx, test): perlen = [5.0] nstp = [5] tsmult = [1.0] @@ -47,10 +45,10 @@ def build_model(idx, dir): for i in range(nper): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -238,19 +236,17 @@ def build_model(idx, dir): return sim, None -def eval_transport(sim): - print("evaluating transport...") - - name = sim.name +def check_output(idx, test): + name = test.name gwtname = "gwt_" + name # load concentration file - fpth = os.path.join(sim.simpath, f"{gwtname}.ucn") + fpth = os.path.join(test.workspace, f"{gwtname}.ucn") cobj = flopy.utils.HeadFile(fpth, precision="double", text="CONCENTRATION") conc = cobj.get_data() # load transport budget file - fpth = os.path.join(sim.simpath, f"{gwtname}.cbc") + fpth = os.path.join(test.workspace, f"{gwtname}.cbc") bobj = flopy.utils.CellBudgetFile( fpth, precision="double", @@ -314,17 +310,13 @@ def eval_transport(sim): istart = istop -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_transport, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_ssm06.py b/autotest/test_gwt_ssm06.py index 1371aec43e2..6dccd9202d9 100644 --- a/autotest/test_gwt_ssm06.py +++ b/autotest/test_gwt_ssm06.py @@ -1,5 +1,7 @@ -# Derived from test_gwt_ssm01fmi.py, but drops RIV and adds SFR. -# See test_gwt_ssm06fmi.py for additional detail on what this test is about. +""" +Derived from test_gwt_ssm01fmi.py, but drops RIV and adds SFR. +See test_gwt_ssm06fmi.py for additional detail on what this test is about. +""" import os @@ -16,11 +18,9 @@ top = 100.0 botm = 0.0 -# # Add SFR for serving as a MVR receiver (something's up when multiple packages # appear in SSM and MVR is active. When MVR is inactive, all seem to work well. # However, things break as soon as MVR is activated. -# conns = [(0, -1), (1, 0, -2), (2, 1, -3), (3, 2, -4), (4, 3)] @@ -189,7 +189,8 @@ def run_flw_and_trnprt_models(dir, exe): budget_filerecord=gwfname + ".sfr.bud", save_flows=True, pname="SFR-1", - unit_conversion=86400.0 * 1.486, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=False, nreaches=len(conns), packagedata=sfr_pkdat, @@ -347,5 +348,4 @@ def run_flw_and_trnprt_models(dir, exe): def test_ssm06(function_tmpdir, targets): - mf6 = targets.mf6 - run_flw_and_trnprt_models(str(function_tmpdir), mf6) + run_flw_and_trnprt_models(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_ssm06fmi.py b/autotest/test_gwt_ssm06fmi.py index 372b1efd1d4..c7e74a3c176 100644 --- a/autotest/test_gwt_ssm06fmi.py +++ b/autotest/test_gwt_ssm06fmi.py @@ -1,11 +1,13 @@ -# Derived from test_gwt_ssm01fmi.py, but drops RIV and adds SFR. -# In that autotest, flow and transport run separately, which is the case here -# as well. However, by adding SFR we can now invoke MVR, in this case -# WEL -> SFR at the same time as invoking auxiliary variables. A -# companion autotest runs this same simulation (uses SFR in place of RIV for -# receiving MVR water), but runs both flow and tranport simultaneously which, -# at one time, wrongly threw an input error. However, running the models -# separately never threw the error. +""" +Derived from test_gwt_ssm01fmi.py, but drops RIV and adds SFR. +In that autotest, flow and transport run separately, which is the case here +as well. However, by adding SFR we can now invoke MVR, in this case +WEL -> SFR at the same time as invoking auxiliary variables. A +companion autotest runs this same simulation (uses SFR in place of RIV for +receiving MVR water), but runs both flow and tranport simultaneously which, +at one time, wrongly threw an input error. However, running the models +separately never threw the error. +""" import os @@ -22,11 +24,9 @@ top = 100.0 botm = 0.0 -# # Add SFR for serving as a MVR receiver (something's up when multiple packages # appear in SSM and MVR is active. When MVR is inactive, all seem to work well. # However, things break as soon as MVR is activated. -# conns = [(0, -1), (1, 0, -2), (2, 1, -3), (3, 2, -4), (4, 3)] @@ -204,7 +204,8 @@ def run_flow_model(dir, exe): budget_filerecord=gwfname + ".sfr.bud", save_flows=True, pname="SFR-1", - unit_conversion=86400.0 * 1.486, + length_conversion=3.28084, + time_conversion=86400.0, boundnames=False, nreaches=len(conns), packagedata=sfr_pkdat, @@ -380,6 +381,5 @@ def run_transport_model(dir, exe): def test_ssm06fmi(function_tmpdir, targets): - mf6 = targets.mf6 - run_flow_model(str(function_tmpdir), mf6) - run_transport_model(str(function_tmpdir), mf6) + run_flow_model(str(function_tmpdir), targets["mf6"]) + run_transport_model(str(function_tmpdir), targets["mf6"]) diff --git a/autotest/test_gwt_uzt01.py b/autotest/test_gwt_uzt01.py index 50f1f482bb9..7f2837ef035 100644 --- a/autotest/test_gwt_uzt01.py +++ b/autotest/test_gwt_uzt01.py @@ -1,9 +1,8 @@ """ -# Test uzt for one-d transport in a vertical column. This problem is based +Test uzt for one-d transport in a vertical column. This problem is based on test_gwf_uzf03.py. Infiltration is assigned a concentration of 100. The -# uzet concentration is also assigned as 100. so that the calculated uzf cells -# should have a concentration of 100. - +uzet concentration is also assigned as 100. so that the calculated uzf cells +should have a concentration of 100. """ import os @@ -11,15 +10,14 @@ import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation -ex = ["uzt01a"] +cases = ["uzt01a"] nlay, nrow, ncol = 15, 1, 1 -def build_model(idx, dir): - +def build_models(idx, test): perlen = [17.7] nper = len(perlen) nstp = [177] @@ -49,10 +47,10 @@ def build_model(idx, dir): for id in range(nper): tdis_rc.append((perlen[id], nstp[id], tsmult[id])) - name = ex[idx] + name = cases[idx] # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -379,14 +377,14 @@ def make_plot(sim, obsvals): print("making plots...") name = sim.name - ws = sim.simpath + ws = sim.workspace # shows curves for times 2.5, 7.5, 12.6, 17.7 # which are indices 24, 74, 125, and -1 - idx = [24, 74, 125, -1] + indices = [24, 74, 125, -1] obsvals = [list(row) for row in obsvals] - obsvals = [obsvals[i] for i in idx] + obsvals = [obsvals[i] for i in indices] obsvals = np.array(obsvals) import matplotlib.pyplot as plt @@ -414,7 +412,7 @@ def make_plot(sim, obsvals): def check_obs(sim): print("checking obs...") name = sim.name - ws = sim.simpath + ws = sim.workspace sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwfname = "gwf_" + name gwtname = "gwt_" + name @@ -485,13 +483,11 @@ def check_obs(sim): assert success, "One or more UZT obs checks did not pass" -def eval_flow(sim): - print("evaluating flow...") - - name = sim.name +def check_output(idx, test): + name = test.name gwfname = "gwf_" + name gwtname = "gwt_" + name - ws = sim.simpath + ws = test.workspace # check binary grid file fname = os.path.join(ws, gwfname + ".dis.grb") @@ -553,26 +549,22 @@ def eval_flow(sim): assert np.allclose(c, canswer) # check observations - check_obs(sim) + check_obs(test) # Make plot of obs - fpth = os.path.join(sim.simpath, gwtname + ".uzt.obs.concentration.csv") + fpth = os.path.join(test.workspace, gwtname + ".uzt.obs.concentration.csv") obsvals = np.genfromtxt(fpth, names=True, delimiter=",") # make_plot(sim, obsvals) -@pytest.mark.parametrize( - "name", - ex, -) -def test_mf6model(name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, 0, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_flow, idxsim=0 - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), ) + test.run() diff --git a/autotest/test_gwt_zb01.py b/autotest/test_gwt_zb01.py index 8bd78e8d48c..b0e2956f047 100644 --- a/autotest/test_gwt_zb01.py +++ b/autotest/test_gwt_zb01.py @@ -1,6 +1,7 @@ -# test that zonebudget works on a cell budget file from GWT -# https://github.com/MODFLOW-USGS/modflow6/discussions/1181 - +""" +Test that zonebudget works on a cell budget file from GWT +https://github.com/MODFLOW-USGS/modflow6/discussions/1181 +""" import os from pathlib import Path @@ -8,18 +9,14 @@ import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation +from framework import TestFramework -name = "zbud6_zb01" +cases = ["zbud6_zb01"] htol = None dtol = 1e-3 budtol = 1e-2 -bud_lst = [ - "STORAGE-AQUEOUS_IN", - "STORAGE-AQUEOUS_OUT" -] +bud_lst = ["STORAGE-AQUEOUS_IN", "STORAGE-AQUEOUS_OUT"] zone_lst = [] for n in bud_lst: s = n.replace("_", "-") @@ -44,7 +41,8 @@ size3d = nlay * nrow * ncol -def build_model(dir, exe): +def build_models(idx, test): + name = cases[idx] perlen = [timetoend] nstp = [50] tsmult = [1.0] @@ -58,9 +56,9 @@ def build_model(dir, exe): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # build MODFLOW 6 files - ws = dir + ws = test.workspace sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name=exe, sim_ws=ws + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) # create tdis package tdis = flopy.mf6.ModflowTdis( @@ -108,11 +106,18 @@ def build_model(dir, exe): w = {0: wellist} # grid discretization - dis = flopy.mf6.ModflowGwfdis(gwf, nlay=nlay, nrow=nrow, ncol=ncol, - delr=delr, delc=delc, - top=top, botm=botm, - idomain=np.ones((nlay, nrow, ncol), dtype=int), - filename=f"{gwfname}.dis") + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=np.ones((nlay, nrow, ncol), dtype=int), + filename=f"{gwfname}.dis", + ) # initial conditions ic = flopy.mf6.ModflowGwfic(gwf, strt=strt, filename=f"{gwfname}.ic") @@ -188,11 +193,18 @@ def build_model(dir, exe): sim.register_ims_package(imsgwt, [gwt.name]) # gwt grid discretization - dis = flopy.mf6.ModflowGwtdis(gwt, nlay=nlay, nrow=nrow, ncol=ncol, - delr=delr, delc=delc, - top=top, botm=botm, - idomain=np.ones((nlay, nrow, ncol), dtype=int), - filename=f"{gwtname}.dis") + dis = flopy.mf6.ModflowGwtdis( + gwt, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=top, + botm=botm, + idomain=np.ones((nlay, nrow, ncol), dtype=int), + filename=f"{gwtname}.dis", + ) # initial conditions ic = flopy.mf6.ModflowGwtic(gwt, strt=0.0, filename=f"{gwtname}.ic") @@ -235,22 +247,21 @@ def build_model(dir, exe): return sim, None -def eval_zb6(sim, exe): - print("evaluating zonebudget...") - ws = Path(sim.simpath) +def check_output(idx, test): + ws = Path(test.workspace) # build zonebudget files # start with 1 since budget isn't calculated for zone 0 - zones = [k + 1 for k in range(nlay)] + zones = [k + 1 for k in range(nlay)] nzones = len(zones) with open(ws / "zonebudget.nam", "w") as f: f.write("BEGIN ZONEBUDGET\n") - f.write(f" BUD gwt_{sim.name}.cbc\n") - f.write(f" ZON {sim.name}.zon\n") - f.write(f" GRB gwf_{sim.name}.dis.grb\n") + f.write(f" BUD gwt_{test.name}.cbc\n") + f.write(f" ZON {test.name}.zon\n") + f.write(f" GRB gwf_{test.name}.dis.grb\n") f.write("END ZONEBUDGET\n") - with open(ws / f"{sim.name}.zon", "w") as f: + with open(ws / f"{test.name}.zon", "w") as f: f.write("BEGIN DIMENSIONS\n") f.write(f" NCELLS {size3d}\n") f.write("END DIMENSIONS\n\n") @@ -262,7 +273,7 @@ def eval_zb6(sim, exe): # run zonebudget success, buff = flopy.run_model( - exe, + test.targets["zbud6"], "zonebudget.nam", model_ws=ws, silent=False, @@ -270,10 +281,12 @@ def eval_zb6(sim, exe): ) assert success - sim.success = success + test.success = success # read data from csv file - zbd = np.genfromtxt(ws / "zonebudget.csv", names=True, delimiter=",", deletechars="") + zbd = np.genfromtxt( + ws / "zonebudget.csv", names=True, delimiter=",", deletechars="" + ) # sum the data for all zones nentries = int(zbd.shape[0] / nzones) @@ -297,8 +310,8 @@ def eval_zb6(sim, exe): # get results from listing file # todo: should flopy have a subclass for GWT list file? budl = flopy.utils.mflistfile.ListBudget( - ws / f"gwt_{os.path.basename(sim.name)}.lst", - budgetkey="MASS BUDGET FOR ENTIRE MODEL" + ws / f"gwt_{os.path.basename(test.name)}.lst", + budgetkey="MASS BUDGET FOR ENTIRE MODEL", ) names = list(bud_lst) found_names = budl.get_record_names() @@ -307,19 +320,17 @@ def eval_zb6(sim, exe): nbud = d0.shape[0] # get results from cbc file - cbc_bud = [ - "STORAGE-AQUEOUS" - ] + cbc_bud = ["STORAGE-AQUEOUS"] d = np.recarray(nbud, dtype=dtype) for key in bud_lst: d[key] = 0.0 cobj = flopy.utils.CellBudgetFile( - ws / f"gwt_{os.path.basename(sim.name)}.cbc", - precision="double") + ws / f"gwt_{os.path.basename(test.name)}.cbc", precision="double" + ) rec = cobj.list_records() kk = cobj.get_kstpkper() times = cobj.get_times() - for idx, (k, t) in enumerate(zip(kk, times)): + for i, (k, t) in enumerate(zip(kk, times)): for text in cbc_bud: qin = 0.0 qout = 0.0 @@ -337,86 +348,81 @@ def eval_zb6(sim, exe): qout -= vv else: qin += vv - d["totim"][idx] = t - d["time_step"][idx] = k[0] + d["totim"][i] = t + d["time_step"][i] = k[0] d["stress_period"] = k[1] key = f"{text}_IN" - d[key][idx] = qin + d[key][i] = qin key = f"{text}_OUT" - d[key][idx] = qout + d[key][i] = qout # calculate absolute difference diff = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, key in enumerate(bud_lst): - diff[:, idx] = d0[key] - d[key] + for i, key in enumerate(bud_lst): + diff[:, i] = d0[key] - d[key] diffmax = np.abs(diff).max() msg = f"maximum absolute total-budget difference ({diffmax}) " # write summary - with open(ws / f"{os.path.basename(sim.name)}.bud.cmp.out", "w") as f: + with open(ws / f"{os.path.basename(test.name)}.bud.cmp.out", "w") as f: for i in range(diff.shape[0]): if i == 0: line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): + for key in bud_lst: line += f"{key + '_LST':>25s}" line += f"{key + '_CBC':>25s}" line += f"{key + '_DIF':>25s}" f.write(line + "\n") line = f"{d['totim'][i]:10g}" - for idx, key in enumerate(bud_lst): + for ii, key in enumerate(bud_lst): line += f"{d0[key][i]:25g}" line += f"{d[key][i]:25g}" - line += f"{diff[i, idx]:25g}" + line += f"{diff[i, ii]:25g}" f.write(line + "\n") # compare zone budget output to cbc output diffzb = np.zeros((nbud, len(bud_lst)), dtype=float) - for idx, (key0, key) in enumerate(zip(zone_lst, bud_lst)): - diffzb[:, idx] = zbsum[key0] - d[key] + for i, (key0, key) in enumerate(zip(zone_lst, bud_lst)): + diffzb[:, i] = zbsum[key0] - d[key] diffzbmax = np.abs(diffzb).max() msg += ( f"\nmaximum absolute zonebudget-cell by cell difference ({diffzbmax}) " ) # write summary - with open(ws / f"{os.path.basename(sim.name)}.zbud.cmp.out", "w") as f: + with open(ws / f"{os.path.basename(test.name)}.zbud.cmp.out", "w") as f: for i in range(diff.shape[0]): if i == 0: line = f"{'TIME':>10s}" - for idx, key in enumerate(bud_lst): + for key in bud_lst: line += f"{key + '_ZBUD':>25s}" line += f"{key + '_CBC':>25s}" line += f"{key + '_DIF':>25s}" f.write(line + "\n") line = f"{d['totim'][i]:10g}" - for idx, (key0, key) in enumerate(zip(zone_lst, bud_lst)): + for ii, (key0, key) in enumerate(zip(zone_lst, bud_lst)): line += f"{zbsum[key0][i]:25g}" line += f"{d[key][i]:25g}" - line += f"{diffzb[i, idx]:25g}" + line += f"{diffzb[i, ii]:25g}" f.write(line + "\n") if diffmax > budtol or diffzbmax > budtol: - sim.success = False + test.success = False msg += f"\n...exceeds {budtol}" assert diffmax < budtol and diffzbmax < budtol, msg else: - sim.success = True + test.success = True print(" " + msg) -def test_mf6model(function_tmpdir, targets): - ws = str(function_tmpdir) - mf6 = targets.mf6 - zb6 = targets.zbud6 - test = TestFramework() - test.build(lambda _, w: build_model(w, mf6), 0, ws) - test.run( - TestSimulation( - name=name, - exe_dict=targets, - exfunc=lambda s: eval_zb6(s, zb6), - htol=htol, - idxsim=0, - ), - ws, +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + htol=htol, ) + test.run() diff --git a/autotest/test_gwtgwt_oldexg.py b/autotest/test_gwtgwt_oldexg.py index 48b9ba073cf..fef038e1c5d 100644 --- a/autotest/test_gwtgwt_oldexg.py +++ b/autotest/test_gwtgwt_oldexg.py @@ -1,33 +1,35 @@ +""" +Test compatibility of GWT-GWT with the 'classic' GWF exchange. +It compares the result of a single reference model +to the equivalent case where the domain is decomposed: + + 'refmodel' 'leftmodel' 'rightmodel' + + 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + +We assert equality on the head values and the (components of) +specific discharges. All models are part of the same solution +for convenience. Finally, the budget error is checked. +""" + import os import flopy import numpy as np import pytest + from framework import TestFramework -from simulation import TestSimulation - -# Test compatibility of GWT-GWT with the 'classic' GWF exchange. -# It compares the result of a single reference model -# to the equivalent case where the domain is decomposed: -# -# 'refmodel' 'leftmodel' 'rightmodel' -# -# 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 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 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 VS 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 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 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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -# -# We assert equality on the head values and the (components of) -# specific discharges. All models are part of the same solution -# for convenience. Finally, the budget error is checked. - -ex = ["gwtgwt_oldexg"] + +cases = ["gwtgwt_oldexg"] use_ifmod = False # some global convenience...: @@ -87,7 +89,7 @@ def get_model(idx, dir): - name = ex[idx] + name = cases[idx] # parameters and spd # tdis @@ -554,8 +556,8 @@ def add_gwtexchange(sim): ) -def build_model(idx, exdir): - sim = get_model(idx, exdir) +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None @@ -579,32 +581,32 @@ def qxqyqz(fname, nlay, nrow, ncol): return qx, qy, qz -def compare_to_ref(sim): - compare_gwf_to_ref(sim) - compare_gwt_to_ref(sim) +def check_output(idx, test): + compare_gwf_to_ref(test) + compare_gwt_to_ref(test) -def compare_gwf_to_ref(sim): +def compare_gwf_to_ref(test): print("comparing heads and spec. discharge to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_ref}.hds") + fpth = os.path.join(test.workspace, f"{mname_ref}.hds") hds = flopy.utils.HeadFile(fpth) heads = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_ref}.cbc") + fpth = os.path.join(test.workspace, f"{mname_ref}.cbc") nlay, nrow, ncol = heads.shape qxb, qyb, qzb = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_left}.hds") + fpth = os.path.join(test.workspace, f"{mname_left}.hds") hds = flopy.utils.HeadFile(fpth) heads_left = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_left}.cbc") + fpth = os.path.join(test.workspace, f"{mname_left}.cbc") nlay, nrow, ncol = heads_left.shape qxb_left, qyb_left, qzb_left = qxqyqz(fpth, nlay, nrow, ncol) - fpth = os.path.join(sim.simpath, f"{mname_right}.hds") + fpth = os.path.join(test.workspace, f"{mname_right}.hds") hds = flopy.utils.HeadFile(fpth) heads_right = hds.get_data() - fpth = os.path.join(sim.simpath, f"{mname_right}.cbc") + fpth = os.path.join(test.workspace, f"{mname_right}.cbc") nlay, nrow, ncol = heads_right.shape qxb_right, qyb_right, qzb_right = qxqyqz(fpth, nlay, nrow, ncol) @@ -675,7 +677,7 @@ def compare_gwf_to_ref(sim): # check budget error from .lst file for mname in [mname_ref, mname_left, mname_right]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -689,11 +691,11 @@ def compare_gwf_to_ref(sim): for mname in [mname_ref, mname_left, mname_right]: print(f"Checking flowja residual for model {mname}") - fpth = os.path.join(sim.simpath, f"{mname}.dis.grb") + fpth = os.path.join(test.workspace, f"{mname}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) ia = grb._datadict["IA"] - 1 - fpth = os.path.join(sim.simpath, f"{mname}.cbc") + fpth = os.path.join(test.workspace, f"{mname}.cbc") assert os.path.isfile(fpth) cbb = flopy.utils.CellBudgetFile(fpth, precision="double") flow_ja_face = cbb.get_data(idx=0) @@ -708,16 +710,16 @@ def compare_gwf_to_ref(sim): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -def compare_gwt_to_ref(sim): +def compare_gwt_to_ref(test): print("comparing concentration to single model reference...") - fpth = os.path.join(sim.simpath, f"{mname_gwtref}.ucn") + fpth = os.path.join(test.workspace, f"{mname_gwtref}.ucn") cnc = flopy.utils.HeadFile(fpth, text="CONCENTRATION") conc = cnc.get_data() - fpth = os.path.join(sim.simpath, f"{mname_gwtleft}.ucn") + fpth = os.path.join(test.workspace, f"{mname_gwtleft}.ucn") cnc = flopy.utils.HeadFile(fpth, text="CONCENTRATION") conc_left = cnc.get_data() - fpth = os.path.join(sim.simpath, f"{mname_gwtright}.ucn") + fpth = os.path.join(test.workspace, f"{mname_gwtright}.ucn") cnc = flopy.utils.HeadFile(fpth, text="CONCENTRATION") conc_right = cnc.get_data() @@ -734,7 +736,7 @@ def compare_gwt_to_ref(sim): # check budget error from .lst file for mname in [mname_gwtref, mname_gwtleft, mname_gwtright]: - fpth = os.path.join(sim.simpath, f"{mname}.lst") + fpth = os.path.join(test.workspace, f"{mname}.lst") for line in open(fpth): if line.lstrip().startswith("PERCENT"): cumul_balance_error = float(line.split()[3]) @@ -749,11 +751,11 @@ def compare_gwt_to_ref(sim): print(f"Checking flowja residual for model {mname}") mflowname = mname.replace("gwt", "") - fpth = os.path.join(sim.simpath, f"{mflowname}.dis.grb") + fpth = os.path.join(test.workspace, f"{mflowname}.dis.grb") grb = flopy.mf6.utils.MfGrdFile(fpth) ia = grb._datadict["IA"] - 1 - fpth = os.path.join(sim.simpath, f"{mname}.cbc") + fpth = os.path.join(test.workspace, f"{mname}.cbc") assert os.path.isfile(fpth) cbb = flopy.utils.CellBudgetFile(fpth, precision="double") flow_ja_face = cbb.get_data(idx=0) @@ -768,17 +770,13 @@ def compare_gwt_to_ref(sim): assert np.allclose(res, 0.0, atol=1.0e-6), errmsg -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - test = TestFramework() - test.build(build_model, idx, ws) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=compare_to_ref, idxsim=idx - ), - ws, - ) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + ) + test.run() diff --git a/autotest/test_largetestmodels.py b/autotest/test_largetestmodels.py new file mode 100644 index 00000000000..1de7748a062 --- /dev/null +++ b/autotest/test_largetestmodels.py @@ -0,0 +1,36 @@ +import pytest + +from framework import TestFramework + +excluded_models = [] + + +@pytest.mark.large +@pytest.mark.repo +@pytest.mark.regression +@pytest.mark.slow +def test_model( + function_tmpdir, + # https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#large-test-models + large_test_model, + markers, + original_regression, + targets, +): + model_path = large_test_model.parent + model_name = model_path.name + excluded = model_name in excluded_models + dev_only = "dev" in model_name and "not developmode" in markers + if excluded or dev_only: + reason = "excluded" if excluded else "developmode only" + pytest.skip(f"Skipping: {model_name} ({reason})") + + test = TestFramework( + name=model_name, + workspace=model_path, + targets=targets, + compare="auto" if original_regression else "mf6_regression", + verbose=False, + ) + test.setup(model_path, function_tmpdir) + test.run() diff --git a/autotest/test_mf6_tmp_simulations.py b/autotest/test_mf6_tmp_simulations.py index 65600a5ab30..693680758d8 100644 --- a/autotest/test_mf6_tmp_simulations.py +++ b/autotest/test_mf6_tmp_simulations.py @@ -2,9 +2,9 @@ import sys import pytest + from common_regression import get_mf6_ftypes, get_namefiles from framework import TestFramework -from simulation import TestSimulation exdir = os.path.join("..", "tmp_simulations") testpaths = os.path.join("..", exdir) @@ -101,7 +101,6 @@ def run_mf6(sim, ws): appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. """ - print(os.getcwd()) src = os.path.join(exdir, sim.name) dst = os.path.join(ws, sim.name) sim.setup(src, dst) @@ -109,10 +108,11 @@ def run_mf6(sim, ws): sim.compare() -@pytest.mark.parametrize( - "idx, name", - list(enumerate(get_mf6_models())), -) +@pytest.mark.parametrize("idx, name", enumerate(get_mf6_models())) def test_mf6model(idx, name, function_tmpdir, targets): - ws = str(function_tmpdir) - run_mf6(TestSimulation(name=name, exe_dict=targets), ws) + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + ) + run_mf6(test, function_tmpdir) diff --git a/autotest/test_par_gwf01.py b/autotest/test_par_gwf01.py index 84cb1fb348b..a3c460baf4b 100644 --- a/autotest/test_par_gwf01.py +++ b/autotest/test_par_gwf01.py @@ -1,31 +1,37 @@ +""" +Test for parallel MODFLOW running on two cpus. +It contains two coupled models with + +1d: (nlay,nrow,ncol) = (1,1,5), +2d: (nlay,nrow,ncol) = (1,5,5), +3d: (nlay,nrow,ncol) = (5,5,5), + +constant head boundaries left=1.0, right=10.0. +The result should be a uniform flow field. +""" + import os import flopy import numpy as np import pytest -from framework import TestFramework -from simulation import TestSimulation -# Test for parallel MODFLOW running on two cpus. -# It contains two coupled models with -# -# 1d: (nlay,nrow,ncol) = (1,1,5), -# 2d: (nlay,nrow,ncol) = (1,5,5), -# 3d: (nlay,nrow,ncol) = (5,5,5), -# -# constant head boundaries left=1.0, right=10.0. -# The result should be a uniform flow field. +from framework import TestFramework -ex = ["par_gwf01-1d", "par_gwf01-2d", "par_gwf01-3d"] -dis_shape = [(1,1,5), (1,5,5), (5,5,5)] +cases = ["par_gwf01-1d", "par_gwf01-2d", "par_gwf01-3d"] +dis_shape = [(1, 1, 5), (1, 5, 5), (5, 5, 5)] # global convenience... name_left = "leftmodel" name_right = "rightmodel" -def get_model(idx, dir): +# solver data +nouter, ninner = 100, 300 +hclose, rclose, relax = 10e-9, 1e-3, 0.97 + - name = ex[idx] +def get_model(idx, dir): + name = cases[idx] # parameters and spd # tdis @@ -34,10 +40,6 @@ def get_model(idx, dir): for i in range(nper): tdis_rc.append((1.0, 1, 1)) - # solver data - nouter, ninner = 100, 300 - hclose, rclose, relax = 10e-9, 1e-3, 0.97 - # model spatial discretization nlay = dis_shape[idx][0] nrow = dis_shape[idx][1] @@ -66,7 +68,10 @@ def get_model(idx, dir): h_start = 0.0 sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir, + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=dir, ) tdis = flopy.mf6.ModflowTdis( @@ -78,12 +83,12 @@ def get_model(idx, dir): print_option="ALL", outer_dvclose=hclose, outer_maximum=nouter, - under_relaxation="DBD", inner_maximum=ninner, inner_dvclose=hclose, rcloserecord=rclose, linear_acceleration="BICGSTAB", relaxation_factor=relax, + pname="ims", ) # submodel on the left: @@ -103,7 +108,7 @@ def get_model(idx, dir): delr=delr, delc=delc, top=tops[0], - botm=tops[1:nlay+1], + botm=tops[1 : nlay + 1], ) ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) npf = flopy.mf6.ModflowGwfnpf( @@ -141,7 +146,7 @@ def get_model(idx, dir): xorigin=shift_x, yorigin=shift_y, top=tops[0], - botm=tops[1:nlay+1], + botm=tops[1 : nlay + 1], ) ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) npf = flopy.mf6.ModflowGwfnpf( @@ -184,51 +189,47 @@ def get_model(idx, dir): exgmnamea=name_left, exgmnameb=name_right, exchangedata=gwfgwf_data, - auxiliary=["ANGLDEGX", "CDIST"] + auxiliary=["ANGLDEGX", "CDIST"], + print_input=True, ) return sim -def build_petsc_db(exdir): - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type cg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-dvclose 10e-7\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - sim = get_model(idx, exdir) - build_petsc_db(exdir) + +def build_models(idx, test): + sim = get_model(idx, test.workspace) return sim, None -def eval_model(sim): + +def check_output(idx, test): # two coupled models with a uniform flow field, - # here we assert the known head values at the + # here we assert the known head values at the # cell centers - fpth = os.path.join(sim.simpath, f"{name_left}.hds") + fpth = os.path.join(test.workspace, f"{name_left}.hds") hds = flopy.utils.HeadFile(fpth) heads_left = hds.get_data().flatten() - fpth = os.path.join(sim.simpath, f"{name_right}.hds") + fpth = os.path.join(test.workspace, f"{name_right}.hds") hds = flopy.utils.HeadFile(fpth) heads_right = hds.get_data().flatten() - np.testing.assert_array_almost_equal(heads_left[0:5], [1.0, 2.0, 3.0, 4.0, 5.0]) - np.testing.assert_array_almost_equal(heads_right[0:5], [6.0, 7.0, 8.0, 9.0, 10.0]) + np.testing.assert_array_almost_equal( + heads_left[0:5], [1.0, 2.0, 3.0, 4.0, 5.0] + ) + np.testing.assert_array_almost_equal( + heads_right[0:5], [6.0, 7.0, 8.0, 9.0, 10.0] + ) + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=2, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, ) + test.run() diff --git a/autotest/test_par_gwf02.py b/autotest/test_par_gwf02.py index d8681868dae..70ffd2f298d 100644 --- a/autotest/test_par_gwf02.py +++ b/autotest/test_par_gwf02.py @@ -1,31 +1,37 @@ -import os +""" +Test for parallel MODFLOW running a simple +multi-model setup with different numbers +of partitions + + + [M1ny] | ... | ... | [Mnxny] + ----------------------------------- + ... | ... | ... | ... + ----------------------------------- + [M12] | ... | ... | ... + ----------------------------------- + [M11] | [M21] | ... | [Mnx1] + +with constant head set at the lower-left corner. +This constant head should reach all domains, +no matter the topology of partitions +""" import flopy import numpy as np -from decimal import Decimal import pytest + from framework import TestFramework -from simulation import TestSimulation - -# Test for parallel MODFLOW running a simple -# multi-model setup on different partitionings -# -# -# [M1ny] | ... | ... | [Mnxny] -# ----------------------------------- -# ... | ... | ... | ... -# ----------------------------------- -# [M12] | ... | ... | ... -# ----------------------------------- -# [M11] | [M21] | ... | [Mnx1] -# -# with constant head set at the lower-left corner. -# This constant head should reach all domains, -# no matter the topology of partitions - -ex = ["par_gwf02-a", "par_gwf02-b", "par_gwf02-c", - "par_gwf02-d", "par_gwf02-e", "par_gwf02-f"] -domain_grid = [(1,5), (5,1), (2,2), (3,3), (4,4), (5,5)] + +cases = [ + "par_gwf02-a", + "par_gwf02-b", + "par_gwf02-c", + "par_gwf02-d", + "par_gwf02-e", + "par_gwf02-f", +] +domain_grid = [(1, 5), (5, 1), (2, 2), (3, 3), (4, 4), (5, 5)] nlay = 1 nrow = 3 @@ -41,9 +47,8 @@ def get_model_name(ix, iy): return f"model-{ix}-{iy}" -def get_simulation(idx, dir): - - name = ex[idx] +def get_simulation(idx, ws): + name = cases[idx] nr_models_x = domain_grid[idx][0] nr_models_y = domain_grid[idx][1] @@ -59,7 +64,10 @@ def get_simulation(idx, dir): rclose, relax = 1e-3, 0.97 sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir, + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, ) tdis = flopy.mf6.ModflowTdis( @@ -90,18 +98,18 @@ def get_simulation(idx, dir): name_west = get_model_name(ix, iy) name_east = get_model_name(ix + 1, iy) add_exchange_west_east(sim, name_west, name_east) - + # add exchange from south to north for ix in range(nr_models_x): - for iy in range(nr_models_y -1 ): + for iy in range(nr_models_y - 1): name_south = get_model_name(ix, iy) name_north = get_model_name(ix, iy + 1) add_exchange_south_north(sim, name_south, name_north) return sim -def add_model(sim, ix, iy, nr_models_x, nr_models_y): +def add_model(sim, ix, iy, nr_models_x, nr_models_y): # model spatial discretization shift_x = ix * ncol * delr shift_y = iy * nrow * delc @@ -125,9 +133,9 @@ def add_model(sim, ix, iy, nr_models_x, nr_models_y): delr=delr, delc=delc, top=tops[0], - botm=tops[1:nlay+1], + botm=tops[1 : nlay + 1], xorigin=shift_x, - yorigin=shift_y + yorigin=shift_y, ) ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) npf = flopy.mf6.ModflowGwfnpf( @@ -151,8 +159,8 @@ def add_model(sim, ix, iy, nr_models_x, nr_models_y): chd_spd_sw = {0: sw_chd} chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd_sw) -def add_exchange_west_east(sim, name_west, name_east): +def add_exchange_west_east(sim, name_west, name_east): exg_filename = f"we_{name_west}_{name_east}.gwfgwf" # exchangedata angldegx = 0.0 @@ -179,11 +187,11 @@ def add_exchange_west_east(sim, name_west, name_east): exgmnameb=name_east, exchangedata=gwfgwf_data, auxiliary=["ANGLDEGX", "CDIST"], - filename=exg_filename + filename=exg_filename, ) -def add_exchange_south_north(sim, name_south, name_north): +def add_exchange_south_north(sim, name_south, name_north): exg_filename = f"sn_{name_south}_{name_north}.gwfgwf" # exchangedata @@ -192,7 +200,7 @@ def add_exchange_south_north(sim, name_south, name_north): gwfgwf_data = [ [ (ilay, 0, icol), - (ilay, nrow-1, icol), + (ilay, nrow - 1, icol), 1, delc / 2.0, delc / 2.0, @@ -211,46 +219,36 @@ def add_exchange_south_north(sim, name_south, name_north): exgmnameb=name_north, exchangedata=gwfgwf_data, auxiliary=["ANGLDEGX", "CDIST"], - filename=exg_filename + filename=exg_filename, ) -def build_petsc_db(exdir): - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type cg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write(f"-dvclose {Decimal(hclose):.2E}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - sim = get_simulation(idx, exdir) - build_petsc_db(exdir) + +def build_models(idx, test): + sim = get_simulation(idx, test.workspace) return sim, None -def eval_model(sim): - mf6_sim = flopy.mf6.MFSimulation.load(sim_ws=sim.simpath) + +def check_output(idx, test): + mf6_sim = flopy.mf6.MFSimulation.load(sim_ws=test.workspace) for mname in mf6_sim.model_names: m = mf6_sim.get_model(mname) hds = m.output.head().get_data().flatten() - hds_compare = cst_head_south_west*np.ones_like(hds) + hds_compare = cst_head_south_west * np.ones_like(hds) assert np.allclose(hds, hds_compare, atol=1.0e-6, rtol=0.0) - + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - ncpus = domain_grid[idx][0]*domain_grid[idx][1] - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=ncpus, - ), - str(function_tmpdir), + ncpus = domain_grid[idx][0] * domain_grid[idx][1] + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=ncpus, ) + test.run() diff --git a/autotest/test_par_gwf03.py b/autotest/test_par_gwf03.py index 2d329446a14..77d09a1ca8a 100644 --- a/autotest/test_par_gwf03.py +++ b/autotest/test_par_gwf03.py @@ -1,31 +1,29 @@ -import os +""" +Scaling parallel MODFLOW running a simple +(multi-)model setup on different partitionings +with constant head set at the lower-left corner. + +a: 1 cpus, 1 model +b: 1 cpus, 4 models +c: 2 cpus, 4 models +d: 4 cpus, 4 models + +The test is that for all configurations, the head +converges globally to the specified boundary value. +In general, the test can be used to compare parallel +vs. serial behavior on an identical problem. +""" import flopy import numpy as np -from decimal import Decimal import pytest + from framework import TestFramework -from simulation import TestSimulation - -# Scaling parallel MODFLOW running a simple -# (multi-)model setup on different partitionings -# with constant head set at the lower-left corner. -# -# a: 1 cpus, 1 model -# b: 1 cpus, 4 models -# c: 2 cpus, 4 models -# d: 4 cpus, 4 models -# -# The test is that for all configurations, the head -# converges globally to the specified boundary value. -# In general, the test can be used to compare parallel -# vs. serial behavior on an identical problem. - -ex = ["par_gwf03-a", "par_gwf03-b", "par_gwf03-c", "par_gwf03-d"] + +cases = ["par_gwf03-a", "par_gwf03-b", "par_gwf03-c", "par_gwf03-d"] ncpus = [1, 1, 2, 4] domain_grid = [(1, 1), (2, 2), (2, 2), (2, 2)] dis_shape = [(2, 100, 100), (2, 50, 50), (2, 50, 50), (2, 50, 50)] - delr = 100.0 delc = 100.0 head_initial = -1.0 @@ -37,9 +35,8 @@ def get_model_name(ix, iy): return f"model-{ix}-{iy}" -def get_simulation(idx, dir): - - name = ex[idx] +def get_simulation(idx, ws): + name = cases[idx] nr_models_x = domain_grid[idx][0] nr_models_y = domain_grid[idx][1] @@ -51,7 +48,7 @@ def get_simulation(idx, dir): # tdis nper = 1 tdis_rc = [] - for i in range(nper): + for _ in range(nper): tdis_rc.append((1.0, 1, 1)) # solver data @@ -59,7 +56,10 @@ def get_simulation(idx, dir): rclose, relax = 1e-3, 0.97 sim = flopy.mf6.MFSimulation( - sim_name=name, version="mf6", exe_name="mf6", sim_ws=dir, + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=ws, ) tdis = flopy.mf6.ModflowTdis( @@ -75,7 +75,7 @@ def get_simulation(idx, dir): inner_dvclose=hclose, rcloserecord=rclose, linear_acceleration="CG", - relaxation_factor=0.0, # turn this off for comparison + relaxation_factor=0.0, # turn this off for comparison ) # create models (and exchanges) @@ -89,25 +89,27 @@ def get_simulation(idx, dir): name_west = get_model_name(ix, iy) name_east = get_model_name(ix + 1, iy) add_exchange_west_east(sim, name_west, name_east, nlay, nrow, ncol) - + # add exchange from south to north for ix in range(nr_models_x): - for iy in range(nr_models_y -1 ): + for iy in range(nr_models_y - 1): name_south = get_model_name(ix, iy) name_north = get_model_name(ix, iy + 1) - add_exchange_south_north(sim, name_south, name_north, nlay, nrow, ncol) + add_exchange_south_north( + sim, name_south, name_north, nlay, nrow, ncol + ) return sim -def add_model(sim, ix, iy, nr_models_x, nr_models_y, nlay, nrow, ncol): +def add_model(sim, ix, iy, nr_models_x, nr_models_y, nlay, nrow, ncol): # model spatial discretization shift_x = ix * ncol * delr shift_y = iy * nrow * delc model_name = get_model_name(ix, iy) # top/bot of the aquifer - tops = [-100.0*i for i in range(nlay + 1)] + tops = [-100.0 * i for i in range(nlay + 1)] # hydraulic conductivity k11 = 10.0 @@ -124,9 +126,9 @@ def add_model(sim, ix, iy, nr_models_x, nr_models_y, nlay, nrow, ncol): delr=delr, delc=delc, top=tops[0], - botm=tops[1:nlay+1], + botm=tops[1 : nlay + 1], xorigin=shift_x, - yorigin=shift_y + yorigin=shift_y, ) ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) npf = flopy.mf6.ModflowGwfnpf( @@ -150,8 +152,8 @@ def add_model(sim, ix, iy, nr_models_x, nr_models_y, nlay, nrow, ncol): chd_spd_sw = {0: sw_chd} chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd_sw) -def add_exchange_west_east(sim, name_west, name_east, nlay, nrow, ncol): +def add_exchange_west_east(sim, name_west, name_east, nlay, nrow, ncol): exg_filename = f"we_{name_west}_{name_east}.gwfgwf" # exchangedata angldegx = 0.0 @@ -178,11 +180,11 @@ def add_exchange_west_east(sim, name_west, name_east, nlay, nrow, ncol): exgmnameb=name_east, exchangedata=gwfgwf_data, auxiliary=["ANGLDEGX", "CDIST"], - filename=exg_filename + filename=exg_filename, ) -def add_exchange_south_north(sim, name_south, name_north, nlay, nrow, ncol): +def add_exchange_south_north(sim, name_south, name_north, nlay, nrow, ncol): exg_filename = f"sn_{name_south}_{name_north}.gwfgwf" # exchangedata @@ -191,7 +193,7 @@ def add_exchange_south_north(sim, name_south, name_north, nlay, nrow, ncol): gwfgwf_data = [ [ (ilay, 0, icol), - (ilay, nrow-1, icol), + (ilay, nrow - 1, icol), 1, delc / 2.0, delc / 2.0, @@ -210,49 +212,35 @@ def add_exchange_south_north(sim, name_south, name_north, nlay, nrow, ncol): exgmnameb=name_north, exchangedata=gwfgwf_data, auxiliary=["ANGLDEGX", "CDIST"], - filename=exg_filename + filename=exg_filename, ) -def build_petsc_db(idx, exdir): - np = ncpus[idx] - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type cg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-sub_pc_factor_levels 2\n") - petsc_file.write(f"-dvclose {Decimal(hclose):.2E}\n") - petsc_file.write(f"-nitermax {500}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - sim = get_simulation(idx, exdir) - build_petsc_db(idx, exdir) + +def build_models(idx, test): + sim = get_simulation(idx, test.workspace) return sim, None -def eval_model(sim): - mf6_sim = flopy.mf6.MFSimulation.load(sim_ws=sim.simpath) + +def check_output(idx, test): + mf6_sim = flopy.mf6.MFSimulation.load(sim_ws=test.workspace) for mname in mf6_sim.model_names: m = mf6_sim.get_model(mname) hds = m.output.head().get_data().flatten() - hds_compare = cst_head_south_west*np.ones_like(hds) + hds_compare = cst_head_south_west * np.ones_like(hds) assert np.allclose(hds, hds_compare, rtol=1.0e-6, atol=0.0001) - + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - np = ncpus[idx] - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=np, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=ncpus[idx], ) + test.run() diff --git a/autotest/test_par_gwf_disu.py b/autotest/test_par_gwf_disu.py new file mode 100644 index 00000000000..da77695e6c2 --- /dev/null +++ b/autotest/test_par_gwf_disu.py @@ -0,0 +1,238 @@ +""" +Test for parallel MODFLOW running on two cpus. +Each case contains two coupled DISU models which are +generated from their DIS counterparts: + +1d: (nlay,nrow,ncol) = (1,1,5), +2d: (nlay,nrow,ncol) = (1,5,5), +3d: (nlay,nrow,ncol) = (5,5,5), + +constant head boundaries left=1.0, right=10.0. +The result should be a uniform flow field. +""" + +import os + +import flopy +import numpy as np +import pytest +from flopy.utils.gridutil import get_disu_kwargs + +from framework import TestFramework + +cases = [ + "par_gwf_disu1d", + "par_gwf_disu2d", + "par_gwf_disu3d", +] +dis_shape = [(1, 1, 5), (1, 1, 5), (1, 1, 5), (1, 5, 5), (5, 5, 5)] + +# global convenience... +name_left = "leftmodel" +name_right = "rightmodel" + +# solver data +nouter, ninner = 100, 300 +hclose, rclose, relax = 10e-9, 1e-3, 0.97 + + +def get_model(idx, dir): + name = cases[idx] + + # parameters and spd + # tdis + nper = 1 + tdis_rc = [] + for i in range(nper): + tdis_rc.append((1.0, 1, 1)) + + # model spatial discretization + nlay = dis_shape[idx][0] + nrow = dis_shape[idx][1] + ncol = dis_shape[idx][2] + + # cell spacing + delr = 100.0 + delr_arr = delr * np.ones(ncol) + delc = 100.0 + delc_arr = delc * np.ones(nrow) + + # shift + shift_x = 5 * delr + shift_y = 0.0 + + # top/bot of the aquifer + tops = [0.0, -100.0, -200.0, -300.0, -400.0, -500.0] + + # conversion to DISU + disukwargs = get_disu_kwargs( + nlay, + nrow, + ncol, + delr_arr, + delc_arr, + tops[0], + tops[1 : nlay + 1], + return_vertices=True, + ) + + # hydraulic conductivity + k11 = 1.0 + + # boundary stress period data + h_left = 1.0 + h_right = 10.0 + + # initial head + h_start = 0.0 + + sim = flopy.mf6.MFSimulation( + sim_name=name, + version="mf6", + exe_name="mf6", + sim_ws=dir, + ) + + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + ims = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + outer_dvclose=hclose, + outer_maximum=nouter, + inner_maximum=ninner, + inner_dvclose=hclose, + rcloserecord=rclose, + linear_acceleration="BICGSTAB", + relaxation_factor=relax, + pname="ims", + ) + + # submodel on the left: + left_chd = [ + [(ilay * ncol * nrow + irow * ncol), h_left] + for irow in range(nrow) + for ilay in range(nlay) + ] + chd_spd_left = {0: left_chd} + + gwf = flopy.mf6.ModflowGwf(sim, modelname=name_left, save_flows=True) + disu = flopy.mf6.ModflowGwfdisu(gwf, **disukwargs) + ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=False, # let's skip angledegx + save_flows=True, + icelltype=0, + k=k11, + ) + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd_left) + oc = flopy.mf6.ModflowGwfoc( + gwf, + head_filerecord=f"{name_left}.hds", + budget_filerecord=f"{name_left}.cbc", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + # submodel on the right: + right_chd = [ + [(ilay * ncol * nrow + irow * ncol + ncol - 1), h_right] + for irow in range(nrow) + for ilay in range(nlay) + ] + chd_spd_right = {0: right_chd} + + gwf = flopy.mf6.ModflowGwf(sim, modelname=name_right, save_flows=True) + disukwargs["xorigin"] = shift_x + disukwargs["yorigin"] = shift_y + disu = flopy.mf6.ModflowGwfdisu(gwf, **disukwargs) + ic = flopy.mf6.ModflowGwfic(gwf, strt=h_start) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_specific_discharge=False, # let's skip angledegx + save_flows=True, + icelltype=0, + k=k11, + ) + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chd_spd_right) + oc = flopy.mf6.ModflowGwfoc( + gwf, + head_filerecord=f"{name_right}.hds", + budget_filerecord=f"{name_right}.cbc", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + + # exchangedata + angldegx = 0.0 + cdist = delr + gwfgwf_data = [ + [ + (ilay * ncol * nrow + irow * ncol + ncol - 1), + (ilay * ncol * nrow + irow * ncol), + 1, + delr / 2.0, + delr / 2.0, + delc, + angldegx, + cdist, + ] + for irow in range(nrow) + for ilay in range(nlay) + ] + + gwfgwf = flopy.mf6.ModflowGwfgwf( + sim, + exgtype="GWF6-GWF6", + nexg=len(gwfgwf_data), + exgmnamea=name_left, + exgmnameb=name_right, + exchangedata=gwfgwf_data, + auxiliary=["ANGLDEGX", "CDIST"], + print_input=True, + ) + + return sim + + +def build_models(idx, test): + sim = get_model(idx, test.workspace) + return sim, None + + +def check_output(idx, test): + pass + # two coupled models with a uniform flow field, + # here we assert the known head values at the + # cell centers + fpth = os.path.join(test.workspace, f"{name_left}.hds") + hds = flopy.utils.HeadFile(fpth) + heads_left = hds.get_data().flatten() + fpth = os.path.join(test.workspace, f"{name_right}.hds") + hds = flopy.utils.HeadFile(fpth) + heads_right = hds.get_data().flatten() + np.testing.assert_array_almost_equal( + heads_left[0:5], [1.0, 2.0, 3.0, 4.0, 5.0] + ) + np.testing.assert_array_almost_equal( + heads_right[0:5], [6.0, 7.0, 8.0, 9.0, 10.0] + ) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, + ) + test.run() diff --git a/autotest/test_par_gwf_exgmvr01.py b/autotest/test_par_gwf_exgmvr01.py new file mode 100644 index 00000000000..61783322d68 --- /dev/null +++ b/autotest/test_par_gwf_exgmvr01.py @@ -0,0 +1,45 @@ +""" +This tests reuses the simulation data in test_gwf_exgmvr01.py +and runs it in parallel on two cpus with + +cpu 1: 'left' +cpu 2: 'right' + +so we can compare the parallel coupling of 'left' + 'right' +with a serial 'single' +""" + +import pytest + +from framework import TestFramework + +cases = ["par_exgmvr01"] + + +def build_models(idx, test): + from test_gwf_exgmvr01 import build_models as build + + sim, sim_ref = build(idx, test) + return sim, sim_ref + + +def check_output(idx, test): + from test_gwf_exgmvr01 import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + parallel=True, + ncpus=(2, 1), + compare=None, + ) + test.run() diff --git a/autotest/test_par_gwf_exgmvr02.py b/autotest/test_par_gwf_exgmvr02.py new file mode 100644 index 00000000000..2f222b8cbba --- /dev/null +++ b/autotest/test_par_gwf_exgmvr02.py @@ -0,0 +1,45 @@ +""" +This tests reuses the simulation data in test_gwf_exgmvr02.py +and runs it in parallel on two cpus with + +cpu 1: 'left' +cpu 2: 'right' + +so we can compare the parallel coupling of 'left' + 'right' +with a serial 'single' +""" + +import pytest + +from framework import TestFramework + +cases = ["par_exgmvr02"] + + +def build_models(idx, test): + from test_gwf_exgmvr02 import build_models as build + + sim, sim_ref = build(idx, test) + return sim, sim_ref + + +def check_output(idx, test): + from test_gwf_exgmvr02 import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + parallel=True, + ncpus=(2, 1), + compare=None, + ) + test.run() diff --git a/autotest/test_par_gwf_idomain.py b/autotest/test_par_gwf_idomain.py index f471d0bf2f0..ce1ae2b0c7a 100644 --- a/autotest/test_par_gwf_idomain.py +++ b/autotest/test_par_gwf_idomain.py @@ -1,56 +1,46 @@ -import os -from decimal import Decimal +""" +This tests reuses the simulation data in test_gwf_ifmod_idomain.py +and runs it in parallel on three cpus with + +cpu 0: 'refmodel' +cpu 1: 'leftmodel' +cpu 2: 'rightmodel' + +so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' +with a serial 'refmodel' +""" + import pytest + from framework import TestFramework -from simulation import TestSimulation - -# This tests reuses the simulation data in test_gwf_ifmod_idomain.py -# and runs it in parallel on three cpus with -# -# cpu 0: 'refmodel' -# cpu 1: 'leftmodel' -# cpu 2: 'rightmodel' -# -# so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' -# with a serial 'refmodel' - -ex = ["par_idomain"] - -def build_petsc_db(idx, exdir): - from test_gwf_ifmod_idomain import hclose_check, max_inner_it - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type bicg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-sub_pc_factor_levels 2\n") - petsc_file.write(f"-dvclose {Decimal(hclose_check):.2E}\n") - petsc_file.write(f"-nitermax {max_inner_it}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - from test_gwf_ifmod_idomain import build_model as build_model_ext - build_petsc_db(idx, exdir) - sim, dummy = build_model_ext(idx, exdir) + +cases = ["par_idomain"] + + +def build_models(idx, test): + from test_gwf_ifmod_idomain import build_models as build + + sim, dummy = build(idx, test) return sim, dummy -def eval_model(test_sim): - from test_gwf_ifmod_idomain import compare_to_ref - compare_to_ref(test_sim) + +def check_output(idx, test): + from test_gwf_ifmod_idomain import check_output as check + + check(idx, test) + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=3, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=3, ) + test.run() diff --git a/autotest/test_par_gwf_ims_csv.py b/autotest/test_par_gwf_ims_csv.py new file mode 100644 index 00000000000..0b400b2645d --- /dev/null +++ b/autotest/test_par_gwf_ims_csv.py @@ -0,0 +1,61 @@ +import flopy +import pytest + +from framework import TestFramework + +""" +Test for parallel MODFLOW running on two cpus. +It contains two coupled models with + +1d: (nlay,nrow,ncol) = (1,1,5), + +constant head boundaries left=1.0, right=10.0. +The result should be a uniform flow field. +""" + +cases = ["par_gwf_csv"] +dis_shape = [(1, 1, 5)] + +# global convenience... +name_left = "leftmodel" +name_right = "rightmodel" + + +def update_ims(idx, ims): + from test_par_gwf01 import hclose, ninner, nouter, rclose + + name = cases[idx] + ims.csv_outer_output_filerecord.set_data(f"{name}.outer.csv") + ims.csv_inner_output_filerecord.set_data(f"{name}.inner.csv") + return + + +def build_models(idx, test): + from test_par_gwf01 import cases as ex_ext + from test_par_gwf01 import get_model + + sim = get_model(idx, test.workspace) + update_ims(idx, sim.get_solution_package(f"{ex_ext[idx]}.ims")) + return sim, None + + +def check_output(idx, test): + from test_par_gwf01 import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, + ) + test.run() diff --git a/autotest/test_par_gwf_newton.py b/autotest/test_par_gwf_newton.py index 29881e3cccb..d8e61ccb5d9 100644 --- a/autotest/test_par_gwf_newton.py +++ b/autotest/test_par_gwf_newton.py @@ -1,58 +1,48 @@ -import os -from decimal import Decimal +""" +This tests reuses the simulation data in test_gwf_ifmod_newton.py +and runs it in parallel on three cpus with + +cpu 0: 'refmodel' +cpu 1: 'leftmodel' +cpu 2: 'rightmodel' + +so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' +with a serial 'refmodel'. + +This test also checks that PTC works in parallel. +""" + import pytest + from framework import TestFramework -from simulation import TestSimulation - -# This tests reuses the simulation data in test_gwf_ifmod_newton.py -# and runs it in parallel on three cpus with -# -# cpu 0: 'refmodel' -# cpu 1: 'leftmodel' -# cpu 2: 'rightmodel' -# -# so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' -# with a serial 'refmodel'. -# -# This test also checks that PTC works in parallel. - -ex = ["par_newton"] - -def build_petsc_db(idx, exdir): - from test_gwf_ifmod_newton import hclose_check, max_inner_it - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type bicg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-sub_pc_factor_levels 2\n") - petsc_file.write(f"-dvclose {Decimal(hclose_check):.2E}\n") - petsc_file.write(f"-nitermax {max_inner_it}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - from test_gwf_ifmod_newton import build_model as build_model_ext - build_petsc_db(idx, exdir) - sim, dummy = build_model_ext(idx, exdir) + +cases = ["par_newton"] + + +def build_models(idx, test): + from test_gwf_ifmod_newton import build_models as build + + sim, dummy = build(idx, test) return sim, dummy -def eval_model(test_sim): - from test_gwf_ifmod_newton import compare_to_ref - compare_to_ref(test_sim) + +def check_output(idx, test): + from test_gwf_ifmod_newton import check_output as check + + check(idx, test) + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=3, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=3, ) + test.run() diff --git a/autotest/test_par_gwf_newton_under_relaxation.py b/autotest/test_par_gwf_newton_under_relaxation.py new file mode 100644 index 00000000000..628a4f0c107 --- /dev/null +++ b/autotest/test_par_gwf_newton_under_relaxation.py @@ -0,0 +1,63 @@ +""" +This tests reuses the simulation data in test_gwf_newton_under_relaxation +and runs it in parallel on one and two cpus with + +so we can compare the parallel coupling of two models +with a serial model. + +This test also checks that Newton under_relaxation works in parallel. +""" + +import os +from decimal import Decimal + +import pytest + +from framework import TestFramework + +cases = ["par_nr_ur01", "par_nr_ur02"] + + +def build_petsc_db(idx, exdir): + from test_gwf_newton_under_relaxation import hclose, ninner + + petsc_db_file = os.path.join(exdir, ".petscrc") + with open(petsc_db_file, "w") as petsc_file: + petsc_file.write("-ksp_type bicg\n") + petsc_file.write("-pc_type bjacobi\n") + petsc_file.write("-sub_pc_type ilu\n") + petsc_file.write("-sub_pc_factor_levels 2\n") + petsc_file.write(f"-dvclose {Decimal(hclose):.2E}\n") + petsc_file.write(f"-nitermax {ninner}\n") + petsc_file.write("-options_left no\n") + + +def build_models(idx, test): + from test_gwf_newton_under_relaxation import build_models as build + + build_petsc_db(idx, test.workspace) + sim, dummy = build(idx, test) + return sim, dummy + + +def check_output(idx, test): + from test_gwf_newton_under_relaxation import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + ncpus = 2 if idx == 1 else 1 + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=ncpus, + ) + test.run() diff --git a/autotest/test_par_gwf_pakcc.py b/autotest/test_par_gwf_pakcc.py new file mode 100644 index 00000000000..8064f1421f7 --- /dev/null +++ b/autotest/test_par_gwf_pakcc.py @@ -0,0 +1,53 @@ +""" +This tests reuses the simulation data in test_gwf_uzf_gwet +and runs it in parallel on one and two cpus with + +so we can compare the parallel coupling of two models +with a serial model. + +This test also checks that Newton under_relaxation works in parallel. +""" + +import pathlib as pl + +import flopy +import numpy as np +import pytest + +from framework import TestFramework + +cases = ["par_uzf_3lay_1p", "par_uzf_3lay_2p"] + + +def build_models(idx, test): + from test_gwf_uzf_gwet import build_models as build + + sim, dummy = build(idx, test) + if idx == 1: + sim.set_sim_path(test.workspace / "working") + sim.write_simulation(silent=True) + mfsplit = flopy.mf6.utils.Mf6Splitter(sim) + split_array = np.zeros((10), dtype=int) + split_array[5:] = 1 + new_sim = mfsplit.split_model(split_array) + new_sim.set_sim_path(test.workspace) + mfsplit.save_node_mapping(pl.Path(f"{test.workspace}/mapping.json")) + return new_sim, None + else: + return sim, dummy + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + ncpus = 2 if idx == 1 else 1 + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + compare=None, + parallel=True, + ncpus=ncpus, + ) + test.run() diff --git a/autotest/test_par_gwf_rewet.py b/autotest/test_par_gwf_rewet.py index f8fdc1fdebd..fad3e4b4932 100644 --- a/autotest/test_par_gwf_rewet.py +++ b/autotest/test_par_gwf_rewet.py @@ -1,55 +1,46 @@ -import os -from decimal import Decimal +""" +This tests reuses the simulation data in test_gwf_ifmod_rewet.py +and runs it in parallel on three cpus with + +cpu 0: 'refmodel' +cpu 1: 'leftmodel' +cpu 2: 'rightmodel' + +so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' +with a serial 'refmodel' +""" + import pytest + from framework import TestFramework -from simulation import TestSimulation - -# This tests reuses the simulation data in test_gwf_ifmod_rewet.py -# and runs it in parallel on three cpus with -# -# cpu 0: 'refmodel' -# cpu 1: 'leftmodel' -# cpu 2: 'rightmodel' -# -# so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' -# with a serial 'refmodel' -ex = ["par_rewet"] - -def build_petsc_db(idx, exdir): - from test_gwf_ifmod_rewet import hclose_check, max_inner_it - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type bicg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-sub_pc_factor_levels 2\n") - petsc_file.write(f"-dvclose {Decimal(hclose_check):.2E}\n") - petsc_file.write(f"-nitermax {max_inner_it}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - from test_gwf_ifmod_rewet import build_model as build_model_ext - build_petsc_db(idx, exdir) - sim, dummy = build_model_ext(idx, exdir) + +cases = ["par_rewet"] + + +def build_models(idx, test): + from test_gwf_ifmod_rewet import build_models as build + + sim, dummy = build(idx, test) return sim, dummy -def eval_model(test_sim): - from test_gwf_ifmod_rewet import compare_to_ref - compare_to_ref(test_sim) + +def check_output(idx, test): + from test_gwf_ifmod_rewet import check_output as check + + check(idx, test) + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=3, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=3, ) + test.run() diff --git a/autotest/test_par_gwf_xt3d02.py b/autotest/test_par_gwf_xt3d02.py index d7fc1139a69..a2e954f337a 100644 --- a/autotest/test_par_gwf_xt3d02.py +++ b/autotest/test_par_gwf_xt3d02.py @@ -1,55 +1,46 @@ -import os -from decimal import Decimal +""" +This tests reuses the simulation data in test_gwf_ifmod_xt3d02.py +and runs it in parallel on three cpus with + +cpu 0: 'refmodel' +cpu 1: 'leftmodel' +cpu 2: 'rightmodel' + +so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' +with a serial 'refmodel' in case of XT3D +""" + import pytest + from framework import TestFramework -from simulation import TestSimulation - -# This tests reuses the simulation data in test_gwf_ifmod_xt3d02.py -# and runs it in parallel on three cpus with -# -# cpu 0: 'refmodel' -# cpu 1: 'leftmodel' -# cpu 2: 'rightmodel' -# -# so we can compare the parallel coupling of 'leftmodel' + 'rightmodel' -# with a serial 'refmodel' in case of XT3D -ex = ["par_xt3d02"] - -def build_petsc_db(idx, exdir): - from test_gwf_ifmod_xt3d02 import hclose_check, max_inner_it - petsc_db_file = os.path.join(exdir, ".petscrc") - with open(petsc_db_file, 'w') as petsc_file: - petsc_file.write("-ksp_type bicg\n") - petsc_file.write("-pc_type bjacobi\n") - petsc_file.write("-sub_pc_type ilu\n") - petsc_file.write("-sub_pc_factor_levels 2\n") - petsc_file.write(f"-dvclose {Decimal(hclose_check):.2E}\n") - petsc_file.write(f"-nitermax {max_inner_it}\n") - petsc_file.write("-options_left no\n") - -def build_model(idx, exdir): - from test_gwf_ifmod_xt3d02 import build_model as build_model_ext - build_petsc_db(idx, exdir) - sim, dummy = build_model_ext(idx, exdir) + +cases = ["par_xt3d02"] + + +def build_models(idx, test): + from test_gwf_ifmod_xt3d02 import build_models as build + + sim, dummy = build(idx, test) return sim, dummy -def eval_model(test_sim): - from test_gwf_ifmod_xt3d02 import compare_to_ref - compare_to_ref(test_sim) + +def check_output(idx, test): + from test_gwf_ifmod_xt3d02 import check_output as check + + check(idx, test) + @pytest.mark.parallel -@pytest.mark.parametrize( - "idx, name", - list(enumerate(ex)), -) +@pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): - test = TestFramework() - test.build(build_model, idx, str(function_tmpdir)) - test.run( - TestSimulation( - name=name, exe_dict=targets, exfunc=eval_model, - idxsim=0, make_comparison=False, - parallel=True, ncpus=3, - ), - str(function_tmpdir), + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=3, ) + test.run() diff --git a/autotest/test_par_gwf_xt3d03.py b/autotest/test_par_gwf_xt3d03.py new file mode 100644 index 00000000000..1ae92085824 --- /dev/null +++ b/autotest/test_par_gwf_xt3d03.py @@ -0,0 +1,52 @@ +""" +This tests reuses the simulation data in test_gwf_ifmod_xt3d03.py +and runs it in parallel on 5 cpus with + +cpu 0: 'ref' +cpu 1: 'tl' +cpu 2: 'bl' +cpu 3: 'tr' +cpu 4: 'br' + +so we can compare the parallel coupling of the 4 models +with a serial reference case with XT3D enabled everywhere. +Particular aspect of this test is the capability to correctly +deal with the "Four Corners" issue, where for some connections +the flux has to be calculated using data from 4 subdomains. + +""" + +import pytest + +from framework import TestFramework + +cases = ["par_xt3d03"] + + +def build_models(idx, test): + from test_gwf_ifmod_xt3d03 import build_models as build + + sim, dummy = build(idx, test) + return sim, dummy + + +def check_output(idx, test): + from test_gwf_ifmod_xt3d03 import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=5, + ) + test.run() diff --git a/autotest/test_par_gwt_adv01.py b/autotest/test_par_gwt_adv01.py new file mode 100644 index 00000000000..2e9647faa56 --- /dev/null +++ b/autotest/test_par_gwt_adv01.py @@ -0,0 +1,39 @@ +""" +This test reuses the simulation data and config in +test_gwt_adv01_gwtgwt.py and runs it in parallel mode. +""" + +import pytest + +from framework import TestFramework + +cases = ["par_adv01a_gwtgwt", "par_adv01b_gwtgwt", "par_adv01c_gwtgwt"] + + +def build_models(idx, test): + from test_gwt_adv01_gwtgwt import build_models as build + + sim, dummy = build(idx, test) + return sim, dummy + + +def check_output(idx, test): + from test_gwt_adv01_gwtgwt import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, + ) + test.run() diff --git a/autotest/test_par_gwt_dsp01.py b/autotest/test_par_gwt_dsp01.py new file mode 100644 index 00000000000..dbdee7a26f9 --- /dev/null +++ b/autotest/test_par_gwt_dsp01.py @@ -0,0 +1,39 @@ +""" +This test reuses the simulation data and config in +test_gwt_dsp01_gwtgwt.py and runs it in parallel mode. +""" + +import pytest + +from framework import TestFramework + +cases = ["par_dsp01_gwtgwt"] + + +def build_models(idx, test): + from test_gwt_dsp01_gwtgwt import build_models as build + + sim, dummy = build(idx, test) + return sim, dummy + + +def check_output(idx, test): + from test_gwt_dsp01_gwtgwt import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, + ) + test.run() diff --git a/autotest/test_par_gwt_henry.py b/autotest/test_par_gwt_henry.py new file mode 100644 index 00000000000..ee333c6a9cc --- /dev/null +++ b/autotest/test_par_gwt_henry.py @@ -0,0 +1,39 @@ +""" +This test reuses the simulation data and config in +test_gwt_henry_gwtgwt.py and runs it in parallel mode. +""" + +import pytest + +from framework import TestFramework + +cases = ["par-henry-ups", "par-henry-cen", "par-henry-tvd"] + + +def build_models(idx, test): + from test_gwt_henry_gwtgwt import build_models as build + + sim, dummy = build(idx, test) + return sim, dummy + + +def check_output(idx, test): + from test_gwt_henry_gwtgwt import check_output as check + + check(idx, test) + + +@pytest.mark.parallel +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + targets=targets, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + compare=None, + parallel=True, + ncpus=2, + ) + test.run() diff --git a/autotest/test_testmodels_mf5to6.py b/autotest/test_testmodels_mf5to6.py new file mode 100644 index 00000000000..c9948681c75 --- /dev/null +++ b/autotest/test_testmodels_mf5to6.py @@ -0,0 +1,85 @@ +import os +from pathlib import Path + +import flopy +import pytest + +from common_regression import get_namefiles, setup_model +from framework import TestFramework + +excluded_models = ["alt_model", "mf2005"] + + +def setup_mf5to6(src, dst) -> Path: + Path(dst).mkdir(exist_ok=True) + lgrpth = None + + # determine if compare directory exists in directory or if mflgr control + # file is in directory + listdir = os.listdir(src) + for value in listdir: + fpth = os.path.join(src, value) + if os.path.isfile(fpth): + ext = os.path.splitext(fpth)[1] + if ".lgr" in ext.lower(): + lgrpth = fpth + + print(f"Copying files to target workspace: {dst}") + # copy lgr files to working directory + if lgrpth is not None: + npth = lgrpth + setup_model(lgrpth, dst) + # copy MODFLOW-2005, MODFLOW-NWT, or MODFLOW-USG files to working directory + else: + npths = get_namefiles(src) + if len(npths) < 1: + msg = f"No name files in source workspace: {src}" + print(msg) + assert False + npth = npths[0] + setup_model(npth, dst) + + return Path(npth) + + +@pytest.mark.repo +@pytest.mark.regression +def test_model( + function_tmpdir, + original_regression, + targets, + # https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#modflow-2005-test-models + test_model_mf5to6, +): + model_path = test_model_mf5to6.parent + model_name = model_path.name + if model_name in excluded_models: + pytest.skip(f"Skipping: {model_name} (excluded)") + + test = TestFramework( + name=model_path.name, + workspace=model_path, + targets=targets, + compare="auto" if original_regression else "mf6_regression", + verbose=False, + ) + + # run the mf5to6 converter + mf5to6_workspace = function_tmpdir / "mf5to6" + npth = setup_mf5to6(model_path, mf5to6_workspace) + nam = os.path.basename(npth) + exe = os.path.abspath(targets["mf5to6"]) + print("MODFLOW 5 to 6 converter run for", nam, "using executable", exe) + success, _ = flopy.run_model( + exe, + nam, + model_ws=mf5to6_workspace, + normal_msg="Program terminated normally", + cargs="mf6", + ) + assert success + + # run mf6 + mf6_workspace = function_tmpdir / "mf6" + test.setup(mf5to6_workspace, mf6_workspace) + test.run() diff --git a/autotest/test_testmodels_mf6.py b/autotest/test_testmodels_mf6.py new file mode 100644 index 00000000000..22382d55b9c --- /dev/null +++ b/autotest/test_testmodels_mf6.py @@ -0,0 +1,42 @@ +import pytest + +from framework import TestFramework + +excluded_models = [ + "alt_model", + "test205_gwtbuy-henrytidal", + # todo reinstate when flopy fixed: https://github.com/modflowpy/flopy/issues/2053 + "test001a_Tharmonic_tabs", + "test004_bcfss", + "test014_NWTP3Low_dev", + "test041_flowdivert_nwt_dev", +] + + +@pytest.mark.repo +@pytest.mark.regression +def test_model( + function_tmpdir, + markers, + original_regression, + targets, + # https://modflow-devtools.readthedocs.io/en/latest/md/fixtures.html#modflow-6-test-models + test_model_mf6, +): + model_path = test_model_mf6.parent + model_name = model_path.name + excluded = model_name in excluded_models + dev_only = "dev" in model_name and "not developmode" in markers + if excluded or dev_only: + reason = "excluded" if excluded else "developmode only" + pytest.skip(f"Skipping: {model_name} ({reason})") + + test = TestFramework( + name=model_name, + workspace=model_path, + targets=targets, + compare="auto" if original_regression else "mf6_regression", + verbose=False, + ) + test.setup(model_path, function_tmpdir) + test.run() diff --git a/autotest/test_z01_testmodels_mf6.py b/autotest/test_z01_testmodels_mf6.py deleted file mode 100644 index 48187b4197d..00000000000 --- a/autotest/test_z01_testmodels_mf6.py +++ /dev/null @@ -1,67 +0,0 @@ -import pytest -from conftest import should_compare -from simulation import TestSimulation - -excluded_models = ["alt_model", "test205_gwtbuy-henrytidal"] -excluded_comparisons = { - "test001e_noUZF_3lay": ["6.2.1",], - "test005_advgw_tidal": ["6.2.1",], - "test017_Crinkle": ["6.2.1",], - "test028_sfr": ["6.2.1",], - "test028_sfr_rewet": ["6.2.1",], - "test028_sfr_rewet_nr": ["6.2.1",], - "test028_sfr_rewet_simple": ["6.2.1",], - "test028_sfr_simple": ["6.2.1",], - "test034_nwtp2": ["6.2.1",], - "test034_nwtp2_1d": ["6.2.1",], - "test045_lake1tr_nr": ["6.2.1",], - "test045_lake2tr": ["6.2.1",], - "test045_lake2tr_nr": ["6.2.1",], - "test051_uzfp2": ["6.2.1",], - "test051_uzfp3_lakmvr_v2": ["6.2.1",], - "test051_uzfp3_wellakmvr_v2": ["6.2.1",], - "test045_lake4ss": ["6.2.2",], - "test056_mt3dms_usgs_gwtex_dev": ["6.4.1",], - "test056_mt3dms_usgs_gwtex_IR_dev": ["6.4.1",], - "test059_mvlake_lak_ss": ["6.4.1",], - "test045_lake2tr_xsfrc_dev": ["6.4.1",], - "test045_lake2tr_xsfrd_dev": ["6.4.1",], - "test045_lake2tr_xsfre_dev": ["6.4.1",], - "test045_lake4ss": ["6.4.1",], - "test045_lake4ss_dev": ["6.4.1",], - "test045_lake4ss_il_dev": ["6.4.1",], - "test045_lake4ss_nr_dev": ["6.4.1",], - "test045_lake4ss_nr_embedded": ["6.4.1",], -} - - -@pytest.mark.repo -@pytest.mark.regression -def test_model(function_tmpdir, test_model_mf6, targets, original_regression, markers): - exdir = test_model_mf6.parent - name = exdir.name - - if name in excluded_models: - pytest.skip(f"Excluding mf6 model '{name}'") - - if "dev" in name and "not developmode" in markers: - pytest.skip(f"Skipping mf6 model '{name}' (develop mode only)") - - sim = TestSimulation( - name=name, - exe_dict=targets, - mf6_regression=not original_regression, - cmp_verbose=False, - make_comparison=should_compare(name, excluded_comparisons, targets), - simpath=str(exdir), - ) - - src = exdir - dst = str(function_tmpdir) - - # Run the MODFLOW 6 simulation and compare to results generated using - # 1) the current MODFLOW 6 release, 2) an existing head file, or 3) or - # appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. - sim.setup(src, dst) - sim.run() - sim.compare() diff --git a/autotest/test_z02_testmodels_mf5to6.py b/autotest/test_z02_testmodels_mf5to6.py deleted file mode 100644 index ef030661ad3..00000000000 --- a/autotest/test_z02_testmodels_mf5to6.py +++ /dev/null @@ -1,105 +0,0 @@ -import os - -import flopy -import pytest -from common_regression import get_namefiles, model_setup -from conftest import should_compare -from simulation import TestSimulation - -sfmt = "{:25s} - {}" -excluded_models = ["alt_model", "mf2005"] -excluded_comparisons = { - "testPr2": ["6.2.1",], - "testUzfLakSfr": ["6.2.1",], - "testUzfLakSfr_laketable": ["6.2.1",], - "testWetDry": ["6.2.1",], -} - - -@pytest.mark.repo -@pytest.mark.regression -def test_model( - function_tmpdir, test_model_mf5to6, targets, original_regression -): - exdir = test_model_mf5to6.parent - name = exdir.name - - if name in excluded_models: - pytest.skip(f"Excluding mf5to6 model: {name}") - - sim = TestSimulation( - name=exdir.name, - exe_dict=targets, - mf6_regression=not original_regression, - cmp_verbose=False, - make_comparison=should_compare(name, excluded_comparisons, targets), - simpath=str(exdir), - ) - - src = sim.simpath - dst = str(function_tmpdir) - - # set lgrpth to None - lgrpth = None - - # determine if compare directory exists in directory or if mflgr control - # file is in directory - listdir = os.listdir(src) - for value in listdir: - fpth = os.path.join(src, value) - if os.path.isfile(fpth): - ext = os.path.splitext(fpth)[1] - if ".lgr" in ext.lower(): - lgrpth = fpth - - print("Copying files to working directory") - # copy lgr files to working directory - if lgrpth is not None: - npth = lgrpth - model_setup(lgrpth, dst) - # copy MODFLOW-2005, MODFLOW-NWT, or MODFLOW-USG files to working directory - else: - npths = get_namefiles(src) - if len(npths) < 1: - msg = f"No name files in {src}" - print(msg) - assert False - npth = npths[0] - model_setup(npth, dst) - - # run the mf5to6 converter - exe = os.path.abspath(targets["mf5to6"]) - print(sfmt.format("using executable", exe)) - nmsg = "Program terminated normally" - try: - nam = os.path.basename(npth) - success, buff = flopy.run_model( - exe, - nam, - model_ws=dst, - silent=False, - report=True, - normal_msg=nmsg, - cargs="mf6", - ) - msg = sfmt.format("MODFLOW 5 to 6 run", nam) - if success: - print(msg) - else: - print("ERROR: " + msg) - except: - msg = sfmt.format("MODFLOW 5 to 6 run", nam) - print("ERROR: " + msg) - success = False - - assert success, msg - - # model setup - src = dst - dst = function_tmpdir / "models" - sim.setup(src, dst) - - # Run the MODFLOW 6 simulation and compare to existing head file or - # appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. - sim.run() - sim.compare() diff --git a/autotest/test_z03_examples.py b/autotest/test_z03_examples.py deleted file mode 100644 index 124d8f9229a..00000000000 --- a/autotest/test_z03_examples.py +++ /dev/null @@ -1,81 +0,0 @@ -import pytest -from conftest import should_compare -from simulation import TestSimulation - -# skip nested models -# ex-gwf-csub-p02c has subdirs like 'es-001', 'hb-100' -# all others just have 2 folders 'mf6gwf' and 'mf6gwt' -excluded_models = [ - "ex-gwf-csub-p02c", - "ex-gwt-hecht-mendez-b", - "ex-gwt-hecht-mendez-c", - "ex-gwt-keating", - "ex-gwt-moc3d-p01a", - "ex-gwt-moc3d-p01b", - "ex-gwt-moc3d-p01c", - "ex-gwt-moc3d-p01d", - "ex-gwt-moc3d-p02", - "ex-gwt-moc3d-p02tg", - "ex-gwt-mt3dms-p02a", - "ex-gwt-mt3dms-p02b", - "ex-gwt-mt3dms-p02c", - "ex-gwt-mt3dms-p02d", - "ex-gwt-mt3dms-p02e", - "ex-gwt-mt3dms-p02f", - "ex-gwt-mt3dsupp631", - "ex-gwt-mt3dsupp632a", - "ex-gwt-mt3dsupp632b", - "ex-gwt-mt3dsupp632c", - "ex-gwt-mt3dsupp82", - "ex-gwt-prudic2004t2", -] -excluded_comparisons = { - "ex-gwf-capture": ["6.2.1"], - "ex-gwf-sagehen": ["6.2.1"], - "ex-gwf-sfr-p01b": ["6.2.1"], - "ex-gwf-nwt-p02a": ["6.2.1"], - "ex-gwf-lak-p01": ["6.2.1"], - "ex-gwf-lak-p02": ["6.2.1"], - "ex-gwf-nwt-p02b": ["6.2.1"], - "ex-gwf-advtidal": ["6.2.1"], - "ex-gwf-sfr-p01": ["6.2.1"], - "ex-gwf-lgr": ["6.2.2"], - "ex-gwt-rotate": ["6.2.2"], - "ex-gwt-gwtgwt-mt3dms-p10": ["6.3.0"], - "ex-gwf-lak-p01": ["6.4.1"], -} - - -@pytest.mark.large -@pytest.mark.repo -@pytest.mark.regression -@pytest.mark.slow -def test_scenario(function_tmpdir, example_scenario, targets): - name, namefiles = example_scenario - exdirs = [nf.parent for nf in namefiles] - - if name in excluded_models: - pytest.skip(f"Excluding mf6 model: {name}") - - for exdir in exdirs: - model_name = f"{name}_{exdir.name}" - workspace = function_tmpdir / model_name - sim = TestSimulation( - name=model_name, - exe_dict=targets.as_dict(), - mf6_regression=True, - cmp_verbose=False, - make_comparison=should_compare( - name, excluded_comparisons, targets - ), - simpath=str(exdir), - ) - - src = sim.simpath - dst = str(workspace) - - # Run the MODFLOW 6 simulation and compare to existing head file or - # appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. - sim.setup(src, dst) - sim.run() - sim.compare() diff --git a/autotest/test_z03_largetestmodels.py b/autotest/test_z03_largetestmodels.py deleted file mode 100644 index c5f9175579a..00000000000 --- a/autotest/test_z03_largetestmodels.py +++ /dev/null @@ -1,46 +0,0 @@ -import pytest -from conftest import should_compare -from simulation import TestSimulation - -excluded_models = [] -excluded_comparisons = { - "test1004_mvlake_laksfr_tr": ["6.4.1",], - "test1004_mvlake_lak_tr": ["6.4.1",], - "test1003_MNW2_Fig28": ["6.2.1",], - "test1001_Peterson": ["6.2.1",], -} - - -@pytest.mark.large -@pytest.mark.repo -@pytest.mark.regression -@pytest.mark.slow -def test_model( - function_tmpdir, large_test_model, targets, original_regression, markers -): - exdir = large_test_model.parent - name = exdir.name - - if name in excluded_models: - pytest.skip(f"Excluding large mf6 model '{name}'") - - if "dev" in name and "not developmode" in markers: - pytest.skip(f"Skipping large mf6 model '{name}' (develop mode only)") - - sim = TestSimulation( - name=name, - exe_dict=targets.as_dict(), - mf6_regression=not original_regression, - cmp_verbose=False, - make_comparison=should_compare(name, excluded_comparisons, targets), - simpath=str(exdir), - ) - - src = sim.simpath - dst = str(function_tmpdir) - - # Run the MODFLOW 6 simulation and compare to existing head file or - # appropriate MODFLOW-2005, MODFLOW-NWT, MODFLOW-USG, or MODFLOW-LGR run. - sim.setup(src, dst) - sim.run() - sim.compare() diff --git a/autotest/tester.f90 b/autotest/tester.f90 new file mode 100644 index 00000000000..ed297ef643c --- /dev/null +++ b/autotest/tester.f90 @@ -0,0 +1,68 @@ +program tester + use, intrinsic :: iso_fortran_env, only: error_unit + use testdrive, only: run_testsuite, new_testsuite, testsuite_type, & + & select_suite, run_selected, get_argument + use TestArrayHandlers, only: collect_arrayhandlers + use TestDevFeature, only: collect_dev_feature + use TestGeomUtil, only: collect_geomutil + use TestHashTable, only: collect_hashtable + use TestInputOutput, only: collect_inputoutput + use TestList, only: collect_list + use TestMathUtil, only: collect_mathutil + use TestMessage, only: collect_message + use TestSim, only: collect_sim + implicit none + integer :: stat, is + character(len=:), allocatable :: suite_name, test_name + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + testsuites = [ & + new_testsuite("ArrayHandlers", collect_arrayhandlers), & + new_testsuite("DevFeature", collect_dev_feature), & + new_testsuite("GeomUtil", collect_geomutil), & + new_testsuite("HashTable", collect_hashtable), & + new_testsuite("InputOutput", collect_inputoutput), & + new_testsuite("List", collect_list), & + new_testsuite("MathUtil", collect_mathutil), & + new_testsuite("Message", collect_message), & + new_testsuite("Sim", collect_sim) & + ] + + call get_argument(1, suite_name) + call get_argument(2, test_name) + + if (allocated(suite_name)) then + is = select_suite(testsuites, suite_name) + if (is > 0 .and. is <= size(testsuites)) then + if (allocated(test_name)) then + write (error_unit, fmt) "Suite:", testsuites(is)%name + call run_selected(testsuites(is)%collect, test_name, error_unit, stat) + if (stat < 0) then + error stop 1 + end if + else + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end if + else + write (error_unit, fmt) "Available testsuites" + do is = 1, size(testsuites) + write (error_unit, fmt) "-", testsuites(is)%name + end do + error stop 1 + end if + else + do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + end if + + if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + +end program tester diff --git a/autotest/update_flopy.py b/autotest/update_flopy.py index d7c2aedd3a2..bf62eabc21c 100644 --- a/autotest/update_flopy.py +++ b/autotest/update_flopy.py @@ -8,6 +8,7 @@ import flopy import pytest + from conftest import project_root_path dfn_path = project_root_path / "doc" / "mf6io" / "mf6ivar" / "dfn" diff --git a/code.json b/code.json index 99dbdf41b3c..0538ab48eb0 100644 --- a/code.json +++ b/code.json @@ -18,9 +18,9 @@ "email": "langevin@usgs.gov" }, "laborHours": -1, - "version": "6.4.2", + "version": "6.4.3", "date": { - "metadataLastUpdated": "2023-06-28" + "metadataLastUpdated": "2024-02-07" }, "organization": "U.S. Geological Survey", "permissions": { diff --git a/distribution/benchmark.py b/distribution/benchmark.py index f5c319804e7..b92d533fec3 100644 --- a/distribution/benchmark.py +++ b/distribution/benchmark.py @@ -27,14 +27,16 @@ _is_windows = sys.platform.lower() == "win32" _app_ext = ".exe" if _is_windows else "" _soext = ".dll" if _is_windows else ".so" +_ostag = "win64" if _is_windows else "linux" if sys.platform.lower().startswith("linux") else "mac" def download_previous_version(output_path: PathLike) -> Tuple[str, Path]: output_path = Path(output_path).expanduser().absolute() version = get_latest_version(_github_repo) + distname = f"mf{version}_{_ostag}" url = ( f"https://github.com/{_github_repo}" - + f"/releases/download/{version}/mf{version}.zip" + + f"/releases/download/{version}/{distname}.zip" ) download_and_unzip( url, @@ -42,7 +44,7 @@ def download_previous_version(output_path: PathLike) -> Tuple[str, Path]: verbose=True, ) - return version, output_path / f"mf{version}" + return version, output_path / distname def get_mf6_cmdargs(app, argv, text="mf6:", verbose=False): diff --git a/distribution/build_dist.py b/distribution/build_dist.py index f60b76302c6..4d8efdfc8f6 100644 --- a/distribution/build_dist.py +++ b/distribution/build_dist.py @@ -1,14 +1,12 @@ import argparse import os import platform -import shutil import sys import textwrap -from collections import namedtuple from os import PathLike, environ from pathlib import Path from pprint import pprint -from shutil import copytree +from shutil import copy, copyfile, copytree, ignore_patterns import pytest from modflow_devtools.build import meson_build @@ -18,55 +16,18 @@ from build_docs import build_documentation from build_makefiles import ( - build_mf6_makefile, build_mf5to6_makefile, + build_mf6_makefile, build_zbud6_makefile, ) from utils import get_project_root_path, run_command -_project_name = "MODFLOW 6" - # default paths _project_root_path = get_project_root_path() -_version_texf_path = _project_root_path / "doc" / "version.tex" _examples_repo_path = _project_root_path.parent / "modflow6-examples" -_examples_path = _examples_repo_path / "examples" _build_path = _project_root_path / "builddir" -_bin_path = _project_root_path / "bin" -_docs_path = _project_root_path / "doc" -_benchmarks_path = _project_root_path / "distribution" / ".benchmarks" - -# top-level directories included in distribution -_included_dir_paths = [ - "bin", - "doc", - "examples", - "src", - "srcbmi", - "msvs", - "make", - "utils", -] - -Makefile = namedtuple("Makefile", ["app", "src_path", "out_path"]) - - -# makefiles included in distribution -_makefiles = [ - Makefile(app="mf6", src_path=_project_root_path / "src", out_path=Path("make")), - Makefile( - app="zbud6", - src_path=_project_root_path / "utils" / "zonebudget" / "src", - out_path=Path("utils") / "zonebudget" / "make", - ), - Makefile( - app="mf5to6", - src_path=_project_root_path / "utils" / "mf5to6" / "src", - out_path=Path("utils") / "mf5to6" / "make", - ), -] - -# system-specific filenames, extensions, etc + +# OS-specific extensions _system = platform.system() _eext = ".exe" if _system == "Windows" else "" _soext = ".dll" if _system == "Windows" else ".so" if _system == "Linux" else ".dylib" @@ -95,30 +56,32 @@ def copy_sources(output_path: PathLike): str(source_msvs_path / "mf6bmi.sln"), str(source_msvs_path / "mf6bmi.vfproj"), ]: - shutil.copy(d, output_path / "msvs") + copy(d, output_path / "msvs") - ignored = shutil.ignore_patterns(".DS_Store") + ignored = [".DS_Store"] - # copy top-level meson.build - shutil.copy(_project_root_path / "meson.build", output_path) + # copy top-level meson.build and meson.options + copy(_project_root_path / "meson.build", output_path) + copy(_project_root_path / "meson.options", output_path) # copy source folder src_path = _project_root_path / "src" dst_path = output_path / "src" print(f"Copying {src_path} to {dst_path}") - copytree(src_path, dst_path, ignore=ignored) + copytree(src_path, dst_path, ignore=ignore_patterns(*ignored)) # copy srcbmi folder src_path = _project_root_path / "srcbmi" dst_path = output_path / "srcbmi" print(f"Copying {src_path} to {dst_path}") - copytree(src_path, dst_path, ignore=ignored) + copytree(src_path, dst_path, ignore=ignore_patterns(*ignored)) # copy utils folder src_path = _project_root_path / "utils" dst_path = output_path / "utils" print(f"Copying {src_path} to {dst_path}") - copytree(src_path, dst_path, ignore=ignored) + ignored.extend(["idmloader"]) + copytree(src_path, dst_path, ignore=ignore_patterns(*ignored)) def test_copy_sources(tmp_path): @@ -134,6 +97,14 @@ def test_copy_sources(tmp_path): assert (tmp_path / "utils" / "meson.build").is_file() assert (tmp_path / "msvs" / "mf6.sln").is_file() + assert (tmp_path / "utils").is_dir() + assert (tmp_path / "utils" / "mf5to6").is_dir() + assert (tmp_path / "utils" / "zonebudget").is_dir() + assert (tmp_path / "utils" / "mf5to6" / "pymake").is_dir() + assert (tmp_path / "utils" / "zonebudget" / "pymake").is_dir() + assert not (tmp_path / "utils" / "idmloader").is_dir() + + def build_examples(examples_repo_path: PathLike, overwrite: bool = False): examples_repo_path = Path(examples_repo_path).expanduser().absolute() @@ -232,10 +203,6 @@ def setup_examples( print(f"Execute permission set for {script_path}") -def test_setup_examples(): - pass - - def build_programs_meson( build_path: PathLike, bin_path: PathLike, overwrite: bool = False ): @@ -278,10 +245,10 @@ def build_makefiles(output_path: PathLike): # create and copy mf6 makefile build_mf6_makefile() (output_path / "make").mkdir(parents=True, exist_ok=True) - shutil.copyfile( + copyfile( _project_root_path / "make" / "makefile", output_path / "make" / "makefile" ) - shutil.copyfile( + copyfile( _project_root_path / "make" / "makedefaults", output_path / "make" / "makedefaults", ) @@ -290,10 +257,10 @@ def build_makefiles(output_path: PathLike): build_zbud6_makefile() rel_path = Path("utils") / "zonebudget" / "make" (output_path / rel_path).mkdir(parents=True, exist_ok=True) - shutil.copyfile( + copyfile( _project_root_path / rel_path / "makefile", output_path / rel_path / "makefile" ) - shutil.copyfile( + copyfile( _project_root_path / rel_path / "makedefaults", output_path / rel_path / "makedefaults", ) @@ -302,10 +269,10 @@ def build_makefiles(output_path: PathLike): build_mf5to6_makefile() rel_path = Path("utils") / "mf5to6" / "make" (output_path / rel_path).mkdir(parents=True, exist_ok=True) - shutil.copyfile( + copyfile( _project_root_path / rel_path / "makefile", output_path / rel_path / "makefile" ) - shutil.copyfile( + copyfile( _project_root_path / rel_path / "makedefaults", output_path / rel_path / "makedefaults", ) @@ -345,32 +312,32 @@ def build_distribution( ) # code.json metadata - shutil.copy(_project_root_path / "code.json", output_path) + copy(_project_root_path / "code.json", output_path) # full releases include examples, source code, makefiles and docs - if full: - # examples - setup_examples( - bin_path=output_path / "bin", - examples_path=output_path / "examples", - overwrite=overwrite, - ) + if not full: + return + + # examples + setup_examples( + bin_path=output_path / "bin", + examples_path=output_path / "examples", + overwrite=overwrite, + ) - # copy source code files - copy_sources(output_path=output_path) + # copy source code files + copy_sources(output_path=output_path) - # build and copy makefiles - build_makefiles(output_path=output_path) + # build and copy makefiles + build_makefiles(output_path=output_path) - # docs - build_documentation( - bin_path=output_path / "bin", - output_path=output_path / "doc", - examples_repo_path=examples_repo_path, - # benchmarks_path=_benchmarks_path / "run-time-comparison.md", - full=full, - overwrite=overwrite, - ) + # docs + build_documentation( + bin_path=output_path / "bin", + full=full, + output_path=output_path / "doc", + overwrite=overwrite, + ) @requires_exe("pdflatex") @@ -446,13 +413,6 @@ def test_build_distribution(tmp_path, full): default=str(_examples_repo_path), help="Path to directory containing modflow6 example models", ) - # parser.add_argument( - # "-b", - # "--benchmarks-path", - # required=False, - # default=str(_project_root_path / "distribution" / ".benchmarks"), - # help="Path to directory containing benchmark results" - # ) parser.add_argument( "--full", required=False, @@ -469,7 +429,6 @@ def test_build_distribution(tmp_path, full): help="Recreate and overwrite existing artifacts", ) args = parser.parse_args() - build_path = Path(args.build_path) out_path = Path(args.output_path) examples_repo_path = ( diff --git a/distribution/build_docs.py b/distribution/build_docs.py index efc4c8bbc0c..3c74f642f13 100644 --- a/distribution/build_docs.py +++ b/distribution/build_docs.py @@ -5,7 +5,7 @@ import sys import textwrap from datetime import datetime -from os import PathLike +from os import PathLike, environ from pathlib import Path from pprint import pprint from tempfile import TemporaryDirectory @@ -17,24 +17,24 @@ from flaky import flaky from modflow_devtools.build import meson_build from modflow_devtools.download import ( - list_artifacts, + download_and_unzip, download_artifact, get_release, - download_and_unzip, + list_artifacts, ) from modflow_devtools.markers import requires_exe, requires_github -from modflow_devtools.misc import set_dir, run_cmd, is_in_ci +from modflow_devtools.misc import is_in_ci, run_cmd, set_dir from benchmark import run_benchmarks -from utils import convert_line_endings -from utils import get_project_root_path +from utils import convert_line_endings, get_project_root_path +# paths _project_root_path = get_project_root_path() _bin_path = _project_root_path / "bin" _examples_repo_path = _project_root_path.parent / "modflow6-examples" _release_notes_path = _project_root_path / "doc" / "ReleaseNotes" _distribution_path = _project_root_path / "distribution" -_benchmarks_path = _project_root_path / "distribution" / ".benchmarks" +_benchmarks_dir_path = _project_root_path / "distribution" / ".benchmarks" _docs_path = _project_root_path / "doc" _dev_dist_tex_paths = [ _docs_path / "mf6io" / "mf6io.tex", @@ -47,12 +47,13 @@ _docs_path / "ConverterGuide" / "converter_mf5to6.tex", _docs_path / "SuppTechInfo" / "mf6suptechinfo.tex", ] + +# OS-specific extensions _system = platform.system() _eext = ".exe" if _system == "Windows" else "" _soext = ".dll" if _system == "Windows" else ".so" if _system == "Linux" else ".dylib" - -# publications included in distribution docs +# publications included in full dist docs _publication_urls = [ "https://pubs.usgs.gov/tm/06/a55/tm6a55.pdf", "https://pubs.usgs.gov/tm/06/a56/tm6a56.pdf", @@ -103,16 +104,21 @@ def clean_tex_files(): assert not os.path.isfile(str(pth) + ".pdf") -def download_benchmarks(output_path: PathLike, verbose: bool = False) -> Optional[Path]: +def download_benchmarks( + output_path: PathLike, verbose: bool = False, repo_owner: str = "MODFLOW-USGS" +) -> Optional[Path]: output_path = Path(output_path).expanduser().absolute() name = "run-time-comparison" # todo make configurable - repo = "MODFLOW-USGS/modflow6" # todo make configurable, add pytest/cli args + repo = f"{repo_owner}/modflow6" # todo make configurable, add pytest/cli args artifacts = list_artifacts(repo, name=name, verbose=verbose) artifacts = sorted( artifacts, key=lambda a: datetime.strptime(a["created_at"], "%Y-%m-%dT%H:%M:%SZ"), reverse=True, ) + artifacts = [ + a for a in artifacts if a["workflow_run"]["head_branch"] == "develop" # todo make configurable + ] most_recent = next(iter(artifacts), None) print(f"Found most recent benchmarks (artifact {most_recent['id']})") if most_recent: @@ -127,21 +133,32 @@ def download_benchmarks(output_path: PathLike, verbose: bool = False) -> Optiona return None +@pytest.fixture +def github_user() -> Optional[str]: + return environ.get("GITHUB_USER", None) + + @flaky @requires_github -def test_download_benchmarks(tmp_path): - path = download_benchmarks(tmp_path, verbose=True) +def test_download_benchmarks(tmp_path, github_user): + path = download_benchmarks( + tmp_path, + verbose=True, + repo_owner=github_user if github_user else "MODFLOW-USGS", + ) if path: assert path.name == "run-time-comparison.md" -def build_benchmark_tex(output_path: PathLike, overwrite: bool = False): - _benchmarks_path.mkdir(parents=True, exist_ok=True) - benchmarks_path = _benchmarks_path / "run-time-comparison.md" +def build_benchmark_tex( + output_path: PathLike, overwrite: bool = False, repo_owner: str = "MODFLOW-USGS" +): + _benchmarks_dir_path.mkdir(parents=True, exist_ok=True) + benchmarks_path = _benchmarks_dir_path / "run-time-comparison.md" # download benchmark artifacts if any exist on GitHub if not benchmarks_path.is_file(): - benchmarks_path = download_benchmarks(_benchmarks_path) + benchmarks_path = download_benchmarks(_benchmarks_dir_path, repo_owner=repo_owner) # run benchmarks again if no benchmarks found on GitHub or overwrite requested if overwrite or not benchmarks_path.is_file(): @@ -162,7 +179,7 @@ def build_benchmark_tex(output_path: PathLike, overwrite: bool = False): ) assert not ret, out + err assert tex_path.is_file() - + if (_distribution_path / f"{benchmarks_path.stem}.md").is_file(): assert (_docs_path / "ReleaseNotes" / f"{benchmarks_path.stem}.tex").is_file() @@ -170,7 +187,7 @@ def build_benchmark_tex(output_path: PathLike, overwrite: bool = False): @flaky @requires_github def test_build_benchmark_tex(tmp_path): - benchmarks_path = _benchmarks_path / "run-time-comparison.md" + benchmarks_path = _benchmarks_dir_path / "run-time-comparison.md" tex_path = _distribution_path / f"{benchmarks_path.stem}.tex" try: @@ -180,6 +197,22 @@ def test_build_benchmark_tex(tmp_path): tex_path.unlink(missing_ok=True) +def build_deprecations_tex(): + deprecations_path = _docs_path / "mf6io" / "mf6ivar" / "md" / "deprecations.md" + + # convert markdown deprecations to LaTeX + with set_dir(_release_notes_path): + tex_path = Path("deprecations.tex") + tex_path.unlink(missing_ok=True) + out, err, ret = run_cmd( + sys.executable, "mk_deprecations.py", deprecations_path, verbose=True + ) + assert not ret, out + err + assert tex_path.is_file() + + assert (_docs_path / "ReleaseNotes" / f"{deprecations_path.stem}.tex").is_file() + + def build_mf6io_tex_from_dfn(overwrite: bool = False): if overwrite: clean_tex_files() @@ -426,19 +459,15 @@ def test_build_pdfs_from_tex(tmp_path): def build_documentation( bin_path: PathLike, - output_path: PathLike, - examples_repo_path: PathLike, - # Example to use to render sample mf6 output in the docs. - # Must be a valid directory in modflow6-examples/examples - example_for_sample: str = "ex-gwf-twri01", full: bool = False, + output_path: Optional[PathLike] = None, overwrite: bool = False, + repo_owner: str = "MODFLOW-USGS", ): - print(f"Building {'full' if full else 'full'} documentation") + print(f"Building {'full' if full else 'minimal'} documentation") bin_path = Path(bin_path).expanduser().absolute() output_path = Path(output_path).expanduser().absolute() - examples_repo_path = Path(examples_repo_path).expanduser().absolute() # make sure output directory exists output_path.mkdir(parents=True, exist_ok=True) @@ -448,25 +477,27 @@ def build_documentation( # build LaTeX input/output example model docs with TemporaryDirectory() as temp: - temp_path = Path(temp) + example_path = _project_root_path / ".mf6minsim" build_mf6io_tex_example( - workspace_path=temp_path, + workspace_path=Path(temp), bin_path=bin_path, - example_model_path=examples_repo_path / "examples" / example_for_sample, + example_model_path=example_path, ) - # build LaTeX file describing distribution folder structure - # build_tex_folder_structure(overwrite=True) + # build deprecations table for insertion into LaTex release notes + build_deprecations_tex() if not full: # convert LaTeX to PDF - build_pdfs_from_tex(tex_paths=_dev_dist_tex_paths, output_path=output_path) + build_pdfs_from_tex(tex_paths=_dev_dist_tex_paths, output_path=output_path, overwrite=overwrite) else: # convert benchmarks to LaTex, running them first if necessary - build_benchmark_tex(output_path=output_path, overwrite=overwrite) + build_benchmark_tex( + output_path=output_path, overwrite=overwrite, repo_owner=repo_owner + ) # download example docs - latest = get_release("MODFLOW-USGS/modflow6-examples", "latest") + latest = get_release(f"{repo_owner}/modflow6-examples", "latest") assets = latest["assets"] asset = next(iter([a for a in assets if a["name"] == "mf6examples.pdf"]), None) download_and_unzip(asset["browser_download_url"], output_path, verbose=True) @@ -529,13 +560,6 @@ def test_build_documentation(tmp_path): """ ), ) - parser.add_argument( - "-t", - "--tex-path", - action="append", - required=False, - help="Extra LaTeX files to include", - ) parser.add_argument( "-b", "--bin-path", @@ -544,18 +568,19 @@ def test_build_documentation(tmp_path): help="Location of modflow6 executables", ) parser.add_argument( - "-e", - "--examples-repo-path", + "-f", + "--force", required=False, - default=str(_examples_repo_path), - help="Path to directory containing modflow6 example models", + default=False, + action="store_true", + help="Recreate and overwrite existing artifacts", ) parser.add_argument( - "-s", - "--example-for-sample", + "--full", required=False, - default="ex-gwf-twri01", - help="Name of example model to use for sample mf6 output", + default=False, + action="store_true", + help="Build docs for a full rather than minimal distribution", ) parser.add_argument( "-o", @@ -565,35 +590,19 @@ def test_build_documentation(tmp_path): help="Location to create documentation artifacts", ) parser.add_argument( - "--full", + "--repo-owner", required=False, - default=False, - action="store_true", - help="Build docs for a full rather than minimal distribution", - ) - parser.add_argument( - "-f", - "--force", - required=False, - default=False, - action="store_true", - help="Recreate and overwrite existing artifacts", + default="MODFLOW-USGS", + help="Repository owner (substitute your own for a fork)", ) args = parser.parse_args() - tex_paths = _full_dist_tex_paths + ( - [Path(p) for p in args.tex_path] if args.tex_path else [] - ) output_path = Path(args.output_path).expanduser().absolute() output_path.mkdir(parents=True, exist_ok=True) bin_path = Path(args.bin_path).expanduser().absolute() - examples_repo_path = Path(args.examples_repo_path).expanduser().absolute() - example_for_sample = args.example_for_sample - build_documentation( bin_path=bin_path, - output_path=output_path, - examples_repo_path=examples_repo_path, - example_for_sample=example_for_sample, full=args.full, + output_path=output_path, overwrite=args.force, + repo_owner=args.repo_owner, ) diff --git a/distribution/build_makefiles.py b/distribution/build_makefiles.py index ce441200775..e9fb09645db 100644 --- a/distribution/build_makefiles.py +++ b/distribution/build_makefiles.py @@ -6,8 +6,8 @@ import pymake import pytest from flaky import flaky -from modflow_devtools.misc import set_dir from modflow_devtools.markers import requires_exe +from modflow_devtools.misc import set_dir from utils import get_modified_time, get_project_root_path diff --git a/distribution/check_dist.py b/distribution/check_dist.py index 27be7d087bd..f8eab4355d6 100644 --- a/distribution/check_dist.py +++ b/distribution/check_dist.py @@ -1,5 +1,4 @@ import platform -import re import subprocess from os import environ from pathlib import Path @@ -7,14 +6,34 @@ import pytest -from utils import split_nonnumeric +# OS-specific extensions _system = platform.system() _eext = ".exe" if _system == "Windows" else "" _soext = ".dll" if _system == "Windows" else ".so" if _system == "Linux" else ".dylib" _scext = ".bat" if _system == "Windows" else ".sh" + +# fortran compiler _fc = environ.get("FC", None) +# directories included in full distribution +_included_dir_paths = { + "full": [ + "bin", + "doc", + "examples", + "src", + "srcbmi", + "msvs", + "make", + "utils", + ], + "minimal": [ + "bin", + "doc", + ], +} + @pytest.fixture def approved(request): @@ -47,26 +66,41 @@ def skip(): return path -def test_sources(dist_dir_path, approved, releasemode, full): +def test_directories(dist_dir_path, full): + for dir_path in _included_dir_paths["full" if full else "minimal"]: + assert (dist_dir_path / dir_path).is_dir() + + +def test_sources(dist_dir_path, releasemode, full): if not full: pytest.skip(reason="sources not included in minimal distribution") + # check top-level meson files + assert (dist_dir_path / "meson.build").is_file() + assert (dist_dir_path / "meson.options").is_file() + + # check src subdir assert (dist_dir_path / "src").is_dir() assert (dist_dir_path / "src" / "mf6.f90").is_file() - version_file_path = dist_dir_path / "src" / "Utilities" / "version.f90" assert version_file_path.is_file() - # find IDEVELOPMODE line + # check IDEVELOPMODE lines = open(version_file_path, "r").read().splitlines() pattern = ":: IDEVELOPMODE =" line = next(iter([l for l in lines if pattern in l]), None) assert line - - # make sure IDEVELOPMODE was set correctly idevelopmode = 0 if releasemode else 1 assert f"IDEVELOPMODE = {idevelopmode}" in line + # check utils subdir + assert (dist_dir_path / "utils").is_dir() + assert (dist_dir_path / "utils" / "mf5to6").is_dir() + assert (dist_dir_path / "utils" / "zonebudget").is_dir() + assert (dist_dir_path / "utils" / "mf5to6" / "pymake").is_dir() + assert (dist_dir_path / "utils" / "zonebudget" / "pymake").is_dir() + assert not (dist_dir_path / "utils" / "idmloader").is_dir() + @pytest.mark.skipif(not _fc, reason="needs Fortran compiler") def test_makefiles(dist_dir_path, full): @@ -142,13 +176,13 @@ def test_examples(dist_dir_path, full): print(f"{len(example_paths)} example models found:") pprint(example_paths) for p in example_paths: - pprint( - subprocess.check_output([str(p / f"run{_scext}")], cwd=p).decode().split() - ) + script_path = p / f"run{_scext}" + if not script_path.is_file(): + continue + pprint(subprocess.check_output([str(script_path)], cwd=p).decode().split()) break - def test_binaries(dist_dir_path, approved): bin_path = dist_dir_path / "bin" assert (bin_path / f"mf6{_eext}").is_file() @@ -156,19 +190,23 @@ def test_binaries(dist_dir_path, approved): assert (bin_path / f"mf5to6{_eext}").is_file() assert (bin_path / f"libmf6{_soext}").is_file() + # get version string output = " ".join( subprocess.check_output([str(bin_path / f"mf6{_eext}"), "-v"]).decode().split() ).lower() assert output.startswith("mf6") - # make sure binaries were built in correct mode + # make sure version string reflects approval assert ("preliminary" in output) != approved - # check version string + # check version numbers version = output.lower().split(" ")[1] - print(version) + print("Version string:", version) v_split = version.split(".") - assert len(v_split) == 3 - assert all(s.isdigit() for s in v_split[:2]) - sol = split_nonnumeric(v_split[2]) - assert sol[0].isdigit() + assert len(v_split) >= 3 + + # approved release should use semantic version number with + # exactly 3 components and no alphabetic characters in it + if approved: + assert len(v_split) == 3 + assert all(s.isdigit() for s in v_split[:3]) diff --git a/distribution/conftest.py b/distribution/conftest.py index 860ef1d585b..df18401b2a4 100644 --- a/distribution/conftest.py +++ b/distribution/conftest.py @@ -1,11 +1,11 @@ from pathlib import Path -from update_version import Version +from packaging.version import Version _project_root_path = Path(__file__).resolve().parent.parent _dist_dir_path = ( _project_root_path.parent - / f"mf{str(Version.from_file(_project_root_path / 'version.txt'))}" + / f"mf{str(Version((_project_root_path / 'version.txt').read_text().strip()))}" ) diff --git a/distribution/update_version.py b/distribution/update_version.py index f1112c58761..e09e0c69aef 100755 --- a/distribution/update_version.py +++ b/distribution/update_version.py @@ -31,20 +31,18 @@ import argparse import json import os -import re -import shutil import textwrap from collections import OrderedDict from datetime import datetime -from os import PathLike +from packaging.version import Version from pathlib import Path -from typing import NamedTuple, Optional +from typing import Optional import pytest from filelock import FileLock import yaml -from utils import get_modified_time, split_nonnumeric +from utils import get_modified_time project_name = "MODFLOW 6" project_root_path = Path(__file__).resolve().parent.parent @@ -62,56 +60,6 @@ ] -class Version(NamedTuple): - """Semantic version number, optionally with a short label (e.g, 'rc'). - The label may contain numbers but must begin with a letter.""" - - major: int = 0 - minor: int = 0 - patch: int = 0 - label: Optional[str] = None - - def __repr__(self): - s = f"{self.major}.{self.minor}.{self.patch}" - if self.label is not None and self.label != "": - s += self.label - return s - - @classmethod - def from_string(cls, version: str) -> "Version": - t = version.split(".") - assert len(t) > 2 - vmajor = int(t[0]) - vminor = int(t[1]) - tt = split_nonnumeric(t[2]) - vpatch = int(tt[0]) - vlabel = tt[1] if len(tt) > 1 else None - return cls(major=vmajor, minor=vminor, patch=vpatch, label=vlabel) - - @classmethod - def from_file(cls, path: PathLike) -> "Version": - path = Path(path).expanduser().absolute() - lines = [line.rstrip("\n") for line in open(Path(path), "r")] - vmajor = vminor = vpatch = vlabel = None - for line in lines: - t = line.split() - if "major =" in line: - vmajor = int(t[2]) - elif "minor =" in line: - vminor = int(t[2]) - elif "micro =" in line: - vpatch = int(t[2]) - elif "label =" in line: - vlabel = t[2].replace("'", "") - - msg = "version string must follow semantic version format, with optional label: major.minor.patch[label]" - missing = lambda v: f"Missing {v} number, {msg}" - assert vmajor is not None, missing("major") - assert vminor is not None, missing("minor") - assert vpatch is not None, missing("patch") - return cls(major=vmajor, minor=vminor, patch=vpatch, label=vlabel) - - _approved_fmtdisclaimer = ''' character(len=*), parameter :: FMTDISCLAIMER = & "(/,& &'This software has been approved for release by the U.S. Geological ',/,& @@ -181,25 +129,17 @@ def log_update(path, version: Version): def update_version_txt_and_py(version: Version, timestamp: datetime): with open(version_file_path, "w") as f: + f.write(str(version)) + log_update(version_file_path, version) + + py_path = project_root_path / "doc" / version_file_path.name.replace(".txt", ".py") + with open(py_path, "w") as f: f.write( f"# {project_name} version file automatically " + f"created using...{os.path.basename(__file__)}\n" ) f.write("# created on..." + f"{timestamp.strftime('%B %d, %Y %H:%M:%S')}\n") - f.write("\n") - f.write(f"major = {version.major}\n") - f.write(f"minor = {version.minor}\n") - f.write(f"micro = {version.patch}\n") - f.write( - "label = " + (("'" + version.label + "'") if version.label else "''") + "\n" - ) - f.write("__version__ = '{:d}.{:d}.{:d}'.format(major, minor, micro)\n") - f.write("if label:\n") - f.write("\t__version__ += '{}{}'.format(__version__, label)") - f.close() - log_update(version_file_path, version) - py_path = project_root_path / "doc" / version_file_path.name.replace(".txt", ".py") - shutil.copyfile(version_file_path, py_path) + f.write(f'__version__ = "{version}"\n') log_update(py_path, version) @@ -209,7 +149,7 @@ def update_meson_build(version: Version): with open(path, "w") as f: for line in lines: if "version:" in line and "meson_version:" not in line: - line = f" version: '{version.major}.{version.minor}.{version.patch}{version.label if version.label else ''}'," + line = f" version: '{version}'," f.write(f"{line}\n") log_update(path, version) @@ -217,7 +157,7 @@ def update_meson_build(version: Version): def update_version_tex(version: Version, timestamp: datetime): path = project_root_path / "doc" / "version.tex" with open(path, "w") as f: - line = "\\newcommand{\\modflowversion}{mf" + f"{str(version)}" + "}" + line = "\\newcommand{\\modflowversion}{mf" + str(version) + "}" f.write(f"{line}\n") line = ( "\\newcommand{\\modflowdate}{" + f"{timestamp.strftime('%B %d, %Y')}" + "}" @@ -351,11 +291,11 @@ def update_version( lock_path = Path(version_file_path.name + ".lock") try: lock = FileLock(lock_path) - previous = Version.from_file(version_file_path) + previous = Version(version_file_path.read_text().strip()) version = ( version if version - else Version(previous.major, previous.minor, previous.patch) + else previous ) with lock: @@ -370,8 +310,8 @@ def update_version( lock_path.unlink(missing_ok=True) -_initial_version = Version(0, 0, 1) -_current_version = Version.from_file(version_file_path) +_initial_version = Version("0.0.1") +_current_version = Version(version_file_path.read_text().strip()) @pytest.mark.skip(reason="reverts repo files on cleanup, tread carefully") @@ -379,17 +319,8 @@ def update_version( "version", [ None, - Version( - major=_initial_version.major, - minor=_initial_version.minor, - patch=_initial_version.patch, - ), - Version( - major=_initial_version.major, - minor=_initial_version.minor, - patch=_initial_version.patch, - label="rc", - ), + _initial_version, + Version(f"{_initial_version.major}.{_initial_version.minor}.dev{_initial_version.micro}"), ], ) @pytest.mark.parametrize("approved", [True, False]) @@ -405,7 +336,7 @@ def test_update_version(version, approved, developmode): approved=approved, developmode=developmode, ) - updated = Version.from_file(version_file_path) + updated = Version(version_file_path.read_text().strip()) # check files containing version info were modified for p, t in zip(touched_file_paths, m_times): @@ -414,20 +345,10 @@ def test_update_version(version, approved, developmode): # check version number and optional label are correct if version: # version should be auto-incremented - assert updated.major == _initial_version.major - assert updated.minor == _initial_version.minor - assert updated.patch == _initial_version.patch - if version.label is not None: - assert updated.label == version.label + assert updated == _initial_version else: # version should not have changed - assert updated.major == _current_version.major - assert updated.minor == _current_version.minor - assert updated.patch == _current_version.patch - if version.label is not None: - assert updated.label == version.label - if version.label is not None: - assert updated.label == _initial_version + assert updated == _current_version # check IDEVELOPMODE was set correctly version_f90_path = project_root_path / "src" / "Utilities" / "version.f90" @@ -462,13 +383,10 @@ def test_update_version(version, approved, developmode): provided, the version number will not be changed. A file lock is held to synchronize file access. To indicate a version is production-ready use --approve. This will change the disclaimer and version tag label, - removing 'Release Candidate' from the latter and modifying the former - to reflect approval The IDEVELOPMODE flag is set to 1 for preliminary - versions and 0 for approved versions. The version tag must follow the + removing '(preliminary)' from the latter, and modifying the former to + reflect approval The --releasemode flag controls whether IDEVELOPMODE + is set to 0 instead of the default 1. The version tag must follow the '..' format conventions for semantic versioning. - If --version is provided, --bump-patch, --bump-minor and --bump-major - may not be provided. Likewise, if any of the latter are provided, the - version number must not be specified. """ ), ) @@ -492,24 +410,6 @@ def test_update_version(version, approved, developmode): action="store_true", help="Set IDEVELOPMODE to 0 for release mode (defaults to false for development distributions)", ) - parser.add_argument( - "--bump-major", - required=False, - action="store_true", - help="Increment the major version number (cannot be used with --version, defaults to false)", - ) - parser.add_argument( - "--bump-minor", - required=False, - action="store_true", - help="Increment the minor version number (cannot be used with --version, defaults to false)", - ) - parser.add_argument( - "--bump-patch", - required=False, - action="store_true", - help="Increment the patch version number (cannot be used with --version, defaults to false)", - ) parser.add_argument( "-g", "--get", @@ -518,33 +418,13 @@ def test_update_version(version, approved, developmode): help="Get the current version number, don't update anything (defaults to false)", ) args = parser.parse_args() - - if args.version and (args.bump_major or args.bump_minor or args.bump_patch): - raise ValueError(f"Cannot specify --version and --bump-*, use one or the other") - - bump_flags = [b for b in [args.bump_major, args.bump_minor, args.bump_patch] if b] - if len(bump_flags) > 1: - raise ValueError(f"Cannot specify more than one --bump-* flag, use just one") - if args.get: - print(Version.from_file(project_root_path / "version.txt")) + print(Version((project_root_path / "version.txt").read_text().strip())) else: - if not args.version and not any(bump_flags): - version = _current_version - elif args.version: - version = Version.from_string(args.version) - else: - current = Version.from_file(project_root_path / "version.txt") - if args.bump_major: - print(f"Incrementing major number") - version = Version(current.major + 1, 0, 0) - elif args.bump_minor: - print(f"Incrementing minor number") - version = Version(current.major, current.minor + 1, 0) - else: - print(f"Incrementing patch number") - version = Version(current.major, current.minor, current.patch + 1) - + print(f"Updating to version {args.version} with options") + print(f" releasemode: {args.releasemode}") + print(f" approved: {args.approved}") + version = Version(args.version) if args.version else _current_version update_version( version=version, timestamp=datetime.now(), diff --git a/doc/Common/gwf-lakobs.tex b/doc/Common/gwf-lakobs.tex index 6686e6f650f..36efa37f01a 100644 --- a/doc/Common/gwf-lakobs.tex +++ b/doc/Common/gwf-lakobs.tex @@ -1,19 +1,19 @@ -LAK & stage & lakeno or boundname & -- & Surface-water stage in a lake. If boundname is specified, boundname must be unique for each lake. \\ -LAK & ext-inflow & lakeno or boundname & -- & Specified inflow into a lake or group of lakes. \\ -LAK & outlet-inflow & lakeno or boundname & -- & Simulated inflow from upstream lake outlets into a lake or group of lakes. \\ -LAK & inflow & lakeno or boundname & -- & Sum of specified inflow and simulated inflow from upstream lake outlets into a lake or group of lakes. \\ -LAK & from-mvr & lakeno or boundname & -- & Inflow into a lake or group of lakes from the MVR package. \\ -LAK & rainfall & lakeno or boundname & -- & Rainfall rate applied to a lake or group of lakes. \\ -LAK & runoff & lakeno or boundname & -- & Runoff rate applied to a lake or group of lakes. \\ -LAK & lak & lakeno or boundname & \texttt{iconn} or -- & Simulated flow rate for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the simulated lake-aquifer flow rate at a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ -LAK & withdrawal & lakeno or boundname & -- & Specified withdrawal rate from a lake or group of lakes. \\ -LAK & evaporation & lakeno or boundname & -- & Simulated evaporation rate from a lake or group of lakes. \\ +LAK & stage & ifno or boundname & -- & Surface-water stage in a lake. If boundname is specified, boundname must be unique for each lake. \\ +LAK & ext-inflow & ifno or boundname & -- & Specified inflow into a lake or group of lakes. \\ +LAK & outlet-inflow & ifno or boundname & -- & Simulated inflow from upstream lake outlets into a lake or group of lakes. \\ +LAK & inflow & ifno or boundname & -- & Sum of specified inflow and simulated inflow from upstream lake outlets into a lake or group of lakes. \\ +LAK & from-mvr & ifno or boundname & -- & Inflow into a lake or group of lakes from the MVR package. \\ +LAK & rainfall & ifno or boundname & -- & Rainfall rate applied to a lake or group of lakes. \\ +LAK & runoff & ifno or boundname & -- & Runoff rate applied to a lake or group of lakes. \\ +LAK & lak & ifno or boundname & \texttt{iconn} or -- & Simulated flow rate for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the simulated lake-aquifer flow rate at a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ +LAK & withdrawal & ifno or boundname & -- & Specified withdrawal rate from a lake or group of lakes. \\ +LAK & evaporation & ifno or boundname & -- & Simulated evaporation rate from a lake or group of lakes. \\ LAK & ext-outflow & outletno or boundname & -- & External outflow from a lake outlet, a lake, or a group of lakes to an external boundary. If boundname is not specified for ID, then the external outflow from a specific lake outlet is observed. In this case, ID is the outlet number outletno. \\ LAK & to-mvr & outletno or boundname & -- & Outflow from a lake outlet, a lake, or a group of lakes that is available for the MVR package. If boundname is not specified for ID, then the outflow available for the MVR package from a specific lake outlet is observed. In this case, ID is the outlet number outletno. \\ -LAK & storage & lakeno or boundname & -- & Simulated storage flow rate for a lake or group of lakes. \\ -LAK & constant & lakeno or boundname & -- & Simulated constant-flow rate for a lake or group of lakes. \\ +LAK & storage & ifno or boundname & -- & Simulated storage flow rate for a lake or group of lakes. \\ +LAK & constant & ifno or boundname & -- & Simulated constant-flow rate for a lake or group of lakes. \\ LAK & outlet & outletno or boundname & -- & Simulated outlet flow rate from a lake outlet, a lake, or a group of lakes. If boundname is not specified for ID, then the flow from a specific lake outlet is observed. In this case, ID is the outlet number outletno. \\ -LAK & volume & lakeno or boundname & -- & Simulated lake volume or group of lakes. \\ -LAK & surface-area & lakeno or boundname & -- & Simulated surface area for a lake or group of lakes. \\ -LAK & wetted-area & lakeno or boundname & \texttt{iconn} or -- & Simulated wetted-area for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the wetted area of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ -LAK & conductance & lakeno or boundname & \texttt{iconn} or -- & Calculated conductance for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the calculated conductance of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. +LAK & volume & ifno or boundname & -- & Simulated lake volume or group of lakes. \\ +LAK & surface-area & ifno or boundname & -- & Simulated surface area for a lake or group of lakes. \\ +LAK & wetted-area & ifno or boundname & \texttt{iconn} or -- & Simulated wetted-area for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the wetted area of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ +LAK & conductance & ifno or boundname & \texttt{iconn} or -- & Calculated conductance for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the calculated conductance of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. diff --git a/doc/Common/gwf-mawobs.tex b/doc/Common/gwf-mawobs.tex index 74f2bac793d..a98a4f1cca5 100644 --- a/doc/Common/gwf-mawobs.tex +++ b/doc/Common/gwf-mawobs.tex @@ -1,11 +1,11 @@ -MAW & head & wellno or boundname & -- & Head in a multi-aquifer well. If boundname is specified, boundname must be unique for each multi-aquifer well. \\ -MAW & from-mvr & wellno or boundname & -- & Simulated inflow to a well from the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & maw & wellno or boundname & \texttt{icon} or -- & Simulated flow rate for a multi-aquifer well or a group of multi-aquifer wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated multi-aquifer well-aquifer flow rate at a specific multi-aquifer well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{icon}. \\ -MAW & rate & wellno or boundname & -- & Simulated pumping rate for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & rate-to-mvr & wellno or boundname & -- & Simulated well discharge that is available for the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & fw-rate & wellno or boundname & -- & Simulated flowing well flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & fw-to-mvr & wellno or boundname & -- & Simulated flowing well discharge rate that is available for the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & storage & wellno or boundname & -- & Simulated storage flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & constant & wellno or boundname & -- & Simulated constant-flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ -MAW & conductance & wellno or boundname & \texttt{icon} or -- & Simulated well conductance for a multi-aquifer well or a group of multi-aquifer wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated multi-aquifer well conductance at a specific multi-aquifer well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{icon}. \\ -MAW & fw-conductance & wellno or boundname & -- & Simulated flowing well conductance for a multi-aquifer well or a group of multi-aquifer wells. \ No newline at end of file +MAW & head & ifno or boundname & -- & Head in a multi-aquifer well. If boundname is specified, boundname must be unique for each multi-aquifer well. \\ +MAW & from-mvr & ifno or boundname & -- & Simulated inflow to a well from the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & maw & ifno or boundname & \texttt{icon} or -- & Simulated flow rate for a multi-aquifer well or a group of multi-aquifer wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated multi-aquifer well-aquifer flow rate at a specific multi-aquifer well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{icon}. \\ +MAW & rate & ifno or boundname & -- & Simulated pumping rate for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & rate-to-mvr & ifno or boundname & -- & Simulated well discharge that is available for the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & fw-rate & ifno or boundname & -- & Simulated flowing well flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & fw-to-mvr & ifno or boundname & -- & Simulated flowing well discharge rate that is available for the MVR package for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & storage & ifno or boundname & -- & Simulated storage flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & constant & ifno or boundname & -- & Simulated constant-flow rate for a multi-aquifer well or a group of multi-aquifer wells. \\ +MAW & conductance & ifno or boundname & \texttt{icon} or -- & Simulated well conductance for a multi-aquifer well or a group of multi-aquifer wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated multi-aquifer well conductance at a specific multi-aquifer well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{icon}. \\ +MAW & fw-conductance & ifno or boundname & -- & Simulated flowing well conductance for a multi-aquifer well or a group of multi-aquifer wells. \ No newline at end of file diff --git a/doc/Common/gwf-sfrobs.tex b/doc/Common/gwf-sfrobs.tex index c8e447c2035..e67791f2635 100644 --- a/doc/Common/gwf-sfrobs.tex +++ b/doc/Common/gwf-sfrobs.tex @@ -1,18 +1,18 @@ -SFR & stage & rno or boundname & -- & Surface-water stage in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ -SFR & ext-inflow & rno or boundname & -- & Inflow into a stream-reach from an external boundary for a stream-reach or a group of stream-reaches. \\ -SFR & inflow & rno or boundname & -- & Inflow into a stream-reach from upstream reaches for a stream-reach or a group of stream-reaches. \\ -SFR & from-mvr & rno or boundname & -- & Inflow into a stream-reach from the MVR package for a stream-reach or a group of stream-reaches. \\ -SFR & rainfall & rno or boundname & -- & Rainfall rate applied to a stream-reach or a group of stream-reaches. \\ -SFR & runoff & rno or boundname & -- & Runoff rate applied to a stream-reach or a group of stream-reaches. \\ -SFR & sfr & rno or boundname & -- & Simulated flow rate for a stream-reach and its aquifer connection for a stream-reach or a group of stream-reaches. \\ -SFR & evaporation & rno or boundname & -- & Simulated evaporation rate from a stream-reach or a group of stream-reaches. \\ -SFR & outflow & rno or boundname & -- & Outflow from a stream-reach to downstream reaches for a stream-reach or a group of stream-reaches. \\ -SFR & ext-outflow & rno or boundname & -- & Outflow from a stream-reach to an external boundary for a stream-reach or a group of stream-reaches. \\ -SFR & to-mvr & rno or boundname & -- & Outflow from a stream-reach that is available for the MVR package for a stream-reach or a group of stream-reaches. \\ -SFR & upstream-flow & rno or boundname & -- & Upstream flow for a stream-reach or a group of stream-reaches from upstream reaches and the MVR package. \\ -SFR & downstream-flow & rno or boundname & -- & Downstream flow for a stream-reach or a group of stream-reaches prior to diversions and the MVR package. \\ -SFR & depth & rno or boundname & -- & Surface-water depth in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ -SFR & wet-perimeter & rno or boundname & -- & Wetted perimeter in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ -SFR & wet-area & rno or boundname & -- & Wetted cross-section area in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ -SFR & wet-width & rno or boundname & -- & Wetted top width in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ +SFR & stage & ifno or boundname & -- & Surface-water stage in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ +SFR & ext-inflow & ifno or boundname & -- & Inflow into a stream-reach from an external boundary for a stream-reach or a group of stream-reaches. \\ +SFR & inflow & ifno or boundname & -- & Inflow into a stream-reach from upstream reaches for a stream-reach or a group of stream-reaches. \\ +SFR & from-mvr & ifno or boundname & -- & Inflow into a stream-reach from the MVR package for a stream-reach or a group of stream-reaches. \\ +SFR & rainfall & ifno or boundname & -- & Rainfall rate applied to a stream-reach or a group of stream-reaches. \\ +SFR & runoff & ifno or boundname & -- & Runoff rate applied to a stream-reach or a group of stream-reaches. \\ +SFR & sfr & ifno or boundname & -- & Simulated flow rate for a stream-reach and its aquifer connection for a stream-reach or a group of stream-reaches. \\ +SFR & evaporation & ifno or boundname & -- & Simulated evaporation rate from a stream-reach or a group of stream-reaches. \\ +SFR & outflow & ifno or boundname & -- & Outflow from a stream-reach to downstream reaches for a stream-reach or a group of stream-reaches. \\ +SFR & ext-outflow & ifno or boundname & -- & Outflow from a stream-reach to an external boundary for a stream-reach or a group of stream-reaches. \\ +SFR & to-mvr & ifno or boundname & -- & Outflow from a stream-reach that is available for the MVR package for a stream-reach or a group of stream-reaches. \\ +SFR & upstream-flow & ifno or boundname & -- & Upstream flow for a stream-reach or a group of stream-reaches from upstream reaches and the MVR package. \\ +SFR & downstream-flow & ifno or boundname & -- & Downstream flow for a stream-reach or a group of stream-reaches prior to diversions and the MVR package. \\ +SFR & depth & ifno or boundname & -- & Surface-water depth in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ +SFR & wet-perimeter & ifno or boundname & -- & Wetted perimeter in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ +SFR & wet-area & ifno or boundname & -- & Wetted cross-section area in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ +SFR & wet-width & ifno or boundname & -- & Wetted top width in a stream-reach boundary. If boundname is specified, boundname must be unique for each reach. \\ diff --git a/doc/Common/gwf-uzfobs.tex b/doc/Common/gwf-uzfobs.tex index b69b947ae86..abe1a42bd9f 100644 --- a/doc/Common/gwf-uzfobs.tex +++ b/doc/Common/gwf-uzfobs.tex @@ -1,12 +1,12 @@ -UZF & uzf-gwrch & iuzno or boundname & -- & Simulated recharge to the aquifer calculated by the UZF package for a UZF cell or a group of UZF cells.\\ -UZF & uzf-gwd & iuzno or boundname & -- & Simulated groundwater discharge to the land surface calculated by the UZF package for a UZF cell or a group of UZF cells. \\ -UZF & uzf-gwd-to-mvr & iuzno or boundname & -- & Simulated groundwater discharge to the land surface calculated by the UZF package that is available to the MVR package for a UZF cell or a group of UZF cells. \\ -UZF & uzf-gwet & iuzno or boundname & -- & Simulated groundwater evapotranspiration calculated by the UZF package for a UZF cell or a group of UZF cells.\\ -UZF & infiltration & iuzno or boundname & -- & Specified infiltration rate applied to a UZF package for a UZF cell or a group of UZF cells with landflag values not equal to zero.\\ -UZF & from-mvr & iuzno or boundname & -- & Inflow into a UZF cell from the MVR package for a UZF cell or a group of UZF cells. \\ -UZF & rej-inf & iuzno or boundname & -- & Simulated rejected infiltration calculated by the UZF package for a UZF cell or a group of UZF cells. \\ -UZF & rej-inf-to-mvr & iuzno or boundname & -- & Simulated rejected infiltration calculated by the UZF package that is available to the MVR package for a UZF cell or a group of UZF cells. \\ -UZF & uzet & iuzno or boundname & -- & Simulated unsaturated evapotranspiration calculated by the UZF package for a UZF cell or a group of UZF cells.\\ -UZF & storage & iuzno or boundname & -- & Simulated storage flow rate for a UZF package cell or a group of UZF cells. \\ -UZF & net-infiltration & iuzno or boundname & -- & Simulated net infiltration rate for a UZF package cell or a group of UZF cells. \\ -UZF & water-content & iuzno or boundname & depth & Unsaturated-zone water content at a user-specified depth (ID2) relative to the top of GWF cellid for a UZF cell. The user-specified depth must be greater than or equal to zero and less than the thickness of GWF cellid (TOP - BOT). If boundname is specified, boundname must be unique for each UZF cell. \ No newline at end of file +UZF & uzf-gwrch & ifno or boundname & -- & Simulated recharge to the aquifer calculated by the UZF package for a UZF cell or a group of UZF cells.\\ +UZF & uzf-gwd & ifno or boundname & -- & Simulated groundwater discharge to the land surface calculated by the UZF package for a UZF cell or a group of UZF cells. \\ +UZF & uzf-gwd-to-mvr & ifno or boundname & -- & Simulated groundwater discharge to the land surface calculated by the UZF package that is available to the MVR package for a UZF cell or a group of UZF cells. \\ +UZF & uzf-gwet & ifno or boundname & -- & Simulated groundwater evapotranspiration calculated by the UZF package for a UZF cell or a group of UZF cells.\\ +UZF & infiltration & ifno or boundname & -- & Specified infiltration rate applied to a UZF package for a UZF cell or a group of UZF cells with landflag values not equal to zero.\\ +UZF & from-mvr & ifno or boundname & -- & Inflow into a UZF cell from the MVR package for a UZF cell or a group of UZF cells. \\ +UZF & rej-inf & ifno or boundname & -- & Simulated rejected infiltration calculated by the UZF package for a UZF cell or a group of UZF cells. \\ +UZF & rej-inf-to-mvr & ifno or boundname & -- & Simulated rejected infiltration calculated by the UZF package that is available to the MVR package for a UZF cell or a group of UZF cells. \\ +UZF & uzet & ifno or boundname & -- & Simulated unsaturated evapotranspiration calculated by the UZF package for a UZF cell or a group of UZF cells.\\ +UZF & storage & ifno or boundname & -- & Simulated storage flow rate for a UZF package cell or a group of UZF cells. \\ +UZF & net-infiltration & ifno or boundname & -- & Simulated net infiltration rate for a UZF package cell or a group of UZF cells. \\ +UZF & water-content & ifno or boundname & depth & Unsaturated-zone water content at a user-specified depth (ID2) relative to the top of GWF cellid for a UZF cell. The user-specified depth must be greater than or equal to zero and less than the thickness of GWF cellid (TOP - BOT). If boundname is specified, boundname must be unique for each UZF cell. \ No newline at end of file diff --git a/doc/Common/gwt-lktobs.tex b/doc/Common/gwt-lktobs.tex index 637dbcf3d49..7d5279fa655 100644 --- a/doc/Common/gwt-lktobs.tex +++ b/doc/Common/gwt-lktobs.tex @@ -1,25 +1,25 @@ % general APT observations -LKT & concentration & lakeno or boundname & -- & Lake concentration. If boundname is specified, boundname must be unique for each lake. \\ -LKT & flow-ja-face & lakeno or boundname & lakeno or -- & Mass flow between two lakes connected by an outlet. If more than one outlet is used to connect the same two lakes, then the mass flow for only the first outlet can be observed. If a boundname is specified for ID1, then the result is the total mass flow for all outlets for a lake. If a boundname is specified for ID1 then ID2 is not used.\\ -LKT & storage & lakeno or boundname & -- & Simulated mass storage flow rate for a lake or group of lakes. \\ -LKT & constant & lakeno or boundname & -- & Simulated mass constant-flow rate for a lake or group of lakes. \\ -LKT & from-mvr & lakeno or boundname & -- & Simulated mass inflow into a lake or group of lakes from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ +LKT & concentration & ifno or boundname & -- & Lake concentration. If boundname is specified, boundname must be unique for each lake. \\ +LKT & flow-ja-face & ifno or boundname & ifno or -- & Mass flow between two lakes connected by an outlet. If more than one outlet is used to connect the same two lakes, then the mass flow for only the first outlet can be observed. If a boundname is specified for ID1, then the result is the total mass flow for all outlets for a lake. If a boundname is specified for ID1 then ID2 is not used.\\ +LKT & storage & ifno or boundname & -- & Simulated mass storage flow rate for a lake or group of lakes. \\ +LKT & constant & ifno or boundname & -- & Simulated mass constant-flow rate for a lake or group of lakes. \\ +LKT & from-mvr & ifno or boundname & -- & Simulated mass inflow into a lake or group of lakes from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ LKT & to-mvr & outletno or boundname & -- & Mass outflow from a lake outlet, a lake, or a group of lakes that is available for the MVR package. If boundname is not specified for ID, then the outflow available for the MVR package from a specific lake outlet is observed. In this case, ID is the outlet number, which must be between 1 and NOUTLETS. \\ -LKT & lkt & lakeno or boundname & \texttt{iconn} or -- & Mass flow rate for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the simulated lake-aquifer flow rate at a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn} for lake \texttt{lakeno}. \\ +LKT & lkt & ifno or boundname & \texttt{iconn} or -- & Mass flow rate for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the simulated lake-aquifer flow rate at a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn} for lake \texttt{ifno}. \\ %observations specific to the lake package % rainfall evaporation runoff ext-inflow withdrawal outflow -LKT & rainfall & lakeno or boundname & -- & Rainfall rate applied to a lake or group of lakes multiplied by the rainfall concentration. \\ -LKT & evaporation & lakeno or boundname & -- & Simulated evaporation rate from a lake or group of lakes multiplied by the evaporation concentration. \\ -LKT & runoff & lakeno or boundname & -- & Runoff rate applied to a lake or group of lakes multiplied by the runoff concentration. \\ -LKT & ext-inflow & lakeno or boundname & -- & Mass inflow into a lake or group of lakes calculated as the external inflow rate multiplied by the inflow concentration. \\ -LKT & withdrawal & lakeno or boundname & -- & Specified withdrawal rate from a lake or group of lakes multiplied by the simulated lake concentration. \\ -LKT & ext-outflow & lakeno or boundname & -- & External outflow from a lake or a group of lakes, through their outlets, to an external boundary. If the water mover is active, the reported ext-outflow value plus the rate to mover is equal to the total outlet outflow. +LKT & rainfall & ifno or boundname & -- & Rainfall rate applied to a lake or group of lakes multiplied by the rainfall concentration. \\ +LKT & evaporation & ifno or boundname & -- & Simulated evaporation rate from a lake or group of lakes multiplied by the evaporation concentration. \\ +LKT & runoff & ifno or boundname & -- & Runoff rate applied to a lake or group of lakes multiplied by the runoff concentration. \\ +LKT & ext-inflow & ifno or boundname & -- & Mass inflow into a lake or group of lakes calculated as the external inflow rate multiplied by the inflow concentration. \\ +LKT & withdrawal & ifno or boundname & -- & Specified withdrawal rate from a lake or group of lakes multiplied by the simulated lake concentration. \\ +LKT & ext-outflow & ifno or boundname & -- & External outflow from a lake or a group of lakes, through their outlets, to an external boundary. If the water mover is active, the reported ext-outflow value plus the rate to mover is equal to the total outlet outflow. -%LKT & outlet-inflow & lakeno or boundname & -- & Simulated inflow from upstream lake outlets into a lake or group of lakes. \\ -%LKT & inflow & lakeno or boundname & -- & Sum of specified inflow and simulated inflow from upstream lake outlets into a lake or group of lakes. \\ +%LKT & outlet-inflow & ifno or boundname & -- & Simulated inflow from upstream lake outlets into a lake or group of lakes. \\ +%LKT & inflow & ifno or boundname & -- & Sum of specified inflow and simulated inflow from upstream lake outlets into a lake or group of lakes. \\ %LKT & outlet & outletno or boundname & -- & Simulate outlet flow rate from a lake outlet, a lake, or a group of lakes. If boundname is not specified for ID, then the flow from a specific lake outlet is observed. In this case, ID is the outlet number outletno. \\ -%LKT & volume & lakeno or boundname & -- & Simulated lake volume or group of lakes. \\ -%LKT & surface-area & lakeno or boundname & -- & Simulated surface area for a lake or group of lakes. \\ -%LKT & wetted-area & lakeno or boundname & \texttt{iconn} or -- & Simulated wetted-area for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the wetted area of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ -%LKT & conductance & lakeno or boundname & \texttt{iconn} or -- & Calculated conductance for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the calculated conductance of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. +%LKT & volume & ifno or boundname & -- & Simulated lake volume or group of lakes. \\ +%LKT & surface-area & ifno or boundname & -- & Simulated surface area for a lake or group of lakes. \\ +%LKT & wetted-area & ifno or boundname & \texttt{iconn} or -- & Simulated wetted-area for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the wetted area of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. \\ +%LKT & conductance & ifno or boundname & \texttt{iconn} or -- & Calculated conductance for a lake or group of lakes and its aquifer connection(s). If boundname is not specified for ID, then the calculated conductance of a specific lake connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn}. diff --git a/doc/Common/gwt-mwtobs.tex b/doc/Common/gwt-mwtobs.tex index d05c267ba37..9799a090edc 100644 --- a/doc/Common/gwt-mwtobs.tex +++ b/doc/Common/gwt-mwtobs.tex @@ -1,13 +1,13 @@ % general APT observations -MWT & concentration & mawno or boundname & -- & Well concentration. If boundname is specified, boundname must be unique for each well. \\ +MWT & concentration & ifno or boundname & -- & Well concentration. If boundname is specified, boundname must be unique for each well. \\ %flowjaface not included -MWT & storage & mawno or boundname & -- & Simulated mass storage flow rate for a well or group of wells. \\ -MWT & constant & mawno or boundname & -- & Simulated mass constant-flow rate for a well or group of wells. \\ -MWT & from-mvr & mawno or boundname & -- & Simulated mass inflow into a well or group of wells from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ -MWT & mwt & mawno or boundname & \texttt{iconn} or -- & Mass flow rate for a well or group of wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated well-aquifer flow rate at a specific well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn} for well \texttt{mawno}. \\ +MWT & storage & ifno or boundname & -- & Simulated mass storage flow rate for a well or group of wells. \\ +MWT & constant & ifno or boundname & -- & Simulated mass constant-flow rate for a well or group of wells. \\ +MWT & from-mvr & ifno or boundname & -- & Simulated mass inflow into a well or group of wells from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ +MWT & mwt & ifno or boundname & \texttt{iconn} or -- & Mass flow rate for a well or group of wells and its aquifer connection(s). If boundname is not specified for ID, then the simulated well-aquifer flow rate at a specific well connection is observed. In this case, ID2 must be specified and is the connection number \texttt{iconn} for well \texttt{ifno}. \\ % observations specific to the mwt package -MWT & rate & mawno or boundname & -- & Simulated mass flow rate for a well or group of wells. \\ -MWT & fw-rate & mawno or boundname & -- & Simulated mass flow rate for a flowing well or group of flowing wells. \\ +MWT & rate & ifno or boundname & -- & Simulated mass flow rate for a well or group of wells. \\ +MWT & fw-rate & ifno or boundname & -- & Simulated mass flow rate for a flowing well or group of flowing wells. \\ MWT & rate-to-mvr & well or boundname & -- & Simulated mass flow rate that is sent to the MVT Package for a well or group of wells.\\ MWT & fw-rate-to-mvr & well or boundname & -- & Simulated mass flow rate that is sent to the MVT Package from a flowing well or group of flowing wells. \\ diff --git a/doc/Common/gwt-sftobs.tex b/doc/Common/gwt-sftobs.tex index 7e1da8f9af0..150b1ee0cdd 100644 --- a/doc/Common/gwt-sftobs.tex +++ b/doc/Common/gwt-sftobs.tex @@ -1,16 +1,16 @@ % general APT observations -SFT & concentration & rno or boundname & -- & Reach concentration. If boundname is specified, boundname must be unique for each reach. \\ -SFT & flow-ja-face & rno or boundname & rno or -- & Mass flow between two reaches. If a boundname is specified for ID1, then the result is the total mass flow for all reaches. If a boundname is specified for ID1 then ID2 is not used.\\ -SFT & storage & rno or boundname & -- & Simulated mass storage flow rate for a reach or group of reaches. \\ -SFT & constant & rno or boundname & -- & Simulated mass constant-flow rate for a reach or group of reaches. \\ -SFT & from-mvr & rno or boundname & -- & Simulated mass inflow into a reach or group of reaches from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ -SFT & to-mvr & rno or boundname & -- & Mass outflow from a reach, or a group of reaches that is available for the MVR package. If boundname is not specified for ID, then the outflow available for the MVR package from a specific reach is observed. \\ -SFT & sft & rno or boundname & -- & Mass flow rate for a reach or group of reaches and its aquifer connection(s). \\ +SFT & concentration & ifno or boundname & -- & Reach concentration. If boundname is specified, boundname must be unique for each reach. \\ +SFT & flow-ja-face & ifno or boundname & ifno or -- & Mass flow between two reaches. If a boundname is specified for ID1, then the result is the total mass flow for all reaches. If a boundname is specified for ID1 then ID2 is not used.\\ +SFT & storage & ifno or boundname & -- & Simulated mass storage flow rate for a reach or group of reaches. \\ +SFT & constant & ifno or boundname & -- & Simulated mass constant-flow rate for a reach or group of reaches. \\ +SFT & from-mvr & ifno or boundname & -- & Simulated mass inflow into a reach or group of reaches from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ +SFT & to-mvr & ifno or boundname & -- & Mass outflow from a reach, or a group of reaches that is available for the MVR package. If boundname is not specified for ID, then the outflow available for the MVR package from a specific reach is observed. \\ +SFT & sft & ifno or boundname & -- & Mass flow rate for a reach or group of reaches and its aquifer connection(s). \\ %observations specific to the stream transport package % rainfall evaporation runoff ext-inflow withdrawal outflow -SFT & rainfall & rno or boundname & -- & Rainfall rate applied to a reach or group of reaches multiplied by the rainfall concentration. \\ -SFT & evaporation & rno or boundname & -- & Simulated evaporation rate from a reach or group of reaches multiplied by the evaporation concentration. \\ -SFT & runoff & rno or boundname & -- & Runoff rate applied to a reach or group of reaches multiplied by the runoff concentration. \\ -SFT & ext-inflow & rno or boundname & -- & Mass inflow into a reach or group of reaches calculated as the external inflow rate multiplied by the inflow concentration. \\ -SFT & ext-outflow & rno or boundname & -- & External outflow from a reach or group of reaches to an external boundary. If boundname is not specified for ID, then the external outflow from a specific reach is observed. In this case, ID is the reach rno. +SFT & rainfall & ifno or boundname & -- & Rainfall rate applied to a reach or group of reaches multiplied by the rainfall concentration. \\ +SFT & evaporation & ifno or boundname & -- & Simulated evaporation rate from a reach or group of reaches multiplied by the evaporation concentration. \\ +SFT & runoff & ifno or boundname & -- & Runoff rate applied to a reach or group of reaches multiplied by the runoff concentration. \\ +SFT & ext-inflow & ifno or boundname & -- & Mass inflow into a reach or group of reaches calculated as the external inflow rate multiplied by the inflow concentration. \\ +SFT & ext-outflow & ifno or boundname & -- & External outflow from a reach or group of reaches to an external boundary. If boundname is not specified for ID, then the external outflow from a specific reach is observed. In this case, ID is the reach ifno. diff --git a/doc/Common/gwt-uztobs.tex b/doc/Common/gwt-uztobs.tex index 917b46b54a3..87b1c679258 100644 --- a/doc/Common/gwt-uztobs.tex +++ b/doc/Common/gwt-uztobs.tex @@ -1,14 +1,14 @@ % general APT observations -UZT & concentration & uztno or boundname & -- & uzt cell concentration. If boundname is specified, boundname must be unique for each uzt cell. \\ -UZT & flow-ja-face & uztno or boundname & uztno or -- & Mass flow between two uzt cells. If a boundname is specified for ID1, then the result is the total mass flow for all uzt cells. If a boundname is specified for ID1 then ID2 is not used.\\ -UZT & storage & uztno or boundname & -- & Simulated mass storage flow rate for a uzt cell or group of uzt cells. \\ -UZT & constant & uztno or boundname & -- & Simulated mass constant-flow rate for a uzt cell or a group of uzt cells. \\ -UZT & from-mvr & uztno or boundname & -- & Simulated mass inflow into a uzt cell or group of uzt cells from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ -UZT & uzt & uztno or boundname & -- & Mass flow rate for a uzt cell or group of uzt cells and its aquifer connection(s). \\ +UZT & concentration & ifno or boundname & -- & uzt cell concentration. If boundname is specified, boundname must be unique for each uzt cell. \\ +UZT & flow-ja-face & ifno or boundname & ifno or -- & Mass flow between two uzt cells. If a boundname is specified for ID1, then the result is the total mass flow for all uzt cells. If a boundname is specified for ID1 then ID2 is not used.\\ +UZT & storage & ifno or boundname & -- & Simulated mass storage flow rate for a uzt cell or group of uzt cells. \\ +UZT & constant & ifno or boundname & -- & Simulated mass constant-flow rate for a uzt cell or a group of uzt cells. \\ +UZT & from-mvr & ifno or boundname & -- & Simulated mass inflow into a uzt cell or group of uzt cells from the MVT package. Mass inflow is calculated as the product of provider concentration and the mover flow rate. \\ +UZT & uzt & ifno or boundname & -- & Mass flow rate for a uzt cell or group of uzt cells and its aquifer connection(s). \\ %observations specific to the uzt package % infiltration rej-inf uzet rej-inf-to-mvr -UZT & infiltration & uztno or boundname & -- & Infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration. \\ -UZT & rej-inf & uztno or boundname & -- & Rejected infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration. \\ -UZT & uzet & uztno or boundname & -- & Unsaturated zone evapotranspiration rate applied to a uzt cell or group of uzt cells multiplied by the uzt cell concentration. \\ -UZT & rej-inf-to-mvr & uztno or boundname & -- & Rejected infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration that is sent to the mover package. \\ +UZT & infiltration & ifno or boundname & -- & Infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration. \\ +UZT & rej-inf & ifno or boundname & -- & Rejected infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration. \\ +UZT & uzet & ifno or boundname & -- & Unsaturated zone evapotranspiration rate applied to a uzt cell or group of uzt cells multiplied by the uzt cell concentration. \\ +UZT & rej-inf-to-mvr & ifno or boundname & -- & Rejected infiltration rate applied to a uzt cell or group of uzt cells multiplied by the infiltration concentration that is sent to the mover package. \\ diff --git a/doc/ReleaseNotes/ReleaseNotes.tex b/doc/ReleaseNotes/ReleaseNotes.tex index 26fbf93e8d8..0ea54536e6c 100644 --- a/doc/ReleaseNotes/ReleaseNotes.tex +++ b/doc/ReleaseNotes/ReleaseNotes.tex @@ -176,6 +176,7 @@ \section{Release History} 6.4.0 & November 30, 2022 & \url{https://doi.org/10.5066/P9FL1JCC} \\ 6.4.1 & December 9, 2022 & \url{https://doi.org/10.5066/P9FL1JCC} \\ 6.4.2 & June 28, 2023 & \url{https://doi.org/10.5066/P9FL1JCC} \\ +6.4.3 & February 7, 2024 & \url{https://doi.org/10.5066/P9FL1JCC} \\ \hline \label{tab:releases} \end{tabular*} @@ -189,7 +190,7 @@ \section{Changes Introduced in this Release} This section describes changes introduced into MODFLOW~6 for the current release. These changes may substantially affect users. \begin{itemize} -\input{v6.4.2.tex} +\input{develop.tex} \end{itemize} % ------------------------------------------------- @@ -199,7 +200,7 @@ \section{Known Issues and Incompatibilities} \begin{enumerate} \item -The AUXMULTNAME option can be used to scale input values, such as riverbed conductance, using values in an auxiliary column. When this AUXMULTNAME option is used, the multiplier value in the AUXMULTNAME column should not be represented with a time series unless the value to scale is also represented with a time series. +The READARRAY utility is used by some packages to read arrays of numeric values provided by the user. The READARRAY utility has an IPRN option (as described in the MODFLOW 6 Description of Input and Output), which will cause the array to be written to the model listing file. Support for the IPRN option has been removed for some packages and will ultimately be removed for all packages. An alternative for IPRN functionality is presently under development. \item The capability to use Unsaturated Zone Flow (UZF) routing beneath lakes and streams has not been implemented. @@ -232,32 +233,34 @@ \section{Known Issues and Incompatibilities} % ------------------------------------------------- \section{Distribution File} -The following distribution file is for use on personal computers: \texttt{\modflowversion.zip}. The distribution file is a compressed zip file. The following directory structure is incorporated in the zip file: +The following distribution file is for use on personal computers: \texttt{\modflowversion\_[ostag].zip}. The distribution file is a compressed zip file. The following directory structure is incorporated in the zip file: % folder structured created by python script \input{folder_struct.tex} -It is recommended that no user files are kept in the \modflowversion~directory structure. If you do plan to put your own files in the \modflowversion~directory structure, do so only by creating additional subdirectories. +It is recommended that no user files are kept in the release directory. If you do plan to put your own files in the release directory, do so only by creating additional subdirectories. % ------------------------------------------------- \section{Installation and Execution} -There is no installation of MODFLOW~6 other than the requirement that \texttt{\modflowversion.zip} must be unzipped into a location where it can be accessed. +There is no installation of MODFLOW~6 other than the requirement that \texttt{\modflowversion\_[ostag].zip} must be unzipped into a location where it can be accessed. To make the executable versions of MODFLOW~6 accessible from any directory, the directory containing the executables should be included in the PATH environment variable. Also, if a prior release of MODFLOW~6 is installed on your system, the directory containing the executables for the prior release should be removed from the PATH environment variable. -As an alternative, the executable file, named ``\texttt{mf6.exe}'' on Windows, in the \modflowversion{}/bin directory can be copied into a directory already included in the PATH environment variable. +As an alternative, the executable file, named ``\texttt{mf6.exe}'' on Windows, in the \modflowversion\_[ostag]/bin directory can be copied into a directory already included in the PATH environment variable. To run MODFLOW~6, simply type \texttt{mf6} in a terminal window. The current working directory must be set to a location where the model input files are located. Upon execution, MODFLOW~6 will immediately look for file with the name \texttt{mfsim.nam} in the current working directory, and will terminate with an error if it does not find this file. % ------------------------------------------------- \section{Compiling MODFLOW~6} -MODFLOW~6 has been compiled using Intel Fortran and GNU Fortran on the Windows, macOS, and Linux operating systems. Because the program uses relatively new Fortran functionality, recent versions of the compilers may be required for successful compilation. MODFLOW~6 is currently tested with gfortran 7-12 on Linux and gfortran 12 on macOS and Windows. If you have gfortran installed on your computer, you can tell which version it is by entering ``\verb|gfortran --version|'' at a terminal window. MODFLOW~6 is currently not compatible with the next-generation Intel Fortran Compiler; a recent version of the Intel Fortran Compiler Classic (e.g. 2021.8.0) must be used. +MODFLOW~6 has been compiled using Intel Fortran and GNU Fortran on Windows, macOS, and several Linux operating systems. All MODFLOW~6 distributions are currently compiled with Intel Fortran. Because the program uses relatively new Fortran functionality, recent versions of the compilers may be required for successful compilation. MODFLOW~6 is not yet compatible with the latest versions of the Intel toolchain, however. + +MODFLOW~6 is currently tested with gfortran 7-12 on Linux and gfortran 12 on macOS and Windows. The gfortran version can be queried with ``\verb|gfortran --version|''. Intel Fortran Compiler Classic version 2022.3.0 is currently tested on all three platforms. Some 2021 versions have also been reported compatible. At this time, MODFLOW~6 is not compatible with the next-generation Intel Fortran Compiler `ifx`. Meson is the recommended build tool for MODFLOW~6. For more detailed compilation instructions, please refer to \url{https://github.com/MODFLOW-USGS/modflow6/blob/develop/DEVELOPER.md#building}. This distribution contains the Microsoft Visual Studio solution and project files for compiling MODFLOW~6 on Windows using the Intel Fortran Compiler Classic. The files have been used successfully with recent versions of Microsoft Visual Studio Community 2019 and the Intel Fortran Compiler Classic. -This distribution also comes with a makefile for compiling MODFLOW~6 with \texttt{gfortran}. The makefile is contained in the \texttt{make} folder. +This distribution also includes a makefile for compiling MODFLOW~6 with \texttt{gfortran}. The makefile is contained in the \texttt{make} folder. For those familiar with Python, the pymake package can also be used to compile MODFLOW~6. Additional information on the Python pymake utility can be found at: \url{https://github.com/modflowpy/pymake}. @@ -295,6 +298,10 @@ \section{MODFLOW~6 Documentation} \noindent Description of the MODFLOW~6 input and output is included in this distribution in the ``doc'' folder as mf6io.pdf. +% ------------------------------------------------- +% if deprecation information exists, then include the deprecation table +\IfFileExists{./deprecations.tex}{\input{./deprecations.tex}}{} + % ------------------------------------------------- % if runtime information exists, then include the run time comparison table \IfFileExists{./run-time-comparison.tex}{\input{./run-time-comparison.tex}}{} diff --git a/doc/ReleaseNotes/appendixA.tex b/doc/ReleaseNotes/appendixA.tex index 2bad0245dce..199d7151043 100644 --- a/doc/ReleaseNotes/appendixA.tex +++ b/doc/ReleaseNotes/appendixA.tex @@ -1,5 +1,6 @@ This appendix describes changes introduced into MODFLOW~6 in previous releases. These changes may substantially affect users. + \input{./previous/v6.4.2.tex} \input{./previous/v6.4.1.tex} \input{./previous/v6.4.0.tex} \input{./previous/v6.3.0.tex} diff --git a/doc/ReleaseNotes/develop.tex b/doc/ReleaseNotes/develop.tex new file mode 100644 index 00000000000..05253619fd4 --- /dev/null +++ b/doc/ReleaseNotes/develop.tex @@ -0,0 +1,64 @@ +% Use this template for starting initializing the release notes +% after a release has just been made. + + \item \currentmodflowversion + + \underline{NEW FUNCTIONALITY} + \begin{itemize} + \item The Input Data Processor (IDP), first released in version 6.4.2, is a general utility for reading user-provided input files. Package-specific routines for reading input files continue to be replaced by the IDP approach. For packages that use IDP for input, logging information is written to the simulation list file (mfsim.lst). Additional information on the IDP and the list of supported packages is contained in the MODFLOW 6 Description of Input and Output (mf6io.pdf) under a section titled ``Processing of Program Input.'' + \item The source code was refactored to support compilation of a parallel version of MODFLOW 6 based on the Message Passing Interface (MPI) and the Portable, Extensible Toolkit for Scientific Computation (PETSc) libraries. The parallel version of MODFLOW is considered preliminary. Limited testing of the parallel version has been performed on laptops, desktops, and supercomputers, but significant changes are expected in future releases. User support for the parallel version of MODFLOW 6 may be provided in the future. + % \item xxx + \end{itemize} + + \underline{EXAMPLES} + \begin{itemize} + \item A new exampled called ex-gwf-rad-disu was added. This new example uses a DISU grid to represent radial groundwater flow to a pumping well. + \item A new exampled called ex-gwf-curv-90 was added. This new example demonstrates use of a DISV grid to represent a curvilinear spatial discretization. For this example, the curvilinear grid is applied to one quarter of a radial groundwater flow system. + \item A new exampled called ex-gwf-curvilin was added. This new example uses a curvilinear grid, represented with the DISV Package, to simulate groundwater flow through a multi-region aquifer with bends in the domain boundaries. + \end{itemize} + + \textbf{\underline{BUG FIXES AND OTHER CHANGES TO EXISTING FUNCTIONALITY}} \\ + \underline{BASIC FUNCTIONALITY} + \begin{itemize} + \item Improve error message if the size of data read from a binary array file is inconsistent with READARRAY control line and variable description keywords. + \item The area calculation for cells in the DISV package was inaccurate for some cases with very large cell vertex coordinates. The area calculation was improved by using transformed cell vertex coordinates prior to making the area calculation. + \item Auxiliary variables in RCH and EVT Array-Based input packages are now reset to zero when otherwise not specified in period input data and the auxiliary parameter is not controlled by a time-series. + % \item xxx + % \item xxx + \end{itemize} + + \underline{INTERNAL FLOW PACKAGES} + \begin{itemize} + \item The data header in the binary output file written by the viscosity (VSC) package was printing `` VISCOSI'' instead of `` VISCOSITY''. The viscosity package now prints the full `` VISCOSITY'' header in the binary output file. + \item The CSUB Package did not support output of z-displacement arrays for models using the DISU package. The CSUB package was updated to support calculation of z-displacement arrays for DISU model grids. + % \item xxx + \end{itemize} + + \underline{STRESS PACKAGES} + \begin{itemize} + \item This release contains a fix for a longstanding issue related to the use of AUXMULTNAME and time series. Previous release notes included the following description of a known issue: \textit{``The AUXMULTNAME option can be used to scale input values, such as riverbed conductance, using values in an auxiliary column. When this AUXMULTNAME option is used, the multiplier value in the AUXMULTNAME column should not be represented with a time series unless the value to scale is also represented with a time series.''} With this release, the Input Data Processor (IDP) is now used to read stress package input files, and the limitation with AUXMULTNAME and time series no longer applies. + % \item xxx + % \item xxx + \end{itemize} + + \underline{ADVANCED STRESS PACKAGES} + \begin{itemize} + \item Added functionality to support zero values for each grid dimension when specifying the CELLID for SFR reaches that are not connected to an underlying groundwater grid cell. For example, for a DIS grid a CELLID of 0 0 0 should be specified for reaches with no connection to a groundwater cell. Warning messages will be issued if NONE is specified for the CELLID of an unconnected reach. Specifying a CELLID of NONE will eventually be deprecated and will cause MODFLOW 6 to terminate with an error. + \item Added functionality to support specification of a DNODATA (3.0E+30) BEDLEAK value for LAK package connections. This DNODATA value is used to identify lake-GWF connections where conductance is solely a function of aquifer properties in the connected GWF cell. In this case, the lakebed sediments are assumed to be absent and all resistance to flow is assumed to be within the GWF cell. Warning messages are now issued if NONE is specified for LAK package connections. Specifying a BEDLEAK value equal to NONE will eventually be deprecated and will cause MODFLOW 6 to terminate with an error. + \item SFR diversion would not be updated if the outflow of its upstream reach is zero. If diversion was not zero in the previous stress period, it would report mass balance error in the SFR budget. This bug was fixed by always updating the diversion. + % \item xxx + \end{itemize} + + %\underline{SOLUTION} + %\begin{itemize} + % \item xxx + % \item xxx + % \item xxx + %\end{itemize} + + \underline{EXCHANGES} + \begin{itemize} + \item A model budget error would occur when a constant-head (CHD) cell in one model had a direct connection to an active cell in another model. For the model budget to be calculated correctly a new term called ``FLOW-JA-FACE-CHD'' was added to the GWF model budget. This term is only included in the budget table when the GWF Model is connected to another GWF Model using a GWF-GWF Exchange. Additionally, the CHD budget calculation for a very specific (and rare) configuration was also incorrect. The incorrect budget calculation occurred when the following conditions were met: (1) a GWF model was connected to another GWF model with a GWF-GWF Exchange; (2) the model as well as the Exchange had the XT3D option enabled, and (3) the model was configured with a CHD cell that is either an Exchange cell, i.e. a cell that is part of the EXCHANGEDATA block, or a cell directly connected to such an Exchange cell. The size of the error depends on the degree of anisotropy around the particular CHD cell and shows up as a discrepancy in the volume budget table reported in the GWF list file. The program has been updated with the correct budget calculation. + % \item xxx + % \item xxx + \end{itemize} diff --git a/doc/ReleaseNotes/folder_struct.tex b/doc/ReleaseNotes/folder_struct.tex index 51ba1dc21b0..544ea59f8e8 100644 --- a/doc/ReleaseNotes/folder_struct.tex +++ b/doc/ReleaseNotes/folder_struct.tex @@ -1,5 +1,5 @@ \begin{verbatim} -mf6.x.x/ +\modflowversion bin/ doc/ examples/ diff --git a/doc/ReleaseNotes/mk_deprecations.py b/doc/ReleaseNotes/mk_deprecations.py new file mode 100644 index 00000000000..128481c2893 --- /dev/null +++ b/doc/ReleaseNotes/mk_deprecations.py @@ -0,0 +1,72 @@ +# This script converts the markdown deprecations table +# into a latex table for inclusion in the release notes +import argparse +from pathlib import Path +from warnings import warn + + +if __name__ == "__main__": + parser = argparse.ArgumentParser() + parser.add_argument("path") + args = parser.parse_args() + + header = r""" + \section{Deprecations} + + Deprecated/removed options in the current version of MODFLOW 6. Deprecated options are not suggested for use and may (but need not) be removed in a future version of MODFLOW 6. Removed options are no longer available in the current version of MODFLOW 6. + + \small + \begin{longtable}[!htbp]{p{5cm} p{3cm} p{3cm} p{1.5cm}} + \caption{List of deprecations and removals} + \label{table:deprecations} + \tabularnewline + + \hline + \hline + \textbf{Model--Package} & \textbf{Option} & \textbf{Deprecated} & \textbf{Removed} \\ + \hline + \endfirsthead + + \hline + \hline + \textbf{Model--Package} & \textbf{Option} & \textbf{Deprecated} & \textbf{Removed} \\ + \hline + \endhead + + """ + + footer = r""" + \hline + \end{longtable} + \normalsize + """ + + fname = "deprecations" + fpath = Path(args.path).expanduser().absolute() + fnametex = Path(f"{fname}.tex").absolute() + fnametex.unlink(missing_ok=True) + + # if the markdown file exists, convert it to latex + if fpath.is_file(): + ftex = open(fnametex, 'w') + ftex.write(header) + skipline = True + with open(fpath) as fmd: + for line in fmd: + if not skipline: + ll = line.strip().split('|') + ll = ll[1:-1] + linetex = "& ".join(ll) + linetex = linetex.replace("\\", "/") + linetex += '\\\\' + '\n' + linetex = linetex.replace("%", "\\%") + linetex = linetex.replace("_", "\\_") + ftex.write(linetex) + ftex.write("\\hline\n") + if ":-" in line: + skipline = False + ftex.write(footer) + ftex.close() + print(f"Created LaTex file {fnametex} from markdown deprecations file {fpath}") + else: + warn(f"Deprecations not found: {fpath}") diff --git a/doc/ReleaseNotes/v6.4.2.tex b/doc/ReleaseNotes/previous/v6.4.2.tex similarity index 99% rename from doc/ReleaseNotes/v6.4.2.tex rename to doc/ReleaseNotes/previous/v6.4.2.tex index 8d718485fc1..afc3511061a 100644 --- a/doc/ReleaseNotes/v6.4.2.tex +++ b/doc/ReleaseNotes/previous/v6.4.2.tex @@ -2,7 +2,7 @@ % after a release has just been made. %\item \currentmodflowversion - \item Version mf6.4.2--June 28, 2023 + \subsection{Version mf6.4.2--June 28, 2023} \underline{NEW FUNCTIONALITY} \begin{itemize} diff --git a/doc/mf6io/body.tex b/doc/mf6io/body.tex index b34c0b6f72b..32f0150cf94 100644 --- a/doc/mf6io/body.tex +++ b/doc/mf6io/body.tex @@ -11,11 +11,15 @@ %General form of input instructions \SECTION{Form of Input Instructions} -\input{form_of_input.tex} +\input{framework/form_of_input.tex} +\input{framework/array_data.tex} +\input{framework/binary_array_input} +\input{framework/list_data.tex} +\input{framework/binary_list_input} %Processing of program input \SECTION{Processing of Program Input} -\input{processing_of_input.tex} +\input{framework/processing_of_input.tex} %Simulation name file \newpage @@ -59,7 +63,7 @@ %Binary files \newpage \SECTION{Description of Binary Output Files for the Groundwater Flow (GWF) and Groundwater Transport (GWT) Models } -\input{gwf/binaryoutput} +\input{framework/binaryoutput} \newpage \ifx\usgsdirector\undefined diff --git a/doc/mf6io/gwf/array_data.tex b/doc/mf6io/framework/array_data.tex similarity index 53% rename from doc/mf6io/gwf/array_data.tex rename to doc/mf6io/framework/array_data.tex index 4a2c400bc79..ac36dec8c92 100644 --- a/doc/mf6io/gwf/array_data.tex +++ b/doc/mf6io/framework/array_data.tex @@ -1,5 +1,5 @@ \subsection{Array Input (READARRAY)} -Some GWF Model packages require arrays of information to be provided by the user. This information is read using a generic READARRAY capability in \mf. Within this user guide, variables that are read with READARRAY are marked accordingly, as shown in example input instructions for a DATA block. +Some \mf Model packages require arrays of information to be provided by the user. This information is read using a generic READARRAY capability in \mf. Within this user guide, variables that are read with READARRAY are marked accordingly, as shown in example input instructions for a DATA block. \begin{lstlisting}[style=blockdefinition] BEGIN DATA @@ -96,7 +96,7 @@ \subsubsection{READARRAY Examples} \end{lstlisting} -Some arrays define information that is required for the entire model grid, or part of a model grid. This type of information is provided in a special type of data block called a ``GRIDDATA'' block. For example, hydraulic conductivity is required for every cell in the model grid. Hydraulic conductivity is read from a ``GRIDDATA'' block in the NPF Package input file. For GRIDDATA arrays with one value for every cell in the model grid, the arrays can optionally be read in a LAYERED format, in which an array is provided for each layer of the grid. Alternatively, the array can be read for the entire model grid. As an example, consider the GRIDDATA block for the IC Package shown below: +Some arrays define information that is required for the entire model grid, or part of a model grid. This type of information is provided in a special type of data block called a ``GRIDDATA'' block. For example, hydraulic conductivity is required for every cell in the model grid. Hydraulic conductivity is read from a ``GRIDDATA'' block in the \mf GWF NPF Package input file. For GRIDDATA arrays with one value for every cell in the model grid, the arrays can optionally be read in a LAYERED format, in which an array is provided for each layer of the grid. Alternatively, the array can be read for the entire model grid. As an example, consider the GRIDDATA block for the \mf GWF or GWT IC Package shown below: \lstinputlisting[style=blockdefinition]{./mf6ivar/tex/gwf-ic-griddata.dat} @@ -104,7 +104,7 @@ \subsubsection{READARRAY Examples} For a structured DIS model, the READARRAY utility is used to read arrays that are dimensioned to the full size of the grid (of size \texttt{nlay*nrow*ncol}). This utility first reads an array name, which associates the input to be read with the desired array. For these arrays, an optional keyword ``LAYERED'' can be located next to the array name. If ``LAYERED'' is detected, then a control line is provided for each layer and the array is filled with values for each model layer. If the ``LAYERED'' keyword is absent, then a single control line is used and the entire array is filled at once. -For example, the following block shows one way the starting head array (STRT) could be specified for a model with 4 layers. Following the array name and the ``LAYERED'' keyword are four control lines, one for each layer. +For example, the following block shows one way the \mf GWF model starting head array (STRT) could be specified for a model with 4 layers. Following the array name and the ``LAYERED'' keyword are four control lines, one for each layer. \begin{lstlisting}[style=inputfile] STRT LAYERED @@ -121,41 +121,21 @@ \subsubsection{READARRAY Examples} CONSTANT 10.0 #applies to all cells in the grid \end{lstlisting} -\subsection{List Input} -Some items consist of several variables, such as layer, row, column, stage, and conductance, for example. List input refers to a block of data with a separate item on each line. For some common list types, the first set of variables is a cell identifier (denoted as \texttt{cellid} in this guide), such as layer, row, and column. With lists, the input data for each item must start on a new line. All variables for an item are assumed to be contained in a single line. Each input variable has a data type, which can be Double Precision, Integer, or Character. Integers are whole numbers and must not include a decimal point or exponent. Double Precision numbers can include a decimal point and an exponent. If no decimal point is included in the entered value, then the decimal point is assumed to be at the right side of the value. Any printable character is allowed for character variables. - -Variables starting with the letters I-N are most commonly integers; however, in some instances, a character string may start with the letters I-N. Variables starting with the letters A-H and O-Z are primarily double precision numbers; however, these variable names may also be used for character data. In \mf all variables are explicitly declared within the source code, as opposed to the implicit type declaration in previous MODFLOW versions. This explicit declaration means that the variable type can be easily determined from the source code. - -Free formatting is used throughout the input instructions. With free format, values are not required to occupy a fixed number of columns in a line. Each value can occupy one or more columns as required to represent the value; however, the values must still be included in the prescribed order. One or more spaces, or a single comma optionally combined with spaces, must separate adjacent values. Also, a numeric value of zero must be explicitly represented with 0 and not by one or more spaces when free format is used, because detecting the difference between a space that represents 0 and a space that represents a value separator is not possible. Free format is similar to Fortran's list directed input. - -Two capabilities included in Fortran's list-directed input are not included in the free-format input implemented in \mf. Null values in which input values are left unchanged from their previous values are not allowed. In general, MODFLOW's input values are not defined prior to their input. A ``/'' cannot be used to terminate an input line without including values for all the variables; data values for all required input variables must be explicitly specified on an input line. For character data, MODFLOW's free format implementation is less stringent than the list-directed input of Fortran. Fortran requires character data to be delineated by apostrophes. MODFLOW does not require apostrophes unless a blank or a comma is part of a character variable. - -As an example of a list, consider the PERIOD block for the GHB Package. The input format is shown below: - -\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/gwf-ghb-period.dat} - -Each line represents a separate item, which consists of variables. In this case, the first variable of the item, \texttt{cellid} is an array of size \texttt{ncelldim}. The next two variables of the item are \texttt{bhead} and \texttt{cond}. Lastly, the item has two optional variables, \texttt{aux} and \texttt{boundname}. Three of the variables shown in the list are colored in blue. Variables that are colored in blue mean that they can be represented with a time series. The time series capability is described in the section on Time-Variable Input in this document. - -The following is simple example of a PERIOD block for the GHB Package, which shows how a list is entered by the user. +In the next example, the ``LAYERED'' keyword is present and binary files are used for each layer. A control line with the ``BINARY'' keyword is required for each layer. \begin{lstlisting}[style=inputfile] -BEGIN PERIOD 1 -# lay row col stage cond - 1 13 1 988.0 0.038 - 1 14 9 1045.0 0.038 -END PERIOD -\end{lstlisting} - -As described earlier in the section on ``Block and Keyword Input,'' block information can be read from a separate text file. To activate reading a list from separate text file, the first and only entry in the block must be a control line of the following form: - -\begin{lstlisting}[style=blockdefinition] - OPEN/CLOSE + STRT LAYERED + OPEN/CLOSE strt.layer1.bin (BINARY) #layer1 + OPEN/CLOSE strt.layer2.bin (BINARY) #layer2 + OPEN/CLOSE strt.layer3.bin (BINARY) #layer3 + OPEN/CLOSE strt.layer4.bin (BINARY) #layer4 \end{lstlisting} -\noindent where \texttt{fname} is the name of the file containing the list. Lists for the stress packages (CHD, WEL, DRN, RIV, GHB, RCH, and EVT) have an additional BINARY option. The BINARY option is not supported for the advanced stress packages (LAK, MAW, SFR, UZF). The BINARY options is specified as follows: +In the next example, the ``LAYERED'' keyword is absent. In this case, a single control line with the ``BINARY'' keyword is required and the binary file will include the entire data array. -\begin{lstlisting}[style=blockdefinition] - OPEN/CLOSE [(BINARY)] +\begin{lstlisting}[style=inputfile] + STRT + OPEN/CLOSE strt.bin (BINARY) #layers1-4 \end{lstlisting} -If the (BINARY) keyword is found on the control line, then the file is opened as an unformatted file on unit 99, and the list is read. There are a number of requirements for using the (BINARY) option for lists. All stress package lists begin with integer values for the \texttt{cellid} (layer, row, and column, for example). These values must be represented as integer numbers in the unformatted file. Also, all auxiliary data must be included in the binary file; auxiliary data must be represented as double precision numbers. Lastly, the (BINARY) option does not support entry of \texttt{boundname}, and so the BOUNDNAMES option should not be activated in the OPTIONS block for the package. \ No newline at end of file +A consequence of the way binary input files have been implemented in \mf, simulated dependent variable binary output (for example, head and concentration) cannot be used as binary array input for a model. Instead, simulated dependent variable binary output must be processed and split into separate binary files for each layer or combined into a single array equal to the size of the grid (for DIS grids this would be an array equal to NCOL * NROW * NLAY). diff --git a/doc/mf6io/framework/binary_array_input.tex b/doc/mf6io/framework/binary_array_input.tex new file mode 100644 index 00000000000..73bfbd38f1d --- /dev/null +++ b/doc/mf6io/framework/binary_array_input.tex @@ -0,0 +1,88 @@ +\subsubsection{Description of Binary Array Input Files} +All floating point variables are written to the binary input files as DOUBLE PRECISION Fortran variables. Integer variables are written to the input files as Fortran integer variables. Some variables are character strings and are indicated as so in the following descriptions. Binary array data are written using the following two records: + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{DATA} \\ + +\vspace{5mm} +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{KSTP} is the time step number; +\item \texttt{KPER} is the stress period number; +\item \texttt{PERTIM} is the time value for the current stress period; +\item \texttt{TOTIM} is the total simulation time; +\item \texttt{TEXT} is a character string (character*16); +\item \texttt{M1} is the length of the data in the fastest varying direction; +\item \texttt{M2} is the length of the data in the second fastest varying direction; +\item \texttt{M3} can be any value but is typically 1 or the layer number for the data; and +\item \texttt{DATA} is the array data of size (M1*M2). +\end{description} + +\noindent The values specified for \texttt{M1}, \texttt{M2}, and \texttt{M3} in Record 1 are dependent on the grid type and if the ``LAYERED'' keyword is present on the READARRAY control line. For binary array data, \texttt{KSTP}, \texttt{KPER}, \texttt{PERTIM}, \texttt{TOTIM}, and \texttt{TEXT} can be set to any value. Binary array input file specifications for each discretization type are given below. + +\paragraph{DIS Grids} +For DIS grids, \texttt{M1=NCOL}, \texttt{M2=NROW}, and \texttt{M3=ILAY} when the ``LAYERED'' keyword is present on the READARRAY control line. For this case, record 1 and 2 should be written as: + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{((DATA(J,I,ILAY),J=1,NCOL),I=1,NROW)} \\ + +\vspace{5mm} +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{NCOL} is the number of columns; +\item \texttt{NROW} is the number of rows; and +\item \texttt{ILAY} is the layer number. +\end{description} + +\noindent For DIS grids, \texttt{M1=NCOL*NROW*NLAY}, \texttt{M2=1}, and \texttt{M3=1} when the ``LAYERED'' keyword is absent on the READARRAY control line. For this case, record 1 and 2 should be written as: + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{(((DATA(J,I,K),J=1,NCOL),I=1,NROW),K=1,NLAY)} \\ + +\vspace{5mm} +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{NLAY} is the number of layers. +\end{description} + +\paragraph{DISV Grids} +For DISV grids, \texttt{M1=NCPL}, \texttt{M2=1}, and \texttt{M3=ILAY} when the ``LAYERED'' keyword is present on the READARRAY control line. For this case, record 1 and 2 should be written as: + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{(DATA(J,ILAY),J=1,NCPL)} \\ + +\vspace{5mm} +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{NCPL} is the number of cells per layer. +\end{description} + +\noindent For DISV grids, \texttt{M1=NCPL*NLAY}, \texttt{M2=1}, and \texttt{M3=1} when the ``LAYERED'' keyword is absent on the READARRAY control line. For this case, record 1 and 2 should be written as: + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{((DATA(J,K),J=1,NCPL),K=1,NLAY)} \\ + + +\paragraph{DISU Grids} +For DISU grids, \texttt{M1=NODES}, \texttt{M2=1}, \texttt{M3=1}. For this case, record 1 and 2 should be written as: + + +\vspace{5mm} +\noindent Record 1: \texttt{KSTP,KPER,PERTIM,TOTIM,TEXT,M1,M2,M3} \\ +\noindent Record 2: \texttt{(DATA(N),N=1,NODES)} \\ + +\vspace{5mm} +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{NODES} is the number cells in the model grid. +\end{description} diff --git a/doc/mf6io/framework/binary_list_input.tex b/doc/mf6io/framework/binary_list_input.tex new file mode 100644 index 00000000000..10ee136062a --- /dev/null +++ b/doc/mf6io/framework/binary_list_input.tex @@ -0,0 +1,18 @@ +\subsubsection{Description of Binary List Input Files} +All floating point variables are written to the binary input files as DOUBLE PRECISION Fortran variables. Integer variables are written to the input files as Fortran integer variables. Auxiliary variables can be included in binary list input files but as indicated previously binary list input files can not be used for packages that include BOUNDNAMES keyword in the OPTIONS block. The format of binary list data are described below. + +\vspace{5mm} +\noindent Record 1: \texttt{(CELLID(N),(RLIST(I,N),I=1,NDAT)(AUXVAR(I,N),I=1, NAUX), N=1,NLIST)}\\ + +\noindent where + +\begin{description} \itemsep0pt \parskip0pt \parsep0pt +\item \texttt{CELLID} is the cell identifier, and depends on the type of grid that is used for the simulation.; +\item \texttt{RLIST} is a double precision two-dimensional array of size (NDAT,NLIST) containing the stress package PERIOD data; +\item \texttt{NDAT} is the number of columns in RLIST, which is the number of columns of real data in the stress package PERIOD data; +\item \texttt{AUXVAR} is a double precision two-dimensional array of size (NAUX,NLIST) containing the auxilary data for the stress package PERIOD data; +\item \texttt{NAUX} is the number of columns in AUXVAR, which is the number of columns of real auxiliary data the in stress package PERIOD data; +\item \texttt{NLIST} is the size of the list; +\end{description} + +\noindent For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. \texttt{NLIST} must be less than or equal to \texttt{MAXBOUND} for a stress package. \texttt{NAUX} is determined by the number of \texttt{AUXILIARY} variable names define in the OPTIONS block for the stress package. diff --git a/doc/mf6io/gwf/binaryoutput.tex b/doc/mf6io/framework/binaryoutput.tex similarity index 99% rename from doc/mf6io/gwf/binaryoutput.tex rename to doc/mf6io/framework/binaryoutput.tex index 985356b87e1..a217180286d 100644 --- a/doc/mf6io/gwf/binaryoutput.tex +++ b/doc/mf6io/framework/binaryoutput.tex @@ -540,7 +540,7 @@ \subsubsection{GWF Model LAK, MAW, SFR, and UZF Packages} \texttt{FW-RATE} & 6 & 1 / \texttt{nmawwells} & calculated flowing well discharge rate from the multi-aquifer well. Only saved if \texttt{FLOWING\_WELLS} is specified in the OPTIONS block. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ \texttt{STORAGE} & 6 & 2 / \texttt{nmawwells} & Calculated flow from storage for multi-aquifer well. Only saved if the \texttt{NO\_WELL\_STORAGE} is not specified in the OPTIONS block. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). The multi-aquifer well volume (\texttt{VOLUME}) is saved as an auxiliary data item for this flow term. \\ \texttt{CONSTANT} & 6 & 1 / \texttt{nmawwells} & Calculated flow to maintain constant head in multi-aquifer well. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ -\texttt{FROM-MVR} & 6 & 1 / \texttt{nmawwells} & Calculated flow to lake from the MVR Package. Only saved if MVR Package is used in the MAW Package. The lake number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ +\texttt{FROM-MVR} & 6 & 1 / \texttt{nmawwells} & Calculated flow to multi-aquifer well from the MVR Package. Only saved if MVR Package is used in the MAW Package. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ \texttt{RATE-TO-MVR} & 6 & 1 / \texttt{nmawwells} & Calculated pumping rate from the multi-aquifer well to the MVR Package. Only saved if MVR Package is used in the MAW Package. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ \texttt{FW-RATE-TO-MVR} & 6 & 1 / \texttt{nmawwells} & Calculated flowing well flow from a multi-aquifer well to the MVR Package. Only saved if MVR Package is used in the MAW Package and the \texttt{FLOWING\_WELLS} is specified in the OPTIONS block. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). \\ \texttt{AUXILIARY} & 6 & \texttt{naux}+1 / \texttt{nmawwells} & Auxiliary variables, if specified in the MAW Package, are saved to this flow term. The first entry of the \texttt{DATA2D} column has a value of zero. The multi-aquifer well number is written to (\texttt{ID1}) and (\texttt{ID2}). diff --git a/doc/mf6io/form_of_input.tex b/doc/mf6io/framework/form_of_input.tex similarity index 100% rename from doc/mf6io/form_of_input.tex rename to doc/mf6io/framework/form_of_input.tex diff --git a/doc/mf6io/framework/list_data.tex b/doc/mf6io/framework/list_data.tex new file mode 100644 index 00000000000..59669b62316 --- /dev/null +++ b/doc/mf6io/framework/list_data.tex @@ -0,0 +1,38 @@ +\subsection{List Input} +Some items consist of several variables, such as layer, row, column, stage, and conductance, for example. List input refers to a block of data with a separate item on each line. For some common list types, the first set of variables is a cell identifier (denoted as \texttt{cellid} in this guide), such as layer, row, and column. With lists, the input data for each item must start on a new line. All variables for an item are assumed to be contained in a single line. Each input variable has a data type, which can be Double Precision, Integer, or Character. Integers are whole numbers and must not include a decimal point or exponent. Double Precision numbers can include a decimal point and an exponent. If no decimal point is included in the entered value, then the decimal point is assumed to be at the right side of the value. Any printable character is allowed for character variables. + +Variables starting with the letters I-N are most commonly integers; however, in some instances, a character string may start with the letters I-N. Variables starting with the letters A-H and O-Z are primarily double precision numbers; however, these variable names may also be used for character data. In \mf all variables are explicitly declared within the source code, as opposed to the implicit type declaration in previous MODFLOW versions. This explicit declaration means that the variable type can be easily determined from the source code. + +Free formatting is used throughout the input instructions. With free format, values are not required to occupy a fixed number of columns in a line. Each value can occupy one or more columns as required to represent the value; however, the values must still be included in the prescribed order. One or more spaces, or a single comma optionally combined with spaces, must separate adjacent values. Also, a numeric value of zero must be explicitly represented with 0 and not by one or more spaces when free format is used, because detecting the difference between a space that represents 0 and a space that represents a value separator is not possible. Free format is similar to Fortran's list directed input. + +Two capabilities included in Fortran's list-directed input are not included in the free-format input implemented in \mf. Null values in which input values are left unchanged from their previous values are not allowed. In general, MODFLOW's input values are not defined prior to their input. A ``/'' cannot be used to terminate an input line without including values for all the variables; data values for all required input variables must be explicitly specified on an input line. For character data, MODFLOW's free format implementation is less stringent than the list-directed input of Fortran. Fortran requires character data to be delineated by apostrophes. MODFLOW does not require apostrophes unless a blank or a comma is part of a character variable. + +As an example of a list, consider the PERIOD block for the GHB Package. The input format is shown below: + +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/gwf-ghb-period.dat} + +Each line represents a separate item, which consists of variables. In this case, the first variable of the item, \texttt{cellid} is an array of size \texttt{ncelldim}. The next two variables of the item are \texttt{bhead} and \texttt{cond}. Lastly, the item has two optional variables, \texttt{aux} and \texttt{boundname}. Three of the variables shown in the list are colored in blue. Variables that are colored in blue mean that they can be represented with a time series. The time series capability is described in the section on Time-Variable Input in this document. + +The following is simple example of a PERIOD block for the GHB Package, which shows how a list is entered by the user. + +\begin{lstlisting}[style=inputfile] +BEGIN PERIOD 1 +# lay row col stage cond + 1 13 1 988.0 0.038 + 1 14 9 1045.0 0.038 +END PERIOD +\end{lstlisting} + +As described earlier in the section on ``Block and Keyword Input,'' block information can be read from a separate text file. To activate reading a list from separate text file, the first and only entry in the block must be a control line of the following form: + +\begin{lstlisting}[style=blockdefinition] + OPEN/CLOSE +\end{lstlisting} + +\noindent where \texttt{fname} is the name of the file containing the list. Lists for the stress packages (CHD, WEL, DRN, RIV, GHB, RCH, and EVT) have an additional BINARY option. The BINARY option is not supported for the advanced stress packages (LAK, MAW, SFR, UZF, LKT, MWT, SFT, UZT). The BINARY options is specified as follows: + +\begin{lstlisting}[style=blockdefinition] + OPEN/CLOSE [(BINARY)] +\end{lstlisting} + +If the (BINARY) keyword is found on the control line, then the file is opened as an unformatted file on unit 99, and the list is read. There are a number of requirements for using the (BINARY) option for lists. All stress package lists begin with integer values for the \texttt{cellid} (layer, row, and column, for example). These values must be represented as integer numbers in the unformatted file. Also, all auxiliary data must be included in the binary file; auxiliary data must be represented as double precision numbers. Lastly, the (BINARY) option does not support entry of \texttt{boundname}, and so the BOUNDNAMES option should not be activated in the OPTIONS block for the package. \ No newline at end of file diff --git a/doc/mf6io/processing_of_input.tex b/doc/mf6io/framework/processing_of_input.tex similarity index 56% rename from doc/mf6io/processing_of_input.tex rename to doc/mf6io/framework/processing_of_input.tex index 3a5766cf204..6af3f1a933b 100644 --- a/doc/mf6io/processing_of_input.tex +++ b/doc/mf6io/framework/processing_of_input.tex @@ -1,43 +1,59 @@ An effort is underway to process program input early in program runtime, before the simulation is created, in a general way that is not dependent on any given component. This capability is called the \mf Input Data Processor (IDP). Components that have been updated to use IDP no longer directly read or process file inputs but instead access input data from internally managed memory locations. -\subsection{Supported components} +\subsection{Supported Components} -A specific set of \mf components has been updated in the current version to use the Input Data Processor, as shown in Table~\ref{table:idmsupported}. Two integration steps have been taken for each file type listed in the table. First, IDP has been updated to support the reading and loading of variable input data for the component. File types listed in the table, each previously read and processed by the component, are now processed by IDP. Second, the component itself has been refactored to retrieve input from managed memory locations in a predictable way. Components and associated file types shown in table~\ref{table:idmsupported} are described in more detail in later sections of this document. +A specific set of \mf components has been updated in the current version to use the IDP routines, as shown in Table~\ref{table:idmsupported}. Two integration steps have been taken for each file type listed in the table. First, IDP has been updated to support the reading and loading of variable input data for the component. File types listed in the table, each previously read and processed by the component, are now processed by IDP. Second, the component itself has been refactored to retrieve input from managed memory locations in a predictable way. Components and associated file types shown in table~\ref{table:idmsupported} are described in more detail in later sections of this document. \begin{table}[H] -\caption{IDP integrated components} +\caption{Components and subcomponents that are read using Input Data Processor (IDP) routines} \small \begin{center} -\begin{tabular*}{\columnwidth}{l l l l} +%\begin{tabular*}{\columnwidth}{l l} +\begin{longtable}{p{6cm} p{4cm}} \hline \hline -\textbf{Component Type} & \textbf{Subcomponent Type} & \textbf{Component} & \textbf{File Type} \\ +\textbf{Component / Subcomponent} & \textbf{File Type} \\ \hline -SIM & NAM & SIM/NAM & mfsim.nam \\ -GWF & NAM & GWF/NAM & GWF name file \\ -GWT & NAM & GWT/NAM & GWT name file \\ -GWF & DIS & GWF/DIS & DIS6 \\ -GWF & DISU & GWF/DISU & DISU6 \\ -GWF & DISV & GWF/DISV & DISV6 \\ -GWF & NPF & GWF/NPF & NPF6 \\ -GWT & DIS & GWT/DIS & DIS6 \\ -GWT & DISU & GWT/DISU & DISU6 \\ -GWT & DISV & GWT/DISV & DISV6 \\ -GWT & DSP & GWT/DSP & DSP6 \\ +SIM/NAM & mfsim.nam \\ +GWF/NAM & GWF name file \\ +GWT/NAM & GWT name file \\ +GWF/CHD & CHD6 \\ +GWF/DIS & DIS6 \\ +GWF/DISU & DISU6 \\ +GWF/DISV & DISV6 \\ +GWF/DRN & DRN6 \\ +GWF/EVT & EVT6 \\ +GWF/EVTA & EVT6 \\ +GWF/GHB & GHB6 \\ +GWF/IC & IC6 \\ +GWF/NPF & NPF6 \\ +GWF/RCH & RCH6 \\ +GWF/RCHA & RCH6 \\ +GWF/RIV & RIV6 \\ +GWF/WEL & WEL6 \\ +GWT/DIS & DIS6 \\ +GWT/DISU & DISU6 \\ +GWT/DISV & DISV6 \\ +GWT/CNC & CNC6 \\ +GWT/DSP & DSP6 \\ +GWT/IC & IC6 \\ +EXG/GWFGWF & GWF6-GWF6 \\ +EXG/GWFGWT & GWF6-GWT6 \\ +EXG/GWTGWT & GWT6-GWT6 \\ \hline -\end{tabular*} +\end{longtable} \label{table:idmsupported} \end{center} \normalsize \end{table} -\subsection{Scope of change} +\subsection{Scope of Change} The Input Data Processor introduces transparent changes that are beyond the scope of this document. Input logging differences, however, are readily apparent when comparing to earlier versions of \mf. These differences are primarily related to timing as input files processed by IDP are read before the simulation has been created. Logging appears in the simulation log (mfsim.lst) in part because simulation models and their associated listing files do not exist at the time when input is read. In addition, input logging reflects only what was read and loaded to memory as further processing and use is deferred to the simulation components that the input is intended for. Summaries of memory managed variables, including input data variables loaded by IDP, are possible to view in the simulation listing files with a Simulation Name File option described later. -\subsection{Example logging blocks} +\subsection{Example of Logging} -Below is example simulation logging (mfsim.lst) for two model package input files read and loaded by the Input Data Processor. The first logging block results from processing a DIS6 input file and the second logging block results from processing an NPF6 input file. Variable names in the blocks are described in later sections of this document. +Below is an example of simulation logging (to the mfsim.lst output file) for two model package input files read and loaded by IDP routines. The first logging block results from processing a DIS6 input file and the second logging block results from processing an NPF6 input file. Variable names in the blocks are described in later sections of this document. \small \begin{lstlisting}[style=modeloutput] diff --git a/doc/mf6io/gwf/bcoptions.tex b/doc/mf6io/gwf/bcoptions.tex index 7f065154d24..939320b22c8 100644 --- a/doc/mf6io/gwf/bcoptions.tex +++ b/doc/mf6io/gwf/bcoptions.tex @@ -40,4 +40,6 @@ \newcommand{\packageperioddescription}{All of the stress package information in the PERIOD block will continue to apply for subsequent stress periods until the end of the simulation, or until another PERIOD block is encountered. When a new PERIOD block is encountered, all of the stresses from the previous block are replaced with the stresses in the new PERIOD block. Note that this behavior is different from the advanced packages (MAW, SFR, LAK, and UZF). To turn off all of the stresses for a stress period, a PERIOD block must be specified with no entries. If a PERIOD block is not specified for the first stress period, then no stresses will be applied until the \texttt{iper} value of the first PERIOD block in the file.} +\newcommand{\packageperioddescriptionarray}[1]{All of the stress package information in the PERIOD block will continue to apply for subsequent stress periods until the end of the simulation, or until another PERIOD block is encountered. When a new PERIOD block is encountered, the array-based input specified by the user will replace the arrays currently in memory. If an array is not specified in the period block, then that array will retain its present values in memory. With the array-based input, the user must specify a {#1} rate of zero in order to turn {#1} off for a stress period. This behavior is different from list-based input in which an empty PERIOD block results in no stresses being applied.} + \newcommand{\advancedpackageperioddescription}[2]{All of the advanced stress package information in the PERIOD block will continue to apply for subsequent stress periods until the end of the simulation, or until another PERIOD block is encountered. When a new PERIOD block is encountered only the {#2} specified in the new period block will be changed. A {#1} not specified in the new period block will continue to behave according to its specification in the previous PERIOD block. Note that this behavior is different from the simple stress packages (CHD, WEL, DRN, RIV, GHB, RCH and EVT), in which any stress not specified in a new PERIOD block will be removed. To turn off all of the advanced stresses for a stress period, a PERIOD block must be specified with settings that deactivate the {#2}. If a PERIOD block is not specified for the first stress period, then no stresses will be applied.} diff --git a/doc/mf6io/gwf/evta.tex b/doc/mf6io/gwf/evta.tex index 48c41bee52b..528d561d459 100644 --- a/doc/mf6io/gwf/evta.tex +++ b/doc/mf6io/gwf/evta.tex @@ -13,7 +13,7 @@ \subsubsection{Structure of Blocks} \vspace{5mm} \noindent \textit{FOR ANY STRESS PERIOD} \lstinputlisting[style=blockdefinition]{./mf6ivar/tex/gwf-evta-period.dat} -\packageperioddescription +\packageperioddescriptionarray{evapotranspiration} \vspace{5mm} \subsubsection{Explanation of Variables} diff --git a/doc/mf6io/gwf/gwf.tex b/doc/mf6io/gwf/gwf.tex index 452122446ef..3e3e77a8c5d 100644 --- a/doc/mf6io/gwf/gwf.tex +++ b/doc/mf6io/gwf/gwf.tex @@ -11,8 +11,6 @@ \subsection{Information for Existing MODFLOW Users} \input{gwf/info_existing_users.tex} -\input{gwf/array_data.tex} - \subsection{Units of Length and Time} The GWF Model formulates the groundwater flow equation without using prescribed length and time units. Any consistent units of length and time can be used when specifying the input data for a simulation. This capability gives a certain amount of freedom to the user, but care must be exercised to avoid mixing units. The program cannot detect the use of inconsistent units. For example, if hydraulic conductivity is entered in units of feet per day and pumpage as cubic meters per second, the program will run, but the results will be meaningless. Other processes generally are expected to work with consistent length and time units; however, other processes could conceivably place restrictions on which units are supported. diff --git a/doc/mf6io/gwf/rcha.tex b/doc/mf6io/gwf/rcha.tex index bfd5f8e3906..3b9180d48e6 100644 --- a/doc/mf6io/gwf/rcha.tex +++ b/doc/mf6io/gwf/rcha.tex @@ -14,7 +14,7 @@ \subsubsection{Structure of Blocks} \vspace{5mm} \noindent \textit{FOR ANY STRESS PERIOD} \lstinputlisting[style=blockdefinition]{./mf6ivar/tex/gwf-rcha-period.dat} -\packageperioddescription +\packageperioddescriptionarray{recharge} \vspace{5mm} \subsubsection{Explanation of Variables} diff --git a/doc/mf6io/mf6ivar/deprecations.py b/doc/mf6io/mf6ivar/deprecations.py new file mode 100644 index 00000000000..52a9e683081 --- /dev/null +++ b/doc/mf6io/mf6ivar/deprecations.py @@ -0,0 +1,52 @@ +import os +from typing import List, Tuple, Optional +from packaging.version import Version +from pathlib import Path + + +def get_deprecations(dfndir) -> List[Tuple[Path, str, Version, Optional[Version]]]: + dfns = Path(dfndir).rglob("*.dfn") + deps = {} + for dfn in dfns: + with open(dfn, "r") as f: + name = None + for line in f: + if line.startswith("#"): + continue + keys = ["deprecated", "removed"] + ikeys = {k: i for i, k in enumerate(keys)} + for key in keys: + if line.startswith("name"): + name = line.split()[1] + if line.startswith(key): + val = deps.get((dfn, key), [None, None]) + key, ver = line.split() + ik = ikeys[key] + val[ik] = val[ik] if val[ik] else Version(ver) + deps[(dfn, name)] = val + + return [(file, key, dep, rem) for (file, key), (dep, rem) in deps.items()] + + +def create_deprecations_file(dfndir, mddir, verbose): + deprecations = get_deprecations(dfndir) + deps_path = (Path(mddir) / 'deprecations.md').absolute() + if verbose: + print(f"Found {len(deprecations)} deprecations, writing {deps_path}") + with open(deps_path, "w") as f: + s = "#### Deprecations\n\n" + s += "The following table lists deprecated options and the versions in which they were deprecated and (optionally) removed.\n\n" + if any(deprecations): + s += "| Model-Package | Option | Deprecated | Removed |\n" + s += "|:--------------|:-------|:-----------|:--------|\n" + for (file, option, deprecated, removed) in deprecations: + s += f"| {file.stem} | {option} | {deprecated} | {removed if removed else ''} |\n" + if len(s) > 0: + s += "\n" + f.write(s) + + +if __name__ == '__main__': + dfndir = os.path.join('.', 'dfn') + mddir = os.path.join('.', 'md') + create_deprecations_file(dfndir, mddir, verbose=True) diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn index 66ce83bced2..2232bfbdf90 100644 --- a/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn +++ b/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn @@ -26,6 +26,7 @@ reader urword optional true longname keyword to print input to list file description keyword to indicate that the list of exchange entries will be echoed to the listing file immediately after it is read. +mf6internal iprpak block options name print_flows @@ -34,6 +35,7 @@ reader urword optional true longname keyword to print gwfgwf flows to list file description keyword to indicate that the list of exchange flow rates will be printed to the listing file for every stress period in which ``SAVE BUDGET'' is specified in Output Control. +mf6internal iprflow block options name save_flows @@ -42,6 +44,7 @@ reader urword optional true longname keyword to save GWFGWF flows description keyword to indicate that cell-by-cell flow terms will be written to the budget file for each model provided that the Output Control for the models are set up with the ``BUDGET SAVE FILE'' option. +mf6internal ipakcb block options name cell_averaging @@ -207,6 +210,7 @@ reader urword optional true longname activate interface model on exchange description activates the interface model mechanism for calculating the coefficients at (and possibly near) the exchange. This keyword should only be used for development purposes. +mf6internal dev_ifmod_on # --------------------- exg gwfgwf dimensions --------------------- @@ -224,6 +228,7 @@ description keyword and integer value specifying the number of GWF-GWF exchanges block exchangedata name exchangedata type recarray cellidm1 cellidm2 ihc cl1 cl2 hwva aux boundname +shape (nexg) reader urword optional false longname exchange data diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn index f7956f73687..f5aeb241996 100644 --- a/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn +++ b/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn @@ -42,6 +42,7 @@ reader urword optional true longname keyword to print input to list file description keyword to indicate that the list of exchange entries will be echoed to the listing file immediately after it is read. +mf6internal iprpak block options name print_flows @@ -50,6 +51,7 @@ reader urword optional true longname keyword to print gwfgwf flows to list file description keyword to indicate that the list of exchange flow rates will be printed to the listing file for every stress period in which ``SAVE BUDGET'' is specified in Output Control. +mf6internal iprflow block options name save_flows @@ -58,6 +60,7 @@ reader urword optional true longname keyword to save GWFGWF flows description keyword to indicate that cell-by-cell flow terms will be written to the budget file for each model provided that the Output Control for the models are set up with the ``BUDGET SAVE FILE'' option. +mf6internal ipakcb block options name adv_scheme @@ -168,6 +171,7 @@ reader urword optional true longname activate interface model on exchange description activates the interface model mechanism for calculating the coefficients at (and possibly near) the exchange. This keyword should only be used for development purposes. +mf6internal dev_ifmod_on # --------------------- exg gwtgwt dimensions --------------------- @@ -185,6 +189,7 @@ description keyword and integer value specifying the number of GWT-GWT exchanges block exchangedata name exchangedata type recarray cellidm1 cellidm2 ihc cl1 cl2 hwva aux boundname +shape (nexg) reader urword optional false longname exchange data diff --git a/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn b/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn index 543433c1b3c..56e3ca306a9 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn @@ -1,5 +1,6 @@ # --------------------- gwf chd options --------------------- # flopy multi-package +# package-type stress-package block options name auxiliary @@ -35,6 +36,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'constant-head'} +mf6internal iprpak block options name print_flows @@ -43,6 +45,7 @@ reader urword optional true longname print CHD flows to listing file description REPLACE print_flows {'{#1}': 'constant-head'} +mf6internal iprflow block options name save_flows @@ -51,6 +54,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'constant-head'} +mf6internal ipakcb block options name ts_filerecord @@ -127,6 +131,15 @@ optional false longname obs6 input filename description REPLACE obs6_filename {'{#1}': 'constant-head'} +# dev options +block options +name dev_no_newton +type keyword +reader urword +optional true +longname turn off Newton for unconfined cells +description turn off Newton for unconfined cells +mf6internal inewton # --------------------- gwf chd dimensions --------------------- @@ -161,6 +174,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -194,6 +208,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'constant head'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-disu.dfn b/doc/mf6io/mf6ivar/dfn/gwf-disu.dfn index 8c131363e2f..48e18477c1c 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-disu.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-disu.dfn @@ -176,7 +176,7 @@ name vertices type recarray iv xv yv shape (nvert) reader urword -optional false +optional true longname vertices data description @@ -219,7 +219,7 @@ name cell2d type recarray icell2d xc yc ncvert icvert shape (nodes) reader urword -optional false +optional true longname cell2d data description diff --git a/doc/mf6io/mf6ivar/dfn/gwf-drn.dfn b/doc/mf6io/mf6ivar/dfn/gwf-drn.dfn index c03a1078000..e88cc6f43c9 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-drn.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-drn.dfn @@ -1,5 +1,6 @@ # --------------------- gwf drn options --------------------- # flopy multi-package +# package-type stress-package block options name auxiliary @@ -44,6 +45,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'drain'} +mf6internal iprpak block options name print_flows @@ -52,6 +54,7 @@ reader urword optional true longname print calculated flows to listing file description REPLACE print_flows {'{#1}': 'drain'} +mf6internal iprflow block options name save_flows @@ -60,6 +63,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'drain'} +mf6internal ipakcb block options name ts_filerecord @@ -145,6 +149,16 @@ optional true longname description REPLACE mover {'{#1}': 'Drain'} +# dev options +block options +name dev_cubic_scaling +type keyword +reader urword +optional true +longname cubic-scaling +description cubic-scaling is used to scale the drain conductance +mf6internal icubicsfac + # --------------------- gwf drn dimensions --------------------- block dimensions @@ -178,6 +192,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -222,6 +237,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'drain'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-evt.dfn b/doc/mf6io/mf6ivar/dfn/gwf-evt.dfn index b66f62301c8..33f5a971611 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-evt.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-evt.dfn @@ -1,5 +1,6 @@ # --------------------- gwf evt options --------------------- # flopy multi-package +# package-type stress-package block options name fixed_cell @@ -44,6 +45,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'evapotranspiration'} +mf6internal iprpak block options name print_flows @@ -52,6 +54,7 @@ reader urword optional true longname print evapotranspiration rates to listing file description REPLACE print_flows {'{#1}': 'evapotranspiration'} +mf6internal iprflow block options name save_flows @@ -60,6 +63,7 @@ reader urword optional true longname save evapotranspiration rates to budget file description REPLACE save_flows {'{#1}': 'evapotranspiration'} +mf6internal ipakcb block options name ts_filerecord @@ -143,6 +147,7 @@ reader urword optional true longname specify proportion of evapotranspiration rate at ET surface description indicates that the proportion of the evapotranspiration rate at the ET surface will be specified as PETM0 in list input. +mf6internal surfratespec # --------------------- gwf evt dimensions --------------------- @@ -184,6 +189,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -235,6 +241,7 @@ shape (nseg-1) tagged false in_record true reader urword +optional true time_series true longname proportion of ET extinction depth description is the proportion of the ET extinction depth at the bottom of a segment (dimensionless). pxdp is an array of size (nseg - 1). Values in pxdp must be greater than 0.0 and less than 1.0. pxdp values for a cell must increase monotonically. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. @@ -246,6 +253,7 @@ shape (nseg-1) tagged false in_record true reader urword +optional true time_series true longname proportion of maximum ET rate description is the proportion of the maximum ET flux rate at the bottom of a segment (dimensionless). petm is an array of size (nseg - 1). If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. @@ -273,6 +281,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'evapotranspiration'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-evta.dfn b/doc/mf6io/mf6ivar/dfn/gwf-evta.dfn index 19ca3cec45a..2dc966cb436 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-evta.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-evta.dfn @@ -1,5 +1,6 @@ # --------------------- gwf evta options --------------------- # flopy multi-package +# package-type stress-package block options name readasarrays @@ -45,6 +46,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'evapotranspiration'} +mf6internal iprpak block options name print_flows @@ -53,6 +55,7 @@ reader urword optional true longname print evapotranspiration rates to listing file description REPLACE print_flows {'{#1}': 'evapotranspiration'} +mf6internal iprflow block options name save_flows @@ -61,6 +64,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'evapotranspiration'} +mf6internal ipakcb block options name tas_filerecord @@ -177,6 +181,7 @@ name rate type double precision shape (ncol*nrow; ncpl) reader readarray +time_series true longname evapotranspiration surface description is the maximum ET flux rate ($LT^{-1}$). default_value 1.e-3 @@ -191,9 +196,11 @@ description is the ET extinction depth ($L$). default_value 1.0 block period -name aux(iaux) +name aux type double precision shape (ncol*nrow; ncpl) reader readarray +time_series true longname auxiliary variable iaux description is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array. +mf6internal auxvar diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghb.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghb.dfn index f84a3708692..c97c78804b3 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-ghb.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghb.dfn @@ -1,5 +1,6 @@ # --------------------- gwf ghb options --------------------- # flopy multi-package +# package-type stress-package block options name auxiliary @@ -35,6 +36,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'general-head boundary'} +mf6internal iprpak block options name print_flows @@ -43,6 +45,7 @@ reader urword optional true longname print calculated flows to listing file description REPLACE print_flows {'{#1}': 'general-head boundary'} +mf6internal iprflow block options name save_flows @@ -51,6 +54,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'general-head boundary'} +mf6internal ipakcb block options name ts_filerecord @@ -169,6 +173,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -213,6 +218,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'general-head boundary'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-lak.dfn b/doc/mf6io/mf6ivar/dfn/gwf-lak.dfn index 36a67c16dca..3dc9e940c0b 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-lak.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-lak.dfn @@ -1,5 +1,6 @@ # --------------------- gwf lak options --------------------- # flopy multi-package +# package-type advanced-stress-package block options name auxiliary @@ -349,21 +350,21 @@ description value specifying the number of lakes tables that will be used to def block packagedata name packagedata -type recarray lakeno strt nlakeconn aux boundname +type recarray ifno strt nlakeconn aux boundname shape (maxbound) reader urword longname description block packagedata -name lakeno +name ifno type integer shape tagged false in_record true reader urword longname lake number for this entry -description integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. +description integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. numeric_index true block packagedata @@ -384,7 +385,7 @@ tagged false in_record true reader urword longname number of lake connections -description integer value that defines the number of GWF cells connected to this (LAKENO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. +description integer value that defines the number of GWF cells connected to this (IFNO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. block packagedata name aux @@ -414,21 +415,21 @@ description REPLACE boundname {'{#1}': 'lake'} block connectiondata name connectiondata -type recarray lakeno iconn cellid claktype bedleak belev telev connlen connwidth +type recarray ifno iconn cellid claktype bedleak belev telev connlen connwidth shape (sum(nlakeconn)) reader urword longname description block connectiondata -name lakeno +name ifno type integer shape tagged false in_record true reader urword longname lake number for this entry -description integer value that defines the lake number associated with the specified CONNECTIONDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. +description integer value that defines the feature (lake) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. numeric_index true block connectiondata @@ -439,7 +440,7 @@ tagged false in_record true reader urword longname connection number for this entry -description integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake LAKENO. +description integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake IFNO. numeric_index true block connectiondata @@ -470,7 +471,7 @@ tagged false in_record true reader urword longname bed leakance -description character string or real value that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero or specified to be NONE. If BEDLEAK is specified to be NONE, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. +description real value or character string that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero, equal to the DNODATA value (3.0E+30), or specified to be NONE. If DNODATA or NONE is specified for BEDLEAK, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. Warning messages will be issued if NONE is specified. Eventually the ability to specify NONE will be deprecated and cause MODFLOW 6 to terminate with an error. block connectiondata name belev @@ -517,21 +518,21 @@ description real value that defines the connection face width for a HORIZONTAL l block tables name tables -type recarray lakeno tab6 filein tab6_filename +type recarray ifno tab6 filein tab6_filename shape (ntables) reader urword longname description block tables -name lakeno +name ifno type integer shape tagged false in_record true reader urword longname lake number for this entry -description integer value that defines the lake number associated with the specified TABLES data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. +description integer value that defines the feature (lake) number associated with the specified TABLES data on the line. IFNO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. numeric_index true block tables @@ -796,7 +797,7 @@ in_record true reader urword time_series true longname extraction rate -description real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to active (IBOUND $>$ 0) lakes. A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero. +description real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to outlets associated with active lakes (STATUS is ACTIVE). A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero. block period name invert diff --git a/doc/mf6io/mf6ivar/dfn/gwf-maw.dfn b/doc/mf6io/mf6ivar/dfn/gwf-maw.dfn index bf64974c4a0..2e957ec2c82 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-maw.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-maw.dfn @@ -1,5 +1,6 @@ # --------------------- gwf maw options --------------------- # flopy multi-package +# package-type advanced-stress-package block options name auxiliary @@ -334,21 +335,21 @@ description integer value specifying the number of multi-aquifer wells that will block packagedata name packagedata -type recarray wellno radius bottom strt condeqn ngwfnodes aux boundname +type recarray ifno radius bottom strt condeqn ngwfnodes aux boundname shape (nmawwells) reader urword longname description block packagedata -name wellno +name ifno type integer shape tagged false in_record true reader urword longname well number for this entry -description integer value that defines the well number associated with the specified PACKAGEDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. +description integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. numeric_index true block packagedata @@ -399,7 +400,7 @@ tagged false in_record true reader urword longname number of connected GWF cells -description integer value that defines the number of GWF nodes connected to this (WELLNO) multi-aquifer well. NGWFNODES must be greater than zero. +description integer value that defines the number of GWF nodes connected to this (IFNO) multi-aquifer well. NGWFNODES must be greater than zero. block packagedata name aux @@ -429,20 +430,20 @@ description REPLACE boundname {'{#1}': 'multi-aquifer well'} block connectiondata name connectiondata -type recarray wellno icon cellid scrn_top scrn_bot hk_skin radius_skin +type recarray ifno icon cellid scrn_top scrn_bot hk_skin radius_skin reader urword longname description block connectiondata -name wellno +name ifno type integer shape tagged false in_record true reader urword longname well number for this entry -description integer value that defines the well number associated with the specified CONNECTIONDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. +description integer value that defines the feature (well) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. numeric_index true block connectiondata @@ -453,7 +454,7 @@ tagged false in_record true reader urword longname connection number -description integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well WELLNO. +description integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well IFNO. numeric_index true block connectiondata @@ -484,7 +485,7 @@ tagged false in_record true reader urword longname screen bottom -description value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. +description value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value and is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. block connectiondata name hk_skin @@ -524,21 +525,21 @@ description REPLACE iper {} block period name perioddata -type recarray wellno mawsetting +type recarray ifno mawsetting shape reader urword longname description block period -name wellno +name ifno type integer shape tagged false in_record true reader urword longname well number for this entry -description integer value that defines the well number associated with the specified PERIOD data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. +description integer value that defines the well number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. numeric_index true block period @@ -619,7 +620,7 @@ in_record true reader urword time_series true longname well pumping rate -description is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (IBOUND $>$ 0) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero. +description is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (STATUS is ACTIVE) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero. block period name well_head diff --git a/doc/mf6io/mf6ivar/dfn/gwf-rch.dfn b/doc/mf6io/mf6ivar/dfn/gwf-rch.dfn index 0a36ae078be..da53c849863 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-rch.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-rch.dfn @@ -1,5 +1,6 @@ # --------------------- gwf rch options --------------------- # flopy multi-package +# package-type stress-package block options name fixed_cell @@ -44,6 +45,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'recharge'} +mf6internal iprpak block options name print_flows @@ -52,6 +54,7 @@ reader urword optional true longname print recharge rates to listing file description REPLACE print_flows {'{#1}': 'recharge'} +mf6internal iprflow block options name save_flows @@ -60,6 +63,7 @@ reader urword optional true longname save recharge to budget file description REPLACE save_flows {'{#1}': 'recharge'} +mf6internal ipakcb block options name ts_filerecord @@ -169,6 +173,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -202,6 +207,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'recharge'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-rcha.dfn b/doc/mf6io/mf6ivar/dfn/gwf-rcha.dfn index bc5874ef599..a0fb9ec0f60 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-rcha.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-rcha.dfn @@ -1,5 +1,6 @@ # --------------------- gwf rcha options --------------------- # flopy multi-package +# package-type stress-package block options name readasarrays @@ -45,6 +46,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'recharge'} +mf6internal iprpak block options name print_flows @@ -53,6 +55,7 @@ reader urword optional true longname print recharge rates to listing file description REPLACE print_flows {'{#1}': 'recharge'} +mf6internal iprflow block options name save_flows @@ -61,6 +64,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'recharge'} +mf6internal ipakcb block options name tas_filerecord @@ -103,7 +107,7 @@ reader urword optional false tagged false longname file name of time series information -description defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the Time-Variable Input section for instructions on using the time-array series capability. +description defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-array series capability. block options name obs_filerecord @@ -168,6 +172,7 @@ name recharge type double precision shape (ncol*nrow; ncpl) reader readarray +time_series true longname recharge rate description is the recharge flux rate ($LT^{-1}$). This rate is multiplied inside the program by the surface area of the cell to calculate the volumetric recharge rate. The recharge array may be defined by a time-array series (see the "Using Time-Array Series in a Package" section). default_value 1.e-3 @@ -177,6 +182,8 @@ name aux type double precision shape (ncol*nrow; ncpl) reader readarray +time_series true optional true longname auxiliary variable iaux description is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array. +mf6internal auxvar diff --git a/doc/mf6io/mf6ivar/dfn/gwf-riv.dfn b/doc/mf6io/mf6ivar/dfn/gwf-riv.dfn index a57b653cc0c..fca586f17eb 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-riv.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-riv.dfn @@ -1,5 +1,6 @@ # --------------------- gwf riv options --------------------- # flopy multi-package +# package-type stress-package block options name auxiliary @@ -35,6 +36,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'river'} +mf6internal iprpak block options name print_flows @@ -43,6 +45,7 @@ reader urword optional true longname print calculated flows to listing file description REPLACE print_flows {'{#1}': 'river'} +mf6internal iprflow block options name save_flows @@ -51,6 +54,7 @@ reader urword optional true longname save CHD flows to budget file description REPLACE save_flows {'{#1}': 'river'} +mf6internal ipakcb block options name ts_filerecord @@ -169,6 +173,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -224,6 +229,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'river'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwf-sfr.dfn b/doc/mf6io/mf6ivar/dfn/gwf-sfr.dfn index 5a23b919e45..24da890760e 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-sfr.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-sfr.dfn @@ -1,5 +1,6 @@ # --------------------- gwf sfr options --------------------- # flopy multi-package +# package-type advanced-stress-package block options name auxiliary @@ -342,21 +343,21 @@ description integer value specifying the number of stream reaches. There must b block packagedata name packagedata -type recarray rno cellid rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv aux boundname +type recarray ifno cellid rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv aux boundname shape (maxbound) reader urword longname description block packagedata -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. +description integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. numeric_index true block packagedata @@ -367,7 +368,7 @@ tagged false in_record true reader urword longname cell identifier -description The keyword `NONE' must be specified for reaches that are not connected to an underlying GWF cell. The keyword `NONE' is used for reaches that are in cells that have IDOMAIN values less than one or are in areas not covered by the GWF model grid. Reach-aquifer flow is not calculated if the keyword `NONE' is specified. +description is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. For reaches that are not connected to an underlying GWF cell, a zero should be specified for each grid dimension. For example, for a DIS grid a CELLID of 0 0 0 should be specified. Reach-aquifer flow is not calculated for unconnected reaches. The keyword NONE can be still be specified to identify unconnected reaches for backward compatibility with previous versions of MODFLOW 6 but eventually NONE will be deprecated and will cause MODFLOW 6 to terminate with an error. block packagedata name rlen @@ -417,7 +418,7 @@ tagged false in_record true reader urword longname streambed thickness -description real value that defines the thickness of the reach streambed. RBTH can be any value if CELLID is `NONE'. Otherwise, RBTH must be greater than zero. +description real value that defines the thickness of the reach streambed. RBTH can be any value if the reach is not connected to an underlying GWF cell. Otherwise, RBTH must be greater than zero. block packagedata name rhk @@ -427,7 +428,7 @@ tagged false in_record true reader urword longname -description real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if CELLID is `NONE'. Otherwise, RHK must be greater than zero. +description real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if the reach is not connected to an underlying GWF cell. Otherwise, RHK must be greater than zero. block packagedata name man @@ -448,7 +449,7 @@ tagged false in_record true reader urword longname number of connected reaches -description integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for RNO is still required in the subsequent CONNECTIONDATA block. +description integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for IFNO is still required in the subsequent CONNECTIONDATA block. block packagedata name ustrf @@ -498,7 +499,7 @@ description REPLACE boundname {'{#1}': 'stream reach'} block crosssections name crosssections -type recarray rno tab6 filein tab6_filename +type recarray ifno tab6 filein tab6_filename shape valid optional false @@ -507,14 +508,14 @@ longname description block crosssections -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified cross-section table file on the line. RNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. +description integer value that defines the feature (reach) number associated with the specified cross-section table file on the line. IFNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. numeric_index true block crosssections @@ -554,27 +555,27 @@ description character string that defines the path and filename for the file con block connectiondata name connectiondata -type recarray rno ic +type recarray ifno ic shape (maxbound) reader urword longname description block connectiondata -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified CONNECTIONDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. +description integer value that defines the feature (reach) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. numeric_index true block connectiondata name ic type integer -shape (ncon(rno)) +shape (ncon(ifno)) tagged false in_record true reader urword @@ -590,21 +591,21 @@ support_negative_index true block diversions name diversions -type recarray rno idv iconr cprior +type recarray ifno idv iconr cprior shape (maxbound) reader urword longname description block diversions -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified DIVERSIONS data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. +description integer value that defines the feature (reach) number associated with the specified DIVERSIONS data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. numeric_index true block diversions @@ -615,7 +616,7 @@ tagged false in_record true reader urword longname downstream diversion number -description integer value that defines the downstream diversion number for the diversion for reach RNO. IDV must be greater than zero and less than or equal to NDV for reach RNO. +description integer value that defines the downstream diversion number for the diversion for reach IFNO. IDV must be greater than zero and less than or equal to NDV for reach IFNO. numeric_index true block diversions @@ -626,7 +627,7 @@ tagged false in_record true reader urword longname downstream reach number for diversion -description integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach RNO. +description integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach IFNO. numeric_index true block diversions @@ -637,7 +638,7 @@ tagged false in_record true reader urword longname iprior code -description character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach RNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach RNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach RNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach RNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach RNO. If $Q_{DS}$ in reach RNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach RNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach RNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach RNO. +description character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach IFNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach IFNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach IFNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach IFNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach IFNO. If $Q_{DS}$ in reach IFNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach IFNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach IFNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach IFNO. # --------------------- gwf sfr period --------------------- @@ -657,21 +658,21 @@ description REPLACE iper {} block period name perioddata -type recarray rno sfrsetting +type recarray ifno sfrsetting shape reader urword longname description block period -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. +description integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. numeric_index true block period @@ -787,7 +788,7 @@ tagged false in_record true reader urword longname diversion number -description an integer value specifying which diversion of reach RNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (RNO). +description an integer value specifying which diversion of reach IFNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (IFNO). numeric_index true block period diff --git a/doc/mf6io/mf6ivar/dfn/gwf-uzf.dfn b/doc/mf6io/mf6ivar/dfn/gwf-uzf.dfn index 02833c08967..fdf5078eba5 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-uzf.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-uzf.dfn @@ -1,5 +1,6 @@ # --------------------- gwf uzf options --------------------- # flopy multi-package +# package-type advanced-stress-package block options name auxiliary @@ -365,21 +366,21 @@ default_value 40 block packagedata name packagedata -type recarray iuzno cellid landflag ivertcon surfdep vks thtr thts thti eps boundname +type recarray ifno cellid landflag ivertcon surfdep vks thtr thts thti eps boundname shape (nuzfcells) reader urword longname description block packagedata -name iuzno +name ifno type integer shape tagged false in_record true reader urword longname uzf id number for this entry -description integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. IUZNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. +description integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. numeric_index true block packagedata @@ -502,21 +503,21 @@ description REPLACE iper {} block period name perioddata -type recarray iuzno finf pet extdp extwc ha hroot rootact aux +type recarray ifno finf pet extdp extwc ha hroot rootact aux shape reader urword longname description block period -name iuzno +name ifno type integer shape tagged false in_record true reader urword longname UZF id number -description integer value that defines the UZF cell number associated with the specified PERIOD data on the line. +description integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. numeric_index true block period diff --git a/doc/mf6io/mf6ivar/dfn/gwf-wel.dfn b/doc/mf6io/mf6ivar/dfn/gwf-wel.dfn index 4f7710ac5dd..c7de3e7e96f 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-wel.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-wel.dfn @@ -1,5 +1,6 @@ # --------------------- gwf wel options --------------------- # flopy multi-package +# package-type stress-package block options name auxiliary @@ -35,6 +36,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'well'} +mf6internal iprpak block options name print_flows @@ -43,6 +45,7 @@ reader urword optional true longname print calculated flows to listing file description REPLACE print_flows {'{#1}': 'well'} +mf6internal iprflow block options name save_flows @@ -51,6 +54,7 @@ reader urword optional true longname save well flows to budget file description REPLACE save_flows {'{#1}': 'well'} +mf6internal ipakcb block options name auto_flow_reduce @@ -59,6 +63,7 @@ reader urword optional true longname cell fractional thickness for reduced pumping description keyword and real value that defines the fraction of the cell thickness used as an interval for smoothly adjusting negative pumping rates to 0 in cells with head values less than or equal to the bottom of the cell. Negative pumping rates are adjusted to 0 or a smaller negative value when the head in the cell is equal to or less than the calculated interval above the cell bottom. AUTO\_FLOW\_REDUCE is set to 0.1 if the specified value is less than or equal to zero. By default, negative pumping rates are not reduced during a simulation. +mf6internal flowred block options name afrcsv_filerecord @@ -69,6 +74,7 @@ tagged true optional true longname description +mf6internal afrcsv_rec block options name auto_flow_reduce_csv @@ -80,6 +86,7 @@ tagged true optional false longname budget keyword description keyword to specify that record corresponds to the AUTO\_FLOW\_REDUCE output option in which a new record is written for each well and for each time step in which the user-requested extraction rate is reduced by the program. +mf6internal afrcsv block options name fileout @@ -221,6 +228,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -254,6 +262,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'well'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwt-cnc.dfn b/doc/mf6io/mf6ivar/dfn/gwt-cnc.dfn index e3ef02bce6c..3a75ccb4cf7 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-cnc.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-cnc.dfn @@ -1,4 +1,5 @@ # --------------------- gwt cnc options --------------------- +# flopy multi-package block options name auxiliary @@ -34,6 +35,7 @@ reader urword optional true longname print input to listing file description REPLACE print_input {'{#1}': 'constant concentration'} +mf6internal iprflow block options name print_flows @@ -42,6 +44,7 @@ reader urword optional true longname print calculated flows to listing file description REPLACE print_flows {'{#1}': 'constant concentration'} +mf6internal ipakcb block options name save_flows @@ -50,6 +53,7 @@ reader urword optional true longname save constant concentration flows to budget file description REPLACE save_flows {'{#1}': 'constant concentration'} +mf6internal iprpak block options name ts_filerecord @@ -160,6 +164,7 @@ shape (maxbound) reader urword longname description +mf6internal spd block period name cellid @@ -181,6 +186,7 @@ reader urword time_series true longname constant concentration value description is the constant concentration value. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. +mf6internal tspvar block period name aux @@ -193,6 +199,7 @@ optional true time_series true longname auxiliary variables description REPLACE aux {'{#1}': 'constant concentration'} +mf6internal auxvar block period name boundname diff --git a/doc/mf6io/mf6ivar/dfn/gwt-disu.dfn b/doc/mf6io/mf6ivar/dfn/gwt-disu.dfn index 09043e92ca5..00ffe21ad09 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-disu.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-disu.dfn @@ -176,7 +176,7 @@ name vertices type recarray iv xv yv shape (nvert) reader urword -optional false +optional true longname vertices data description @@ -219,7 +219,7 @@ name cell2d type recarray icell2d xc yc ncvert icvert shape (nodes) reader urword -optional false +optional true longname cell2d data description diff --git a/doc/mf6io/mf6ivar/dfn/gwt-lkt.dfn b/doc/mf6io/mf6ivar/dfn/gwt-lkt.dfn index 44fb4422ca6..6dbca6ffb12 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-lkt.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-lkt.dfn @@ -259,21 +259,21 @@ description REPLACE obs6_filename {'{#1}': 'LKT'} block packagedata name packagedata -type recarray lakeno strt aux boundname +type recarray ifno strt aux boundname shape (maxbound) reader urword longname description block packagedata -name lakeno +name ifno type integer shape tagged false in_record true reader urword longname lake number for this entry -description integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. +description integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. numeric_index true block packagedata @@ -327,21 +327,21 @@ description REPLACE iper {} block period name lakeperioddata -type recarray lakeno laksetting +type recarray ifno laksetting shape reader urword longname description block period -name lakeno +name ifno type integer shape tagged false in_record true reader urword longname lake number for this entry -description integer value that defines the lake number associated with the specified PERIOD data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. +description integer value that defines the feature (lake) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NLAKES. numeric_index true block period @@ -352,7 +352,7 @@ tagged false in_record true reader urword longname -description line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. +description line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, EXT-INFLOW, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. block period name status diff --git a/doc/mf6io/mf6ivar/dfn/gwt-mwt.dfn b/doc/mf6io/mf6ivar/dfn/gwt-mwt.dfn index 67529c4b8a9..b2b43467858 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-mwt.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-mwt.dfn @@ -259,21 +259,21 @@ description REPLACE obs6_filename {'{#1}': 'MWT'} block packagedata name packagedata -type recarray mawno strt aux boundname +type recarray ifno strt aux boundname shape (maxbound) reader urword longname description block packagedata -name mawno +name ifno type integer shape tagged false in_record true reader urword longname well number for this entry -description integer value that defines the well number associated with the specified PACKAGEDATA data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. +description integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. numeric_index true block packagedata @@ -327,21 +327,21 @@ description REPLACE iper {} block period name mwtperioddata -type recarray mawno mwtsetting +type recarray ifno mwtsetting shape reader urword longname description block period -name mawno +name ifno type integer shape tagged false in_record true reader urword longname well number for this entry -description integer value that defines the well number associated with the specified PERIOD data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. +description integer value that defines the feature (well) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. numeric_index true block period @@ -352,7 +352,7 @@ tagged false in_record true reader urword longname -description line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. +description line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RATE, and AUXILIARY. These settings are used to assign the concentration associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. block period name status diff --git a/doc/mf6io/mf6ivar/dfn/gwt-sft.dfn b/doc/mf6io/mf6ivar/dfn/gwt-sft.dfn index dc98b6a2bed..5323f4c7c5e 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-sft.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-sft.dfn @@ -259,21 +259,21 @@ description REPLACE obs6_filename {'{#1}': 'SFT'} block packagedata name packagedata -type recarray rno strt aux boundname +type recarray ifno strt aux boundname shape (maxbound) reader urword longname description block packagedata -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. +description integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. numeric_index true block packagedata @@ -327,21 +327,21 @@ description REPLACE iper {} block period name reachperioddata -type recarray rno reachsetting +type recarray ifno reachsetting shape reader urword longname description block period -name rno +name ifno type integer shape tagged false in_record true reader urword longname reach number for this entry -description integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. +description integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. numeric_index true block period diff --git a/doc/mf6io/mf6ivar/dfn/gwt-uzt.dfn b/doc/mf6io/mf6ivar/dfn/gwt-uzt.dfn index d95baabe6e4..00524848bdd 100644 --- a/doc/mf6io/mf6ivar/dfn/gwt-uzt.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwt-uzt.dfn @@ -259,21 +259,21 @@ description REPLACE obs6_filename {'{#1}': 'UZT'} block packagedata name packagedata -type recarray uzfno strt aux boundname +type recarray ifno strt aux boundname shape (maxbound) reader urword longname description block packagedata -name uzfno +name ifno type integer shape tagged false in_record true reader urword longname UZF cell number for this entry -description integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. +description integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. numeric_index true block packagedata @@ -327,21 +327,21 @@ description REPLACE iper {} block period name uztperioddata -type recarray uzfno uztsetting +type recarray ifno uztsetting shape reader urword longname description block period -name uzfno +name ifno type integer shape tagged false in_record true reader urword longname unsaturated zone flow cell number for this entry -description integer value that defines the UZF cell number associated with the specified PERIOD data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. +description integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. numeric_index true block period diff --git a/doc/mf6io/mf6ivar/dfn/utl-spc.dfn b/doc/mf6io/mf6ivar/dfn/utl-spc.dfn index 5ca5bd0ae00..6fabd0c0f6a 100644 --- a/doc/mf6io/mf6ivar/dfn/utl-spc.dfn +++ b/doc/mf6io/mf6ivar/dfn/utl-spc.dfn @@ -104,7 +104,7 @@ tagged false in_record true reader urword longname -description line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: CONCENTRATION. +description line of information that is parsed into a keyword and values. Keyword values that can be used to start the SPCSETTING string include: CONCENTRATION. block period name concentration diff --git a/doc/mf6io/mf6ivar/examples/gwf-lak-example.dat b/doc/mf6io/mf6ivar/examples/gwf-lak-example.dat index 9e3250aa2c2..b422457ba66 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-lak-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-lak-example.dat @@ -13,69 +13,69 @@ BEGIN DIMENSIONS END DIMENSIONS BEGIN PACKAGEDATA -# lakeno strt lakeconn boundname - 1 110.00 57 LAKE_1 +# ifno strt lakeconn boundname + 1 110.00 57 LAKE_1 END PACKAGEDATA BEGIN CONNECTIONDATA -# lakeno iconn layer row column ctype bedleak belev telev dx width - 1 1 1 7 6 HORIZONTAL 0.1 0 0 500 500 - 1 2 1 8 6 HORIZONTAL 0.1 0 0 500 500 - 1 3 1 9 6 HORIZONTAL 0.1 0 0 500 500 - 1 4 1 10 6 HORIZONTAL 0.1 0 0 500 500 - 1 5 1 11 6 HORIZONTAL 0.1 0 0 500 500 - 1 6 1 6 7 HORIZONTAL 0.1 0 0 500 500 - 1 7 2 7 7 VERTICAL 0.1 0 0 0 0 - 1 8 2 8 7 VERTICAL 0.1 0 0 0 0 - 1 9 2 8 7 HORIZONTAL 0.1 0 0 250 500 - 1 10 2 9 7 VERTICAL 0.1 0 0 0 0 - 1 11 2 9 7 HORIZONTAL 0.1 0 0 250 500 - 1 12 2 10 7 VERTICAL 0.1 0 0 0 0 - 1 13 2 10 7 HORIZONTAL 0.1 0 0 250 500 - 1 14 2 11 7 VERTICAL 0.1 0 0 0 0 - 1 15 1 12 7 HORIZONTAL 0.1 0 0 500 500 - 1 16 1 6 8 HORIZONTAL 0.1 0 0 500 500 - 1 17 2 7 8 VERTICAL 0.1 0 0 0 0 - 1 18 2 7 8 HORIZONTAL 0.1 0 0 250 500 - 1 19 3 8 8 VERTICAL 0.1 0 0 0 0 - 1 20 3 9 8 VERTICAL 0.1 0 0 0 0 - 1 21 3 10 8 VERTICAL 0.1 0 0 0 0 - 1 22 2 11 8 VERTICAL 0.1 0 0 0 0 - 1 23 2 11 8 HORIZONTAL 0.1 0 0 250 500 - 1 24 1 12 8 HORIZONTAL 0.1 0 0 500 500 - 1 25 1 6 9 HORIZONTAL 0.1 0 0 500 500 - 1 26 2 7 9 VERTICAL 0.1 0 0 0 0 - 1 27 2 7 9 HORIZONTAL 0.1 0 0 250 500 - 1 28 3 8 9 VERTICAL 0.1 0 0 0 0 - 1 29 3 9 9 VERTICAL 0.1 0 0 0 0 - 1 30 3 10 9 VERTICAL 0.1 0 0 0 0 - 1 31 2 11 9 VERTICAL 0.1 0 0 0 0 - 1 32 2 11 9 HORIZONTAL 0.1 0 0 250 500 - 1 33 1 12 9 HORIZONTAL 0.1 0 0 500 500 - 1 34 1 6 10 HORIZONTAL 0.1 0 0 500 500 - 1 35 2 7 10 VERTICAL 0.1 0 0 0 0 - 1 36 2 7 10 HORIZONTAL 0.1 0 0 250 500 - 1 37 3 8 10 VERTICAL 0.1 0 0 0 0 - 1 38 3 9 10 VERTICAL 0.1 0 0 0 0 - 1 39 3 10 10 VERTICAL 0.1 0 0 0 0 - 1 40 2 11 10 VERTICAL 0.1 0 0 0 0 - 1 41 2 11 10 HORIZONTAL 0.1 0 0 250 500 - 1 42 1 12 10 HORIZONTAL 0.1 0 0 500 500 - 1 43 1 6 11 HORIZONTAL 0.1 0 0 500 500 - 1 44 2 7 11 VERTICAL 0.1 0 0 0 0 - 1 45 2 8 11 VERTICAL 0.1 0 0 0 0 - 1 46 2 8 11 HORIZONTAL 0.1 0 0 250 500 - 1 47 2 9 11 VERTICAL 0.1 0 0 0 0 - 1 48 2 9 11 HORIZONTAL 0.1 0 0 250 500 - 1 49 2 10 11 VERTICAL 0.1 0 0 0 0 - 1 50 2 10 11 HORIZONTAL 0.1 0 0 250 500 - 1 51 2 11 11 VERTICAL 0.1 0 0 0 0 - 1 52 1 12 11 HORIZONTAL 0.1 0 0 500 500 - 1 53 1 7 12 HORIZONTAL 0.1 0 0 500 500 - 1 54 1 8 12 HORIZONTAL 0.1 0 0 500 500 - 1 55 1 9 12 HORIZONTAL 0.1 0 0 500 500 - 1 56 1 10 12 HORIZONTAL 0.1 0 0 500 500 - 1 57 1 11 12 HORIZONTAL 0.1 0 0 500 500 +# ifno iconn layer row column ctype bedleak belev telev dx width + 1 1 1 7 6 HORIZONTAL 0.1 0 0 500 500 + 1 2 1 8 6 HORIZONTAL 0.1 0 0 500 500 + 1 3 1 9 6 HORIZONTAL 0.1 0 0 500 500 + 1 4 1 10 6 HORIZONTAL 0.1 0 0 500 500 + 1 5 1 11 6 HORIZONTAL 0.1 0 0 500 500 + 1 6 1 6 7 HORIZONTAL 0.1 0 0 500 500 + 1 7 2 7 7 VERTICAL 0.1 0 0 0 0 + 1 8 2 8 7 VERTICAL 0.1 0 0 0 0 + 1 9 2 8 7 HORIZONTAL 0.1 0 0 250 500 + 1 10 2 9 7 VERTICAL 0.1 0 0 0 0 + 1 11 2 9 7 HORIZONTAL 0.1 0 0 250 500 + 1 12 2 10 7 VERTICAL 0.1 0 0 0 0 + 1 13 2 10 7 HORIZONTAL 0.1 0 0 250 500 + 1 14 2 11 7 VERTICAL 0.1 0 0 0 0 + 1 15 1 12 7 HORIZONTAL 0.1 0 0 500 500 + 1 16 1 6 8 HORIZONTAL 0.1 0 0 500 500 + 1 17 2 7 8 VERTICAL 0.1 0 0 0 0 + 1 18 2 7 8 HORIZONTAL 0.1 0 0 250 500 + 1 19 3 8 8 VERTICAL 0.1 0 0 0 0 + 1 20 3 9 8 VERTICAL 0.1 0 0 0 0 + 1 21 3 10 8 VERTICAL 0.1 0 0 0 0 + 1 22 2 11 8 VERTICAL 0.1 0 0 0 0 + 1 23 2 11 8 HORIZONTAL 0.1 0 0 250 500 + 1 24 1 12 8 HORIZONTAL 0.1 0 0 500 500 + 1 25 1 6 9 HORIZONTAL 0.1 0 0 500 500 + 1 26 2 7 9 VERTICAL 0.1 0 0 0 0 + 1 27 2 7 9 HORIZONTAL 0.1 0 0 250 500 + 1 28 3 8 9 VERTICAL 0.1 0 0 0 0 + 1 29 3 9 9 VERTICAL 0.1 0 0 0 0 + 1 30 3 10 9 VERTICAL 0.1 0 0 0 0 + 1 31 2 11 9 VERTICAL 0.1 0 0 0 0 + 1 32 2 11 9 HORIZONTAL 0.1 0 0 250 500 + 1 33 1 12 9 HORIZONTAL 0.1 0 0 500 500 + 1 34 1 6 10 HORIZONTAL 0.1 0 0 500 500 + 1 35 2 7 10 VERTICAL 0.1 0 0 0 0 + 1 36 2 7 10 HORIZONTAL 0.1 0 0 250 500 + 1 37 3 8 10 VERTICAL 0.1 0 0 0 0 + 1 38 3 9 10 VERTICAL 0.1 0 0 0 0 + 1 39 3 10 10 VERTICAL 0.1 0 0 0 0 + 1 40 2 11 10 VERTICAL 0.1 0 0 0 0 + 1 41 2 11 10 HORIZONTAL 0.1 0 0 250 500 + 1 42 1 12 10 HORIZONTAL 0.1 0 0 500 500 + 1 43 1 6 11 HORIZONTAL 0.1 0 0 500 500 + 1 44 2 7 11 VERTICAL 0.1 0 0 0 0 + 1 45 2 8 11 VERTICAL 0.1 0 0 0 0 + 1 46 2 8 11 HORIZONTAL 0.1 0 0 250 500 + 1 47 2 9 11 VERTICAL 0.1 0 0 0 0 + 1 48 2 9 11 HORIZONTAL 0.1 0 0 250 500 + 1 49 2 10 11 VERTICAL 0.1 0 0 0 0 + 1 50 2 10 11 HORIZONTAL 0.1 0 0 250 500 + 1 51 2 11 11 VERTICAL 0.1 0 0 0 0 + 1 52 1 12 11 HORIZONTAL 0.1 0 0 500 500 + 1 53 1 7 12 HORIZONTAL 0.1 0 0 500 500 + 1 54 1 8 12 HORIZONTAL 0.1 0 0 500 500 + 1 55 1 9 12 HORIZONTAL 0.1 0 0 500 500 + 1 56 1 10 12 HORIZONTAL 0.1 0 0 500 500 + 1 57 1 11 12 HORIZONTAL 0.1 0 0 500 500 END CONNECTIONDATA BEGIN OUTLETS diff --git a/doc/mf6io/mf6ivar/examples/gwf-maw-example1.dat b/doc/mf6io/mf6ivar/examples/gwf-maw-example1.dat index d0cd90b41ae..416a69593f0 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-maw-example1.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-maw-example1.dat @@ -12,16 +12,16 @@ begin dimensions end dimensions begin packagedata -# wellno radius bottom strt condeqn ngwnodes name - 1 0.15 -100.0 9.14 thiem 2 pwell - 2 0.25 -100.0 9.14 thiem 1 iwell +# ifno radius bottom strt condeqn ngwnodes name + 1 0.15 -100.0 9.14 thiem 2 pwell + 2 0.25 -100.0 9.14 thiem 1 iwell end packagedata begin connectiondata -# wellno conn l r c stop sbot k rskin - 1 1 1 51 51 0 0 0 0 - 1 2 2 51 51 0 0 0 0 - 2 1 2 2 2 0 0 0 0 +# ifno conn l r c stop sbot k rskin + 1 1 1 51 51 0 0 0 0 + 1 2 2 51 51 0 0 0 0 + 2 1 2 2 2 0 0 0 0 end connectiondata begin period 1 diff --git a/doc/mf6io/mf6ivar/examples/gwf-maw-example2.dat b/doc/mf6io/mf6ivar/examples/gwf-maw-example2.dat index fc9f856fe94..fe50eb04554 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-maw-example2.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-maw-example2.dat @@ -10,16 +10,16 @@ begin dimensions end dimensions begin packagedata -# wellno radius bottom strt condeqn ngwnodes name - 1 0.15 -100.0 9.14 mean 2 pwell - 2 0.25 -100.0 9.14 mean 1 iwell +# ifno radius bottom strt condeqn ngwnodes name + 1 0.15 -100.0 9.14 mean 2 pwell + 2 0.25 -100.0 9.14 mean 1 iwell end packagedata begin connectiondata -# wellno conn l r c stop sbot k rskin - 1 1 1 51 51 0. -100. 361. .25 - 1 2 2 51 51 0. -100. 361. .25 - 2 1 2 2 2 -50. -100. 361 .50 +# ifno conn l r c stop sbot k rskin + 1 1 1 51 51 0. -100. 361. .25 + 1 2 2 51 51 0. -100. 361. .25 + 2 1 2 2 2 -50. -100. 361 .50 end connectiondata begin period 1 diff --git a/doc/mf6io/mf6ivar/examples/gwf-maw-example3.dat b/doc/mf6io/mf6ivar/examples/gwf-maw-example3.dat index a8742eba367..f0477598e97 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-maw-example3.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-maw-example3.dat @@ -11,14 +11,14 @@ begin dimensions end dimensions begin packagedata -# wellno radius bottom strt condeqn ngwnodes name - 1 0.15 -514.9 9.14 specified 2 ntwell +# ifno radius bottom strt condeqn ngwnodes name + 1 0.15 -514.9 9.14 specified 2 ntwell end packagedata begin connectiondata -# wellno conn l r c stop sbot k rskin - 1 1 1 51 51 -50 -514.9 111.3763 0 - 1 2 2 51 51 -50 -514.9 445.9849 0 +# ifno conn l r c stop sbot k rskin + 1 1 1 51 51 -50 -514.9 111.3763 0 + 1 2 2 51 51 -50 -514.9 445.9849 0 end connectiondata begin period 1 diff --git a/doc/mf6io/mf6ivar/examples/gwf-rch-example.dat b/doc/mf6io/mf6ivar/examples/gwf-rch-example.dat index 21086eb5ff0..c37205b5ee7 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-rch-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-rch-example.dat @@ -14,7 +14,6 @@ BEGIN DIMENSIONS END DIMENSIONS BEGIN PERIOD 1 - RECHARGE # Lay Row Col Rate Var1 Var2 mult BoundName 1 1 1 rch_1 1.0 2.0 1.0 Rch-1-1 1 1 2 rch_1 1.1 2.1 1.0 Rch-1-2 diff --git a/doc/mf6io/mf6ivar/examples/gwf-sfr-example.dat b/doc/mf6io/mf6ivar/examples/gwf-sfr-example.dat index 18d885dfd4c..e91f90ee487 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-sfr-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-sfr-example.dat @@ -13,94 +13,94 @@ BEGIN DIMENSIONS END DIMENSIONS BEGIN PACKAGEDATA -#rno k i j rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv boundname - 1 1 1 1 4500. 12 8.67E-04 1093.048 3.0 0.00003 0.03 1 1.0 0 reach1 - 2 1 2 2 7000. 12 8.67E-04 1088.059 3.0 0.00003 0.03 2 1.0 0 reach2 - 3 1 3 3 6000. 12 8.67E-04 1082.419 3.0 0.00003 0.03 2 1.0 0 reach3 - 4 1 3 4 5550. 12 8.67E-04 1077.408 3.0 0.00003 0.03 3 1.0 1 reach4 - 5 1 4 5 6500. 12 9.43E-04 1071.934 3.0 0.00003 0.03 2 1.0 0 - 6 1 5 6 5000. 12 9.43E-04 1066.509 3.0 0.00003 0.03 2 1.0 0 - 7 1 6 6 5000. 12 9.43E-04 1061.792 3.0 0.00003 0.03 2 1.0 0 - 8 1 7 6 5000. 12 9.43E-04 1057.075 3.0 0.00003 0.03 2 1.0 0 - 9 1 8 6 5000. 12 9.43E-04 1052.359 3.0 0.00003 0.03 2 1.0 0 - 10 1 3 5 5000. 10 5.45E-04 1073.636 2.0 0.00003 0.03 2 0.0 0 canal - 11 1 3 6 5000. 10 5.45E-04 1070.909 2.0 0.00003 0.03 2 1.0 0 canal - 12 1 3 7 4500. 10 5.45E-04 1068.318 2.0 0.00003 0.03 2 1.0 0 canal - 13 1 4 8 6000. 10 5.45E-04 1065.455 2.0 0.00003 0.03 2 1.0 0 canal - 14 1 5 8 5000. 10 5.45E-04 1062.455 2.0 0.00003 0.03 2 1.0 0 canal - 15 1 6 8 2000. 10 5.45E-04 1060.545 2.0 0.00003 0.03 2 1.0 0 canal - 16 1 510 2500. 10 1.81E-03 1077.727 3.0 0.00003 0.03 1 1.0 0 - 17 1 5 9 5000. 10 1.81E-03 1070.909 3.0 0.00003 0.03 2 1.0 0 - 18 1 6 8 3500. 10 1.81E-03 1063.182 3.0 0.00003 0.03 2 1.0 0 - 19 1 6 8 4000. 15 1.00E-03 1058.000 3.0 0.00003 0.03 3 1.0 0 - 20 1 7 7 5000. 15 1.00E-03 1053.500 3.0 0.00003 0.03 2 1.0 0 - 21 1 8 7 3500. 15 1.00E-03 1049.250 3.0 0.00003 0.03 2 1.0 0 - 22 1 8 6 2500. 15 1.00E-03 1046.250 3.0 0.00003 0.03 2 1.0 0 - 23 1 9 6 5000. 12 9.09E-04 1042.727 3.0 0.00003 0.03 3 1.0 0 - 24 1 10 7 5000. 12 9.09E-04 1038.182 3.0 0.00003 0.03 2 1.0 0 - 25 1 11 7 5000. 12 9.09E-04 1033.636 3.0 0.00003 0.03 2 1.0 0 - 26 1 12 7 5000. 12 9.09E-04 1029.091 3.0 0.00003 0.03 2 1.0 0 - 27 1 13 7 2000. 12 9.09E-04 1025.909 3.0 0.00003 0.03 2 1.0 0 - 28 1 14 9 5000. 55 9.67E-04 1037.581 3.0 0.00006 0.025 1 1.0 0 - 29 1 13 8 5500. 55 9.67E-04 1032.500 3.0 0.00006 0.025 2 1.0 0 - 30 1 13 7 5000. 55 9.67E-04 1027.419 3.0 0.00006 0.025 2 1.0 0 - 31 1 13 6 5000. 40 1.25E-03 1021.875 3.0 0.00006 0.025 3 1.0 0 - 32 1 13 5 5000. 40 1.25E-03 1015.625 3.0 0.00006 0.025 2 1.0 0 - 33 1 13 4 5000. 40 1.25E-03 1009.375 3.0 0.00006 0.025 2 1.0 0 - 34 1 13 3 5000. 40 1.25E-03 1003.125 3.0 0.00006 0.025 2 1.0 0 - 35 1 13 2 5000. 40 1.25E-03 996.8750 3.0 0.00006 0.025 2 1.0 0 - 36 1 13 1 3000. 40 1.25E-03 991.8750 3.0 0.00006 0.025 2 1.0 0 - 37 none 5000. 40 1.25E-03 985.6250 3.0 0.00006 0.025 1 1.0 0 +#ifno k i j rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv boundname + 1 1 1 1 4500. 12 8.67E-04 1093.048 3.0 0.00003 0.03 1 1.0 0 reach1 + 2 1 2 2 7000. 12 8.67E-04 1088.059 3.0 0.00003 0.03 2 1.0 0 reach2 + 3 1 3 3 6000. 12 8.67E-04 1082.419 3.0 0.00003 0.03 2 1.0 0 reach3 + 4 1 3 4 5550. 12 8.67E-04 1077.408 3.0 0.00003 0.03 3 1.0 1 reach4 + 5 1 4 5 6500. 12 9.43E-04 1071.934 3.0 0.00003 0.03 2 1.0 0 + 6 1 5 6 5000. 12 9.43E-04 1066.509 3.0 0.00003 0.03 2 1.0 0 + 7 1 6 6 5000. 12 9.43E-04 1061.792 3.0 0.00003 0.03 2 1.0 0 + 8 1 7 6 5000. 12 9.43E-04 1057.075 3.0 0.00003 0.03 2 1.0 0 + 9 1 8 6 5000. 12 9.43E-04 1052.359 3.0 0.00003 0.03 2 1.0 0 + 10 1 3 5 5000. 10 5.45E-04 1073.636 2.0 0.00003 0.03 2 0.0 0 canal + 11 1 3 6 5000. 10 5.45E-04 1070.909 2.0 0.00003 0.03 2 1.0 0 canal + 12 1 3 7 4500. 10 5.45E-04 1068.318 2.0 0.00003 0.03 2 1.0 0 canal + 13 1 4 8 6000. 10 5.45E-04 1065.455 2.0 0.00003 0.03 2 1.0 0 canal + 14 1 5 8 5000. 10 5.45E-04 1062.455 2.0 0.00003 0.03 2 1.0 0 canal + 15 1 6 8 2000. 10 5.45E-04 1060.545 2.0 0.00003 0.03 2 1.0 0 canal + 16 1 5 10 2500. 10 1.81E-03 1077.727 3.0 0.00003 0.03 1 1.0 0 + 17 1 5 9 5000. 10 1.81E-03 1070.909 3.0 0.00003 0.03 2 1.0 0 + 18 1 6 8 3500. 10 1.81E-03 1063.182 3.0 0.00003 0.03 2 1.0 0 + 19 1 6 8 4000. 15 1.00E-03 1058.000 3.0 0.00003 0.03 3 1.0 0 + 20 1 7 7 5000. 15 1.00E-03 1053.500 3.0 0.00003 0.03 2 1.0 0 + 21 1 8 7 3500. 15 1.00E-03 1049.250 3.0 0.00003 0.03 2 1.0 0 + 22 1 8 6 2500. 15 1.00E-03 1046.250 3.0 0.00003 0.03 2 1.0 0 + 23 1 9 6 5000. 12 9.09E-04 1042.727 3.0 0.00003 0.03 3 1.0 0 + 24 1 10 7 5000. 12 9.09E-04 1038.182 3.0 0.00003 0.03 2 1.0 0 + 25 1 11 7 5000. 12 9.09E-04 1033.636 3.0 0.00003 0.03 2 1.0 0 + 26 1 12 7 5000. 12 9.09E-04 1029.091 3.0 0.00003 0.03 2 1.0 0 + 27 1 13 7 2000. 12 9.09E-04 1025.909 3.0 0.00003 0.03 2 1.0 0 + 28 1 14 9 5000. 55 9.67E-04 1037.581 3.0 0.00006 0.025 1 1.0 0 + 29 1 13 8 5500. 55 9.67E-04 1032.500 3.0 0.00006 0.025 2 1.0 0 + 30 1 13 7 5000. 55 9.67E-04 1027.419 3.0 0.00006 0.025 2 1.0 0 + 31 1 13 6 5000. 40 1.25E-03 1021.875 3.0 0.00006 0.025 3 1.0 0 + 32 1 13 5 5000. 40 1.25E-03 1015.625 3.0 0.00006 0.025 2 1.0 0 + 33 1 13 4 5000. 40 1.25E-03 1009.375 3.0 0.00006 0.025 2 1.0 0 + 34 1 13 3 5000. 40 1.25E-03 1003.125 3.0 0.00006 0.025 2 1.0 0 + 35 1 13 2 5000. 40 1.25E-03 996.8750 3.0 0.00006 0.025 2 1.0 0 + 36 1 13 1 3000. 40 1.25E-03 991.8750 3.0 0.00006 0.025 2 1.0 0 + 37 0 0 0 5000. 40 1.25E-03 985.6250 3.0 0.00006 0.025 1 1.0 0 END PACKAGEDATA BEGIN CONNECTIONDATA -#rno ic1 ic2 ic3 - 1 -2 - 2 1 -3 - 3 2 -4 - 4 3 -5 -10 - 5 4 -6 - 6 5 -7 - 7 6 -8 - 8 7 -9 - 9 8 -23 - 10 4 -11 - 11 10 -12 - 12 11 -13 - 13 12 -14 - 14 13 -15 - 15 14 -19 - 16 -17 - 17 16 -18 - 18 17 -19 - 19 15 18 -20 - 20 19 -21 - 21 20 -22 - 22 21 -23 - 23 9 22 -24 - 24 23 -25 - 25 24 -26 - 26 25 -27 - 27 26 -31 - 28 -29 - 29 28 -30 - 30 29 -31 - 31 27 30 -32 - 32 31 -33 - 33 32 -34 - 34 33 -35 - 35 34 -36 - 36 35 -37 - 37 36 +#ifno ic1 ic2 ic3 + 1 -2 + 2 1 -3 + 3 2 -4 + 4 3 -5 -10 + 5 4 -6 + 6 5 -7 + 7 6 -8 + 8 7 -9 + 9 8 -23 + 10 4 -11 + 11 10 -12 + 12 11 -13 + 13 12 -14 + 14 13 -15 + 15 14 -19 + 16 -17 + 17 16 -18 + 18 17 -19 + 19 15 18 -20 + 20 19 -21 + 21 20 -22 + 22 21 -23 + 23 9 22 -24 + 24 23 -25 + 25 24 -26 + 26 25 -27 + 27 26 -31 + 28 -29 + 29 28 -30 + 30 29 -31 + 31 27 30 -32 + 32 31 -33 + 33 32 -34 + 34 33 -35 + 35 34 -36 + 36 35 -37 + 37 36 END CONNECTIONDATA BEGIN DIVERSIONS -# rno idv iconr cprior +# ifno idv iconr cprior 4 1 10 UPTO END DIVERSIONS BEGIN PERIOD 1 -# rno sfrsetting +#ifno sfrsetting 1 inflow 25. 16 inflow 10. 28 inflow 150. diff --git a/doc/mf6io/mf6ivar/examples/gwf-sfr-example2.dat b/doc/mf6io/mf6ivar/examples/gwf-sfr-example2.dat index a5b1e0f08f7..70121651009 100644 --- a/doc/mf6io/mf6ivar/examples/gwf-sfr-example2.dat +++ b/doc/mf6io/mf6ivar/examples/gwf-sfr-example2.dat @@ -13,17 +13,17 @@ BEGIN DIMENSIONS END DIMENSIONS BEGIN PACKAGEDATA -#rno k i j rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv boundname - 1 1 1 1 1000. 10 8.67E-04 1093.048 3.0 0.00003 0.03 1 1.0 0 trapezoidal - 2 1 2 2 2000. 11 8.67E-04 1088.059 3.0 0.00003 0.03 2 1.0 0 trapezoidal - 3 1 3 3 3000. 12 8.67E-04 1082.419 3.0 0.00003 0.03 2 1.0 0 trapezoidal - 4 1 3 4 4000. 13 8.67E-04 1077.408 3.0 0.00003 0.03 2 1.0 0 trapezoidal - 5 1 4 5 5000. 14 9.43E-04 1071.934 3.0 0.00003 0.03 2 1.0 0 rect - 6 1 5 6 5000. 15 9.43E-04 1066.509 3.0 0.00003 0.03 2 1.0 0 rect - 7 1 6 6 5000. 16 9.43E-04 1061.792 3.0 0.00003 0.03 2 1.0 0 rect - 8 1 7 6 5000. 17 9.43E-04 1057.075 3.0 0.00003 0.03 2 1.0 0 rect - 9 1 8 6 5000. 18 9.43E-04 1052.359 3.0 0.00003 0.03 2 1.0 0 rect - 10 1 3 5 5000. 19 5.45E-04 1073.636 2.0 0.00003 0.03 1 0.0 0 rect +#ifno k i j rlen rwid rgrd rtp rbth rhk man ncon ustrf ndv boundname + 1 1 1 1 1000. 10 8.67E-04 1093.048 3.0 0.00003 0.03 1 1.0 0 trapezoidal + 2 1 2 2 2000. 11 8.67E-04 1088.059 3.0 0.00003 0.03 2 1.0 0 trapezoidal + 3 1 3 3 3000. 12 8.67E-04 1082.419 3.0 0.00003 0.03 2 1.0 0 trapezoidal + 4 1 3 4 4000. 13 8.67E-04 1077.408 3.0 0.00003 0.03 2 1.0 0 trapezoidal + 5 1 4 5 5000. 14 9.43E-04 1071.934 3.0 0.00003 0.03 2 1.0 0 rect + 6 1 5 6 5000. 15 9.43E-04 1066.509 3.0 0.00003 0.03 2 1.0 0 rect + 7 1 6 6 5000. 16 9.43E-04 1061.792 3.0 0.00003 0.03 2 1.0 0 rect + 8 1 7 6 5000. 17 9.43E-04 1057.075 3.0 0.00003 0.03 2 1.0 0 rect + 9 1 8 6 5000. 18 9.43E-04 1052.359 3.0 0.00003 0.03 2 1.0 0 rect + 10 1 3 5 5000. 19 5.45E-04 1073.636 2.0 0.00003 0.03 1 0.0 0 rect END PACKAGEDATA # CROSSSECTIONS BLOCK is optional @@ -34,21 +34,21 @@ BEGIN CROSSSECTIONS END CROSSSECTIONS BEGIN CONNECTIONDATA -#rno ic1 ic2 ic3 - 1 -2 - 2 1 -3 - 3 2 -4 - 4 3 -5 - 5 4 -6 - 6 5 -7 - 7 6 -8 - 8 7 -9 - 9 8 -10 - 10 9 +# ifno ic1 ic2 ic3 + 1 -2 + 2 1 -3 + 3 2 -4 + 4 3 -5 + 5 4 -6 + 6 5 -7 + 7 6 -8 + 8 7 -9 + 9 8 -10 + 10 9 END CONNECTIONDATA BEGIN PERIOD 1 -# rno sfrsetting - 1 inflow 25. - 4 crosssection TAB6 FILEIN trapezoidal.tab +# ifno sfrsetting + 1 inflow 25. + 4 crosssection TAB6 FILEIN trapezoidal.tab END PERIOD diff --git a/doc/mf6io/mf6ivar/examples/gwt-lkt-example-obs.dat b/doc/mf6io/mf6ivar/examples/gwt-lkt-example-obs.dat index 219b663b6f5..b099bbb1b3f 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-lkt-example-obs.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-lkt-example-obs.dat @@ -4,23 +4,24 @@ BEGIN options END options BEGIN continuous FILEOUT gwt_lkt02.lkt.obs.csv - lkt-1-conc CONCENTRATION 1 - lkt-1-extinflow EXT-INFLOW 1 - lkt-1-rain RAINFALL 1 - lkt-1-roff RUNOFF 1 - lkt-1-evap EVAPORATION 1 - lkt-1-wdrl WITHDRAWAL 1 - lkt-1-stor STORAGE 1 - lkt-1-const CONSTANT 1 - lkt-1-gwt1 LKT 1 1 - lkt-1-gwt2 LKT 1 2 - lkt-2-gwt1 LKT 2 1 - lkt-1-mylake1 LKT MYLAKE1 - lkt-1-fjf FLOW-JA-FACE 1 2 - lkt-2-fjf FLOW-JA-FACE 2 1 - lkt-3-fjf FLOW-JA-FACE 2 3 - lkt-4-fjf FLOW-JA-FACE 3 2 - lkt-5-fjf FLOW-JA-FACE MYLAKE1 - lkt-6-fjf FLOW-JA-FACE MYLAKE2 - lkt-7-fjf FLOW-JA-FACE MYLAKE3 +# obs_name obs_type ID ID2 + lkt-1-conc CONCENTRATION 1 + lkt-1-extinflow EXT-INFLOW 1 + lkt-1-rain RAINFALL 1 + lkt-1-roff RUNOFF 1 + lkt-1-evap EVAPORATION 1 + lkt-1-wdrl WITHDRAWAL 1 + lkt-1-stor STORAGE 1 + lkt-1-const CONSTANT 1 + lkt-1-gwt1 LKT 1 1 + lkt-1-gwt2 LKT 1 2 + lkt-2-gwt1 LKT 2 1 + lkt-1-mylake1 LKT MYLAKE1 + lkt-1-fjf FLOW-JA-FACE 1 2 + lkt-2-fjf FLOW-JA-FACE 2 1 + lkt-3-fjf FLOW-JA-FACE 2 3 + lkt-4-fjf FLOW-JA-FACE 3 2 + lkt-5-fjf FLOW-JA-FACE MYLAKE1 + lkt-6-fjf FLOW-JA-FACE MYLAKE2 + lkt-7-fjf FLOW-JA-FACE MYLAKE3 END continuous diff --git a/doc/mf6io/mf6ivar/examples/gwt-lkt-example.dat b/doc/mf6io/mf6ivar/examples/gwt-lkt-example.dat index 5e3706eb239..76e1f6986ee 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-lkt-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-lkt-example.dat @@ -11,10 +11,10 @@ BEGIN OPTIONS END OPTIONS BEGIN PACKAGEDATA -# L STRT aux1 aux2 bname - 1 0.00000000 99.00000000 999.00000000 MYLAKE1 - 2 0.00000000 99.00000000 999.00000000 MYLAKE2 - 3 0.00000000 99.00000000 999.00000000 MYLAKE3 +# ifno STRT aux1 aux2 bname + 1 0.00000000 99.00000000 999.00000000 MYLAKE1 + 2 0.00000000 99.00000000 999.00000000 MYLAKE2 + 3 0.00000000 99.00000000 999.00000000 MYLAKE3 END PACKAGEDATA BEGIN PERIOD 1 diff --git a/doc/mf6io/mf6ivar/examples/gwt-mwt-example-obs.dat b/doc/mf6io/mf6ivar/examples/gwt-mwt-example-obs.dat index f5d2c250348..a968355aaf5 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-mwt-example-obs.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-mwt-example-obs.dat @@ -4,40 +4,41 @@ BEGIN options END options BEGIN continuous FILEOUT gwt_mwt_02.mwt.obs.csv - mwt1mwt MWT 1 1 - mwt2mwt MWT 2 1 - mwt3mwt MWT 3 1 - mwt4mwt MWT 4 1 - mwt1conc CONCENTRATION 1 - mwt2conc CONCENTRATION 2 - mwt3conc CONCENTRATION 3 - mwt4conc CONCENTRATION 4 - mwt1stor STORAGE 1 - mwt2stor STORAGE 2 - mwt3stor STORAGE 3 - mwt4stor STORAGE 4 - mwt1cnst CONSTANT 1 - mwt2cnst CONSTANT 2 - mwt3cnst CONSTANT 3 - mwt4cnst CONSTANT 4 - mwt1fmvr FROM-MVR 1 - mwt2fmvr FROM-MVR 2 - mwt3fmvr FROM-MVR 3 - mwt4fmvr FROM-MVR 4 - mwt1rate RATE 1 - mwt2rate RATE 2 - mwt3rate RATE 3 - mwt4rate RATE 4 - mwt1rtmv RATE-TO-MVR 1 - mwt2rtmv RATE-TO-MVR 2 - mwt3rtmv RATE-TO-MVR 3 - mwt4rtmv RATE-TO-MVR 4 - mwt1fwrt FW-RATE 1 - mwt2fwrt FW-RATE 2 - mwt3fwrt FW-RATE 3 - mwt4fwrt FW-RATE 4 - mwt1frtm FW-RATE-TO-MVR 1 - mwt2frtm FW-RATE-TO-MVR 2 - mwt3frtm FW-RATE-TO-MVR 3 - mwt4frtm FW-RATE-TO-MVR 4 +# obs_name obs_type ID ID2 + mwt1mwt MWT 1 1 + mwt2mwt MWT 2 1 + mwt3mwt MWT 3 1 + mwt4mwt MWT 4 1 + mwt1conc CONCENTRATION 1 + mwt2conc CONCENTRATION 2 + mwt3conc CONCENTRATION 3 + mwt4conc CONCENTRATION 4 + mwt1stor STORAGE 1 + mwt2stor STORAGE 2 + mwt3stor STORAGE 3 + mwt4stor STORAGE 4 + mwt1cnst CONSTANT 1 + mwt2cnst CONSTANT 2 + mwt3cnst CONSTANT 3 + mwt4cnst CONSTANT 4 + mwt1fmvr FROM-MVR 1 + mwt2fmvr FROM-MVR 2 + mwt3fmvr FROM-MVR 3 + mwt4fmvr FROM-MVR 4 + mwt1rate RATE 1 + mwt2rate RATE 2 + mwt3rate RATE 3 + mwt4rate RATE 4 + mwt1rtmv RATE-TO-MVR 1 + mwt2rtmv RATE-TO-MVR 2 + mwt3rtmv RATE-TO-MVR 3 + mwt4rtmv RATE-TO-MVR 4 + mwt1fwrt FW-RATE 1 + mwt2fwrt FW-RATE 2 + mwt3fwrt FW-RATE 3 + mwt4fwrt FW-RATE 4 + mwt1frtm FW-RATE-TO-MVR 1 + mwt2frtm FW-RATE-TO-MVR 2 + mwt3frtm FW-RATE-TO-MVR 3 + mwt4frtm FW-RATE-TO-MVR 4 END continuous FILEOUT gwt_mwt_02.mwt.obs.csv \ No newline at end of file diff --git a/doc/mf6io/mf6ivar/examples/gwt-mwt-example.dat b/doc/mf6io/mf6ivar/examples/gwt-mwt-example.dat index 111a30b3d37..c3157ad0dd5 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-mwt-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-mwt-example.dat @@ -11,10 +11,10 @@ BEGIN OPTIONS END OPTIONS BEGIN PACKAGEDATA -# L STRT aux1 aux2 bname - 1 0.00000000 99.00000000 999.00000000 MYWELL1 - 2 0.00000000 99.00000000 999.00000000 MYWELL2 - 3 0.00000000 99.00000000 999.00000000 MYWELL3 +# ifno STRT aux1 aux2 bname + 1 0.00000000 99.00000000 999.00000000 MYWELL1 + 2 0.00000000 99.00000000 999.00000000 MYWELL2 + 3 0.00000000 99.00000000 999.00000000 MYWELL3 END PACKAGEDATA BEGIN PERIOD 1 diff --git a/doc/mf6io/mf6ivar/examples/gwt-uzt-example-obs.dat b/doc/mf6io/mf6ivar/examples/gwt-uzt-example-obs.dat index 8d52cf11160..5a9feb5dd1d 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-uzt-example-obs.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-uzt-example-obs.dat @@ -4,9 +4,10 @@ BEGIN options END options BEGIN continuous FILEOUT gwt_02.uzt.obs.csv - mwt-1-conc CONCENTRATION 1 - mwt-1-stor STORAGE 1 - mwt-1-gwt1 UZT 1 - mwt-1-gwt2 UZT 2 - mwt-2-gwt1 UZT 3 +# obs_name obs_type ID + mwt-1-conc CONCENTRATION 1 + mwt-1-stor STORAGE 1 + mwt-1-gwt1 UZT 1 + mwt-1-gwt2 UZT 2 + mwt-2-gwt1 UZT 3 END continuous diff --git a/doc/mf6io/mf6ivar/examples/gwt-uzt-example.dat b/doc/mf6io/mf6ivar/examples/gwt-uzt-example.dat index 5a525d35959..5896535f8d7 100644 --- a/doc/mf6io/mf6ivar/examples/gwt-uzt-example.dat +++ b/doc/mf6io/mf6ivar/examples/gwt-uzt-example.dat @@ -11,10 +11,10 @@ BEGIN OPTIONS END OPTIONS BEGIN PACKAGEDATA -# L STRT aux1 aux2 bname - 1 0.00000000 99.00000000 999.00000000 MYUZFCELL1 - 2 0.00000000 99.00000000 999.00000000 MYUZFCELL2 - 3 0.00000000 99.00000000 999.00000000 MYUZFCELL3 +# ifno STRT aux1 aux2 bname + 1 0.00000000 99.00000000 999.00000000 MYUZFCELL1 + 2 0.00000000 99.00000000 999.00000000 MYUZFCELL2 + 3 0.00000000 99.00000000 999.00000000 MYUZFCELL3 END PACKAGEDATA BEGIN PERIOD 1 diff --git a/doc/mf6io/mf6ivar/md/deprecations.md b/doc/mf6io/mf6ivar/md/deprecations.md new file mode 100644 index 00000000000..5c3429bcc9f --- /dev/null +++ b/doc/mf6io/mf6ivar/md/deprecations.md @@ -0,0 +1,14 @@ +#### Deprecations + +The following table lists deprecated options and the versions in which they were deprecated and (optionally) removed. + +| Model-Package | Option | Deprecated | Removed | +|:--------------|:-------|:-----------|:--------| +| gwf-sfr | unit_conversion | 6.4.2 | | +| sln-ims | csv_output_filerecord | 6.1.1 | | +| sln-ims | csv_output | 6.1.1 | | +| sln-ims | csvfile | 6.1.1 | | +| sln-ims | outer_hclose | 6.1.1 | | +| sln-ims | outer_rclosebnd | 6.1.1 | | +| sln-ims | inner_hclose | 6.1.1 | | + diff --git a/doc/mf6io/mf6ivar/md/mf6ivar.md b/doc/mf6io/mf6ivar/md/mf6ivar.md index 796bc5bcfeb..a1a6b95f5ac 100644 --- a/doc/mf6io/mf6ivar/md/mf6ivar.md +++ b/doc/mf6io/mf6ivar/md/mf6ivar.md @@ -321,6 +321,7 @@ | GWF | CHD | OPTIONS | TS6_FILENAME | STRING | defines a time-series file defining time series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-series capability. | | GWF | CHD | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWF | CHD | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the constant-head package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the constant-head package. | +| GWF | CHD | OPTIONS | DEV_NO_NEWTON | KEYWORD | turn off Newton for unconfined cells | | GWF | CHD | DIMENSIONS | MAXBOUND | INTEGER | integer value specifying the maximum number of constant-head cells that will be specified for use during any stress period. | | GWF | CHD | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | | GWF | CHD | PERIOD | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. | @@ -362,6 +363,7 @@ | GWF | DRN | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWF | DRN | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the Drain package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the Drain package. | | GWF | DRN | OPTIONS | MOVER | KEYWORD | keyword to indicate that this instance of the Drain Package can be used with the Water Mover (MVR) Package. When the MOVER option is specified, additional memory is allocated within the package to store the available, provided, and received water. | +| GWF | DRN | OPTIONS | DEV_CUBIC_SCALING | KEYWORD | cubic-scaling is used to scale the drain conductance | | GWF | DRN | DIMENSIONS | MAXBOUND | INTEGER | integer value specifying the maximum number of drains cells that will be specified for use during any stress period. | | GWF | DRN | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | | GWF | DRN | PERIOD | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. | @@ -435,7 +437,7 @@ | GWF | RCHA | OPTIONS | SAVE_FLOWS | KEYWORD | keyword to indicate that recharge flow terms will be written to the file specified with ``BUDGET FILEOUT'' in Output Control. | | GWF | RCHA | OPTIONS | TAS6 | KEYWORD | keyword to specify that record corresponds to a time-array-series file. | | GWF | RCHA | OPTIONS | FILEIN | KEYWORD | keyword to specify that an input filename is expected next. | -| GWF | RCHA | OPTIONS | TAS6_FILENAME | STRING | defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the Time-Variable Input section for instructions on using the time-array series capability. | +| GWF | RCHA | OPTIONS | TAS6_FILENAME | STRING | defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-array series capability. | | GWF | RCHA | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWF | RCHA | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the Recharge package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the Recharge package. | | GWF | RCHA | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | @@ -484,7 +486,7 @@ | GWF | EVTA | PERIOD | SURFACE | DOUBLE PRECISION (NCOL*NROW; NCPL) | is the elevation of the ET surface ($L$). | | GWF | EVTA | PERIOD | RATE | DOUBLE PRECISION (NCOL*NROW; NCPL) | is the maximum ET flux rate ($LT^{-1}$). | | GWF | EVTA | PERIOD | DEPTH | DOUBLE PRECISION (NCOL*NROW; NCPL) | is the ET extinction depth ($L$). | -| GWF | EVTA | PERIOD | AUX(IAUX) | DOUBLE PRECISION (NCOL*NROW; NCPL) | is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array. | +| GWF | EVTA | PERIOD | AUX | DOUBLE PRECISION (NCOL*NROW; NCPL) | is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array. | | GWF | MAW | OPTIONS | AUXILIARY | STRING (NAUX) | defines an array of one or more auxiliary variable names. There is no limit on the number of auxiliary variables that can be provided on this line; however, lists of information provided in subsequent blocks must have a column of data for each auxiliary variable name defined here. The number of auxiliary variables detected on this line determines the value for naux. Comments cannot be provided anywhere on this line as they will be interpreted as auxiliary variable names. Auxiliary variables may not be used by the package, but they will be available for use by other parts of the program. The program will terminate with an error if auxiliary variables are specified on more than one line in the options block. | | GWF | MAW | OPTIONS | BOUNDNAMES | KEYWORD | keyword to indicate that boundary names may be provided with the list of multi-aquifer well cells. | | GWF | MAW | OPTIONS | PRINT_INPUT | KEYWORD | keyword to indicate that the list of multi-aquifer well information will be written to the listing file immediately after it is read. | @@ -512,30 +514,30 @@ | GWF | MAW | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the MAW package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the MAW package. | | GWF | MAW | OPTIONS | MOVER | KEYWORD | keyword to indicate that this instance of the MAW Package can be used with the Water Mover (MVR) Package. When the MOVER option is specified, additional memory is allocated within the package to store the available, provided, and received water. | | GWF | MAW | DIMENSIONS | NMAWWELLS | INTEGER | integer value specifying the number of multi-aquifer wells that will be simulated for all stress periods. | -| GWF | MAW | PACKAGEDATA | WELLNO | INTEGER | integer value that defines the well number associated with the specified PACKAGEDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. | +| GWF | MAW | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. | | GWF | MAW | PACKAGEDATA | RADIUS | DOUBLE PRECISION | radius for the multi-aquifer well. The program will terminate with an error if the radius is less than or equal to zero. | | GWF | MAW | PACKAGEDATA | BOTTOM | DOUBLE PRECISION | bottom elevation of the multi-aquifer well. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, BOTTOM is set to the cell bottom in the lowermost GWF cell connection in cases where the specified well bottom is above the bottom of this GWF cell. If CONDEQN is MEAN, BOTTOM is set to the lowermost GWF cell connection screen bottom in cases where the specified well bottom is above this value. The bottom elevation defines the lowest well head that will be simulated when the NEWTON UNDER\_RELAXATION option is specified in the GWF model name file. The bottom elevation is also used to calculate volumetric storage in the well. | | GWF | MAW | PACKAGEDATA | STRT | DOUBLE PRECISION | starting head for the multi-aquifer well. The program will terminate with an error if the starting head is less than the specified well bottom. | | GWF | MAW | PACKAGEDATA | CONDEQN | STRING | character string that defines the conductance equation that is used to calculate the saturated conductance for the multi-aquifer well. Possible multi-aquifer well CONDEQN strings include: SPECIFIED--character keyword to indicate the multi-aquifer well saturated conductance will be specified. THIEM--character keyword to indicate the multi-aquifer well saturated conductance will be calculated using the Thiem equation, which considers the cell top and bottom, aquifer hydraulic conductivity, and effective cell and well radius. SKIN--character keyword to indicate that the multi-aquifer well saturated conductance will be calculated using the cell top and bottom, aquifer and screen hydraulic conductivity, and well and skin radius. CUMULATIVE--character keyword to indicate that the multi-aquifer well saturated conductance will be calculated using a combination of the Thiem and SKIN equations. MEAN--character keyword to indicate the multi-aquifer well saturated conductance will be calculated using the aquifer and screen top and bottom, aquifer and screen hydraulic conductivity, and well and skin radius. The CUMULATIVE conductance equation is identical to the SKIN LOSSTYPE in the Multi-Node Well (MNW2) package for MODFLOW-2005. The program will terminate with an error condition if CONDEQN is SKIN or CUMULATIVE and the calculated saturated conductance is less than zero; if an error condition occurs, it is suggested that the THEIM or MEAN conductance equations be used for these multi-aquifer wells. | -| GWF | MAW | PACKAGEDATA | NGWFNODES | INTEGER | integer value that defines the number of GWF nodes connected to this (WELLNO) multi-aquifer well. NGWFNODES must be greater than zero. | +| GWF | MAW | PACKAGEDATA | NGWFNODES | INTEGER | integer value that defines the number of GWF nodes connected to this (IFNO) multi-aquifer well. NGWFNODES must be greater than zero. | | GWF | MAW | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each multi-aquifer well. The values of auxiliary variables must be present for each multi-aquifer well. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | MAW | PACKAGEDATA | BOUNDNAME | STRING | name of the multi-aquifer well cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | -| GWF | MAW | CONNECTIONDATA | WELLNO | INTEGER | integer value that defines the well number associated with the specified CONNECTIONDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. | -| GWF | MAW | CONNECTIONDATA | ICON | INTEGER | integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well WELLNO. | +| GWF | MAW | CONNECTIONDATA | IFNO | INTEGER | integer value that defines the feature (well) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. | +| GWF | MAW | CONNECTIONDATA | ICON | INTEGER | integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well IFNO. | | GWF | MAW | CONNECTIONDATA | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. One or more screened intervals can be connected to the same CELLID if CONDEQN for a well is MEAN. The program will terminate with an error if MAW wells using SPECIFIED, THIEM, SKIN, or CUMULATIVE conductance equations have more than one connection to the same CELLID. | | GWF | MAW | CONNECTIONDATA | SCRN_TOP | DOUBLE PRECISION | value that defines the top elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_TOP can be any value and is set to the top of the cell. If CONDEQN is MEAN, SCRN\_TOP is set to the multi-aquifer well connection cell top if the specified value is greater than the cell top. The program will terminate with an error if the screen top is less than the screen bottom. | -| GWF | MAW | CONNECTIONDATA | SCRN_BOT | DOUBLE PRECISION | value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. | +| GWF | MAW | CONNECTIONDATA | SCRN_BOT | DOUBLE PRECISION | value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value and is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. | | GWF | MAW | CONNECTIONDATA | HK_SKIN | DOUBLE PRECISION | value that defines the skin (filter pack) hydraulic conductivity (if CONDEQN for the multi-aquifer well is SKIN, CUMULATIVE, or MEAN) or conductance (if CONDEQN for the multi-aquifer well is SPECIFIED) for each GWF node connected to the multi-aquifer well (NGWFNODES). If CONDEQN is SPECIFIED, HK\_SKIN must be greater than or equal to zero. HK\_SKIN can be any value if CONDEQN is THIEM. Otherwise, HK\_SKIN must be greater than zero. If CONDEQN is SKIN, the contrast between the cell transmissivity (the product of geometric mean horizontal hydraulic conductivity and the cell thickness) and the well transmissivity (the product of HK\_SKIN and the screen thicknesses) must be greater than one in node CELLID or the program will terminate with an error condition; if an error condition occurs, it is suggested that the HK\_SKIN be reduced to a value less than K11 and K22 in node CELLID or the THEIM or MEAN conductance equations be used for these multi-aquifer wells. | | GWF | MAW | CONNECTIONDATA | RADIUS_SKIN | DOUBLE PRECISION | real value that defines the skin radius (filter pack radius) for the multi-aquifer well. RADIUS\_SKIN can be any value if CONDEQN is SPECIFIED or THIEM. If CONDEQN is SKIN, CUMULATIVE, or MEAN, the program will terminate with an error if RADIUS\_SKIN is less than or equal to the RADIUS for the multi-aquifer well. | | GWF | MAW | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWF | MAW | PERIOD | WELLNO | INTEGER | integer value that defines the well number associated with the specified PERIOD data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. | +| GWF | MAW | PERIOD | IFNO | INTEGER | integer value that defines the well number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. | | GWF | MAW | PERIOD | MAWSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: STATUS, FLOWING\_WELL, RATE, WELL\_HEAD, HEAD\_LIMIT, SHUT\_OFF, RATE\_SCALING, and AUXILIARY. | | GWF | MAW | PERIOD | STATUS | STRING | keyword option to define well status. STATUS can be ACTIVE, INACTIVE, or CONSTANT. By default, STATUS is ACTIVE. | | GWF | MAW | PERIOD | FLOWING_WELL | KEYWORD | keyword to indicate the well is a flowing well. The FLOWING\_WELL option can be used to simulate flowing wells when the simulated well head exceeds the specified drainage elevation. | | GWF | MAW | PERIOD | FWELEV | DOUBLE PRECISION | elevation used to determine whether or not the well is flowing. | | GWF | MAW | PERIOD | FWCOND | DOUBLE PRECISION | conductance used to calculate the discharge of a free flowing well. Flow occurs when the head in the well is above the well top elevation (FWELEV). | | GWF | MAW | PERIOD | FWRLEN | DOUBLE PRECISION | length used to reduce the conductance of the flowing well. When the head in the well drops below the well top plus the reduction length, then the conductance is reduced. This reduction length can be used to improve the stability of simulations with flowing wells so that there is not an abrupt change in flowing well rates. | -| GWF | MAW | PERIOD | RATE | DOUBLE PRECISION | is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (IBOUND $>$ 0) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero. | +| GWF | MAW | PERIOD | RATE | DOUBLE PRECISION | is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (STATUS is ACTIVE) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero. | | GWF | MAW | PERIOD | WELL_HEAD | DOUBLE PRECISION | is the head in the multi-aquifer well. WELL\_HEAD is only applied to constant head (STATUS is CONSTANT) and inactive (STATUS is INACTIVE) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. The program will terminate with an error if WELL\_HEAD is less than the bottom of the well. | | GWF | MAW | PERIOD | HEAD_LIMIT | STRING | is the limiting water level (head) in the well, which is the minimum of the well RATE or the well inflow rate from the aquifer. HEAD\_LIMIT can be applied to extraction wells (RATE $<$ 0) or injection wells (RATE $>$ 0). HEAD\_LIMIT can be deactivated by specifying the text string `OFF'. The HEAD\_LIMIT option is based on the HEAD\_LIMIT functionality available in the MNW2~\citep{konikow2009} package for MODFLOW-2005. The HEAD\_LIMIT option has been included to facilitate backward compatibility with previous versions of MODFLOW but use of the RATE\_SCALING option instead of the HEAD\_LIMIT option is recommended. By default, HEAD\_LIMIT is `OFF'. | | GWF | MAW | PERIOD | SHUT_OFF | KEYWORD | keyword for activating well shut off capability. Subsequent values define the minimum and maximum pumping rate that a well must exceed to shutoff or reactivate a well, respectively, during a stress period. SHUT\_OFF is only applied to injection wells (RATE$<0$) and if HEAD\_LIMIT is specified (not set to `OFF'). If HEAD\_LIMIT is specified, SHUT\_OFF can be deactivated by specifying a minimum value equal to zero. The SHUT\_OFF option is based on the SHUT\_OFF functionality available in the MNW2~\citep{konikow2009} package for MODFLOW-2005. The SHUT\_OFF option has been included to facilitate backward compatibility with previous versions of MODFLOW but use of the RATE\_SCALING option instead of the SHUT\_OFF option is recommended. By default, SHUT\_OFF is not used. | @@ -575,32 +577,32 @@ | GWF | SFR | OPTIONS | LENGTH_CONVERSION | DOUBLE PRECISION | real value that is used to convert user-specified Manning's roughness coefficients from meters to model length units. LENGTH\_CONVERSION should be set to 3.28081, 1.0, and 100.0 when using length units (LENGTH\_UNITS) of feet, meters, or centimeters in the simulation, respectively. LENGTH\_CONVERSION does not need to be specified if LENGTH\_UNITS are meters. | | GWF | SFR | OPTIONS | TIME_CONVERSION | DOUBLE PRECISION | real value that is used to convert user-specified Manning's roughness coefficients from seconds to model time units. TIME\_CONVERSION should be set to 1.0, 60.0, 3,600.0, 86,400.0, and 31,557,600.0 when using time units (TIME\_UNITS) of seconds, minutes, hours, days, or years in the simulation, respectively. TIME\_CONVERSION does not need to be specified if TIME\_UNITS are seconds. | | GWF | SFR | DIMENSIONS | NREACHES | INTEGER | integer value specifying the number of stream reaches. There must be NREACHES entries in the PACKAGEDATA block. | -| GWF | SFR | PACKAGEDATA | RNO | INTEGER | integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. | -| GWF | SFR | PACKAGEDATA | CELLID | INTEGER (NCELLDIM) | The keyword `NONE' must be specified for reaches that are not connected to an underlying GWF cell. The keyword `NONE' is used for reaches that are in cells that have IDOMAIN values less than one or are in areas not covered by the GWF model grid. Reach-aquifer flow is not calculated if the keyword `NONE' is specified. | +| GWF | SFR | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. | +| GWF | SFR | PACKAGEDATA | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. For reaches that are not connected to an underlying GWF cell, a zero should be specified for each grid dimension. For example, for a DIS grid a CELLID of 0 0 0 should be specified. Reach-aquifer flow is not calculated for unconnected reaches. The keyword NONE can be still be specified to identify unconnected reaches for backward compatibility with previous versions of MODFLOW 6 but eventually NONE will be deprecated and will cause MODFLOW 6 to terminate with an error. | | GWF | SFR | PACKAGEDATA | RLEN | DOUBLE PRECISION | real value that defines the reach length. RLEN must be greater than zero. | | GWF | SFR | PACKAGEDATA | RWID | DOUBLE PRECISION | real value that defines the reach width. RWID must be greater than zero. | | GWF | SFR | PACKAGEDATA | RGRD | DOUBLE PRECISION | real value that defines the stream gradient (slope) across the reach. RGRD must be greater than zero. | | GWF | SFR | PACKAGEDATA | RTP | DOUBLE PRECISION | real value that defines the bottom elevation of the reach. | -| GWF | SFR | PACKAGEDATA | RBTH | DOUBLE PRECISION | real value that defines the thickness of the reach streambed. RBTH can be any value if CELLID is `NONE'. Otherwise, RBTH must be greater than zero. | -| GWF | SFR | PACKAGEDATA | RHK | DOUBLE PRECISION | real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if CELLID is `NONE'. Otherwise, RHK must be greater than zero. | +| GWF | SFR | PACKAGEDATA | RBTH | DOUBLE PRECISION | real value that defines the thickness of the reach streambed. RBTH can be any value if the reach is not connected to an underlying GWF cell. Otherwise, RBTH must be greater than zero. | +| GWF | SFR | PACKAGEDATA | RHK | DOUBLE PRECISION | real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if the reach is not connected to an underlying GWF cell. Otherwise, RHK must be greater than zero. | | GWF | SFR | PACKAGEDATA | MAN | STRING | real or character value that defines the Manning's roughness coefficient for the reach. MAN must be greater than zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | -| GWF | SFR | PACKAGEDATA | NCON | INTEGER | integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for RNO is still required in the subsequent CONNECTIONDATA block. | +| GWF | SFR | PACKAGEDATA | NCON | INTEGER | integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for IFNO is still required in the subsequent CONNECTIONDATA block. | | GWF | SFR | PACKAGEDATA | USTRF | DOUBLE PRECISION | real value that defines the fraction of upstream flow from each upstream reach that is applied as upstream inflow to the reach. The sum of all USTRF values for all reaches connected to the same upstream reach must be equal to one and USTRF must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | SFR | PACKAGEDATA | NDV | INTEGER | integer value that defines the number of downstream diversions for the reach. | | GWF | SFR | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each stream reach. The values of auxiliary variables must be present for each stream reach. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | SFR | PACKAGEDATA | BOUNDNAME | STRING | name of the stream reach cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | -| GWF | SFR | CROSSSECTIONS | RNO | INTEGER | integer value that defines the reach number associated with the specified cross-section table file on the line. RNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. | +| GWF | SFR | CROSSSECTIONS | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified cross-section table file on the line. IFNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. | | GWF | SFR | CROSSSECTIONS | TAB6 | KEYWORD | keyword to specify that record corresponds to a cross-section table file. | | GWF | SFR | CROSSSECTIONS | FILEIN | KEYWORD | keyword to specify that an input filename is expected next. | | GWF | SFR | CROSSSECTIONS | TAB6_FILENAME | STRING | character string that defines the path and filename for the file containing cross-section table data for the reach. The TAB6\_FILENAME file includes the number of entries in the file and the station elevation data in terms of the fractional width and the reach depth. Instructions for creating the TAB6\_FILENAME input file are provided in SFR Reach Cross-Section Table Input File section. | -| GWF | SFR | CONNECTIONDATA | RNO | INTEGER | integer value that defines the reach number associated with the specified CONNECTIONDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. | -| GWF | SFR | CONNECTIONDATA | IC | INTEGER (NCON(RNO)) | integer value that defines the reach number of the reach connected to the current reach and whether it is connected to the upstream or downstream end of the reach. Negative IC numbers indicate connected reaches are connected to the downstream end of the current reach. Positive IC numbers indicate connected reaches are connected to the upstream end of the current reach. The absolute value of IC must be greater than zero and less than or equal to NREACHES. IC should not be specified when NCON is zero but must be specified otherwise. | -| GWF | SFR | DIVERSIONS | RNO | INTEGER | integer value that defines the reach number associated with the specified DIVERSIONS data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. | -| GWF | SFR | DIVERSIONS | IDV | INTEGER | integer value that defines the downstream diversion number for the diversion for reach RNO. IDV must be greater than zero and less than or equal to NDV for reach RNO. | -| GWF | SFR | DIVERSIONS | ICONR | INTEGER | integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach RNO. | -| GWF | SFR | DIVERSIONS | CPRIOR | STRING | character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach RNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach RNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach RNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach RNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach RNO. If $Q_{DS}$ in reach RNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach RNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach RNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach RNO. | +| GWF | SFR | CONNECTIONDATA | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. | +| GWF | SFR | CONNECTIONDATA | IC | INTEGER (NCON(IFNO)) | integer value that defines the reach number of the reach connected to the current reach and whether it is connected to the upstream or downstream end of the reach. Negative IC numbers indicate connected reaches are connected to the downstream end of the current reach. Positive IC numbers indicate connected reaches are connected to the upstream end of the current reach. The absolute value of IC must be greater than zero and less than or equal to NREACHES. IC should not be specified when NCON is zero but must be specified otherwise. | +| GWF | SFR | DIVERSIONS | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified DIVERSIONS data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. | +| GWF | SFR | DIVERSIONS | IDV | INTEGER | integer value that defines the downstream diversion number for the diversion for reach IFNO. IDV must be greater than zero and less than or equal to NDV for reach IFNO. | +| GWF | SFR | DIVERSIONS | ICONR | INTEGER | integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach IFNO. | +| GWF | SFR | DIVERSIONS | CPRIOR | STRING | character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach IFNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach IFNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach IFNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach IFNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach IFNO. If $Q_{DS}$ in reach IFNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach IFNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach IFNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach IFNO. | | GWF | SFR | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWF | SFR | PERIOD | RNO | INTEGER | integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. | +| GWF | SFR | PERIOD | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. | | GWF | SFR | PERIOD | SFRSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the SFRSETTING string include: STATUS, MANNING, STAGE, INFLOW, RAINFALL, EVAPORATION, RUNOFF, DIVERSION, UPSTREAM\_FRACTION, and AUXILIARY. | | GWF | SFR | PERIOD | STATUS | STRING | keyword option to define stream reach status. STATUS can be ACTIVE, INACTIVE, or SIMPLE. The SIMPLE STATUS option simulates streamflow using a user-specified stage for a reach or a stage set to the top of the reach (depth = 0). In cases where the simulated leakage calculated using the specified stage exceeds the sum of inflows to the reach, the stage is set to the top of the reach and leakage is set equal to the sum of inflows. Upstream fractions should be changed using the UPSTREAM\_FRACTION SFRSETTING if the status for one or more reaches is changed to ACTIVE or INACTIVE. For example, if one of two downstream connections for a reach is inactivated, the upstream fraction for the active and inactive downstream reach should be changed to 1.0 and 0.0, respectively, to ensure that the active reach receives all of the downstream outflow from the upstream reach. By default, STATUS is ACTIVE. | | GWF | SFR | PERIOD | MANNING | STRING | real or character value that defines the Manning's roughness coefficient for the reach. MANNING must be greater than zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -610,7 +612,7 @@ | GWF | SFR | PERIOD | EVAPORATION | STRING | real or character value that defines the volumetric rate per unit area of water subtracted by evaporation from the streamflow routing reach. A positive evaporation rate should be provided. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. If the volumetric evaporation rate for a reach exceeds the sources of water to the reach (upstream and specified inflows, rainfall, and runoff but excluding groundwater leakage into the reach) the volumetric evaporation rate is limited to the sources of water to the reach. By default, evaporation rates are zero for each reach. | | GWF | SFR | PERIOD | RUNOFF | STRING | real or character value that defines the volumetric rate of diffuse overland runoff that enters the streamflow routing reach. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. If the volumetric runoff rate for a reach is negative and exceeds inflows to the reach (upstream and specified inflows, and rainfall but excluding groundwater leakage into the reach) the volumetric runoff rate is limited to inflows to the reach and the volumetric evaporation rate for the reach is set to zero. By default, runoff rates are zero for each reach. | | GWF | SFR | PERIOD | DIVERSION | KEYWORD | keyword to indicate diversion record. | -| GWF | SFR | PERIOD | IDV | INTEGER | an integer value specifying which diversion of reach RNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (RNO). | +| GWF | SFR | PERIOD | IDV | INTEGER | an integer value specifying which diversion of reach IFNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (IFNO). | | GWF | SFR | PERIOD | DIVFLOW | DOUBLE PRECISION | real or character value that defines the volumetric diversion (DIVFLOW) rate for the streamflow routing reach. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | SFR | PERIOD | UPSTREAM_FRACTION | DOUBLE PRECISION | real value that defines the fraction of upstream flow (USTRF) from each upstream reach that is applied as upstream inflow to the reach. The sum of all USTRF values for all reaches connected to the same upstream reach must be equal to one. | | GWF | SFR | PERIOD | CROSS_SECTION | KEYWORD | keyword to specify that record corresponds to a reach cross-section. | @@ -649,21 +651,21 @@ | GWF | LAK | DIMENSIONS | NLAKES | INTEGER | value specifying the number of lakes that will be simulated for all stress periods. | | GWF | LAK | DIMENSIONS | NOUTLETS | INTEGER | value specifying the number of outlets that will be simulated for all stress periods. If NOUTLETS is not specified, a default value of zero is used. | | GWF | LAK | DIMENSIONS | NTABLES | INTEGER | value specifying the number of lakes tables that will be used to define the lake stage, volume relation, and surface area. If NTABLES is not specified, a default value of zero is used. | -| GWF | LAK | PACKAGEDATA | LAKENO | INTEGER | integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. | +| GWF | LAK | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. | | GWF | LAK | PACKAGEDATA | STRT | DOUBLE PRECISION | real value that defines the starting stage for the lake. | -| GWF | LAK | PACKAGEDATA | NLAKECONN | INTEGER | integer value that defines the number of GWF cells connected to this (LAKENO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. | +| GWF | LAK | PACKAGEDATA | NLAKECONN | INTEGER | integer value that defines the number of GWF cells connected to this (IFNO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. | | GWF | LAK | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each lake. The values of auxiliary variables must be present for each lake. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | LAK | PACKAGEDATA | BOUNDNAME | STRING | name of the lake cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | -| GWF | LAK | CONNECTIONDATA | LAKENO | INTEGER | integer value that defines the lake number associated with the specified CONNECTIONDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. | -| GWF | LAK | CONNECTIONDATA | ICONN | INTEGER | integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake LAKENO. | +| GWF | LAK | CONNECTIONDATA | IFNO | INTEGER | integer value that defines the feature (lake) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. | +| GWF | LAK | CONNECTIONDATA | ICONN | INTEGER | integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake IFNO. | | GWF | LAK | CONNECTIONDATA | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. | | GWF | LAK | CONNECTIONDATA | CLAKTYPE | STRING | character string that defines the lake-GWF connection type for the lake connection. Possible lake-GWF connection type strings include: VERTICAL--character keyword to indicate the lake-GWF connection is vertical and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{33}$ tensor component defined for CELLID in the NPF package. HORIZONTAL--character keyword to indicate the lake-GWF connection is horizontal and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{11}$ tensor component defined for CELLID in the NPF package. EMBEDDEDH--character keyword to indicate the lake-GWF connection is embedded in a single cell and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{11}$ tensor component defined for CELLID in the NPF package. EMBEDDEDV--character keyword to indicate the lake-GWF connection is embedded in a single cell and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{33}$ tensor component defined for CELLID in the NPF package. Embedded lakes can only be connected to a single cell (NLAKECONN = 1) and there must be a lake table associated with each embedded lake. | -| GWF | LAK | CONNECTIONDATA | BEDLEAK | STRING | character string or real value that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero or specified to be NONE. If BEDLEAK is specified to be NONE, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. | +| GWF | LAK | CONNECTIONDATA | BEDLEAK | STRING | real value or character string that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero, equal to the DNODATA value (3.0E+30), or specified to be NONE. If DNODATA or NONE is specified for BEDLEAK, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. Warning messages will be issued if NONE is specified. Eventually the ability to specify NONE will be deprecated and cause MODFLOW 6 to terminate with an error. | | GWF | LAK | CONNECTIONDATA | BELEV | DOUBLE PRECISION | real value that defines the bottom elevation for a HORIZONTAL lake-GWF connection. Any value can be specified if CLAKTYPE is VERTICAL, EMBEDDEDH, or EMBEDDEDV. If CLAKTYPE is HORIZONTAL and BELEV is not equal to TELEV, BELEV must be greater than or equal to the bottom of the GWF cell CELLID. If BELEV is equal to TELEV, BELEV is reset to the bottom of the GWF cell CELLID. | | GWF | LAK | CONNECTIONDATA | TELEV | DOUBLE PRECISION | real value that defines the top elevation for a HORIZONTAL lake-GWF connection. Any value can be specified if CLAKTYPE is VERTICAL, EMBEDDEDH, or EMBEDDEDV. If CLAKTYPE is HORIZONTAL and TELEV is not equal to BELEV, TELEV must be less than or equal to the top of the GWF cell CELLID. If TELEV is equal to BELEV, TELEV is reset to the top of the GWF cell CELLID. | | GWF | LAK | CONNECTIONDATA | CONNLEN | DOUBLE PRECISION | real value that defines the distance between the connected GWF CELLID node and the lake for a HORIZONTAL, EMBEDDEDH, or EMBEDDEDV lake-GWF connection. CONLENN must be greater than zero for a HORIZONTAL, EMBEDDEDH, or EMBEDDEDV lake-GWF connection. Any value can be specified if CLAKTYPE is VERTICAL. | | GWF | LAK | CONNECTIONDATA | CONNWIDTH | DOUBLE PRECISION | real value that defines the connection face width for a HORIZONTAL lake-GWF connection. CONNWIDTH must be greater than zero for a HORIZONTAL lake-GWF connection. Any value can be specified if CLAKTYPE is VERTICAL, EMBEDDEDH, or EMBEDDEDV. | -| GWF | LAK | TABLES | LAKENO | INTEGER | integer value that defines the lake number associated with the specified TABLES data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. | +| GWF | LAK | TABLES | IFNO | INTEGER | integer value that defines the feature (lake) number associated with the specified TABLES data on the line. IFNO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. | | GWF | LAK | TABLES | TAB6 | KEYWORD | keyword to specify that record corresponds to a table file. | | GWF | LAK | TABLES | FILEIN | KEYWORD | keyword to specify that an input filename is expected next. | | GWF | LAK | TABLES | TAB6_FILENAME | STRING | character string that defines the path and filename for the file containing lake table data for the lake connection. The TAB6\_FILENAME file includes the number of entries in the file and the relation between stage, volume, and surface area for each entry in the file. Lake table files for EMBEDDEDH and EMBEDDEDV lake-GWF connections also include lake-GWF exchange area data for each entry in the file. Instructions for creating the TAB6\_FILENAME input file are provided in Lake Table Input File section. | @@ -685,7 +687,7 @@ | GWF | LAK | PERIOD | RUNOFF | STRING | real or character value that defines the runoff rate $(L^3 T^{-1})$ for the lake. Value must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | LAK | PERIOD | INFLOW | STRING | real or character value that defines the volumetric inflow rate $(L^3 T^{-1})$ for the lake. Value must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, inflow rates are zero for each lake. | | GWF | LAK | PERIOD | WITHDRAWAL | STRING | real or character value that defines the maximum withdrawal rate $(L^3 T^{-1})$ for the lake. Value must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | -| GWF | LAK | PERIOD | RATE | STRING | real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to active (IBOUND $>$ 0) lakes. A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero. | +| GWF | LAK | PERIOD | RATE | STRING | real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to outlets associated with active lakes (STATUS is ACTIVE). A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero. | | GWF | LAK | PERIOD | INVERT | STRING | real or character value that defines the invert elevation for the lake outlet. A specified INVERT value is only used for active lakes if COUTTYPE for lake outlet OUTLETNO is not SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | LAK | PERIOD | ROUGH | STRING | real value that defines the roughness coefficient for the lake outlet. Any value can be specified if COUTTYPE is not MANNING. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | LAK | PERIOD | WIDTH | STRING | real or character value that defines the width of the lake outlet. A specified WIDTH value is only used for active lakes if COUTTYPE for lake outlet OUTLETNO is not SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -723,7 +725,7 @@ | GWF | UZF | DIMENSIONS | NUZFCELLS | INTEGER | is the number of UZF cells. More than one UZF cell can be assigned to a GWF cell; however, only one GWF cell can be assigned to a single UZF cell. If more than one UZF cell is assigned to a GWF cell, then an auxiliary variable should be used to reduce the surface area of the UZF cell with the AUXMULTNAME option. | | GWF | UZF | DIMENSIONS | NTRAILWAVES | INTEGER | is the number of trailing waves. A recommended value of 7 can be used for NTRAILWAVES. This value can be increased to lower mass balance error in the unsaturated zone. | | GWF | UZF | DIMENSIONS | NWAVESETS | INTEGER | is the number of wave sets. A recommended value of 40 can be used for NWAVESETS. This value can be increased if more waves are required to resolve variations in water content within the unsaturated zone. | -| GWF | UZF | PACKAGEDATA | IUZNO | INTEGER | integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. IUZNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. | +| GWF | UZF | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. | | GWF | UZF | PACKAGEDATA | CELLID | INTEGER (NCELLDIM) | is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. | | GWF | UZF | PACKAGEDATA | LANDFLAG | INTEGER | integer value set to one for land surface cells indicating that boundary conditions can be applied and data can be specified in the PERIOD block. A value of 0 specifies a non-land surface cell. | | GWF | UZF | PACKAGEDATA | IVERTCON | INTEGER | integer value set to specify underlying UZF cell that receives water flowing to bottom of cell. If unsaturated zone flow reaches the water table before the cell bottom, then water is added to the GWF cell instead of flowing to the underlying UZF cell. A value of 0 indicates the UZF cell is not connected to an underlying UZF cell. | @@ -735,7 +737,7 @@ | GWF | UZF | PACKAGEDATA | EPS | DOUBLE PRECISION | is the exponent used in the Brooks-Corey function. The Brooks-Corey function is used by UZF to calculated hydraulic conductivity under partially saturated conditions as a function of water content and the user-specified saturated hydraulic conductivity. | | GWF | UZF | PACKAGEDATA | BOUNDNAME | STRING | name of the UZF cell cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | | GWF | UZF | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWF | UZF | PERIOD | IUZNO | INTEGER | integer value that defines the UZF cell number associated with the specified PERIOD data on the line. | +| GWF | UZF | PERIOD | IFNO | INTEGER | integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. | | GWF | UZF | PERIOD | FINF | STRING | real or character value that defines the applied infiltration rate of the UZF cell ($LT^{-1}$). If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | UZF | PERIOD | PET | STRING | real or character value that defines the potential evapotranspiration rate of the UZF cell and specified GWF cell. Evapotranspiration is first removed from the unsaturated zone and any remaining potential evapotranspiration is applied to the saturated zone. If IVERTCON is greater than zero then residual potential evapotranspiration not satisfied in the UZF cell is applied to the underlying UZF and GWF cells. PET is always specified, but is only used if SIMULATE\_ET is specified in the OPTIONS block. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWF | UZF | PERIOD | EXTDP | STRING | real or character value that defines the evapotranspiration extinction depth of the UZF cell. If IVERTCON is greater than zero and EXTDP extends below the GWF cell bottom then remaining potential evapotranspiration is applied to the underlying UZF and GWF cells. EXTDP is always specified, but is only used if SIMULATE\_ET is specified in the OPTIONS block. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -938,7 +940,7 @@ | GWT | SSM | OPTIONS | PRINT_FLOWS | KEYWORD | keyword to indicate that the list of SSM flow rates will be printed to the listing file for every stress period time step in which ``BUDGET PRINT'' is specified in Output Control. If there is no Output Control option and ``PRINT\_FLOWS'' is specified, then flow rates are printed for the last time step of each stress period. | | GWT | SSM | OPTIONS | SAVE_FLOWS | KEYWORD | keyword to indicate that SSM flow terms will be written to the file specified with ``BUDGET FILEOUT'' in Output Control. | | GWT | SSM | SOURCES | PNAME | STRING | name of the flow package for which an auxiliary variable contains a source concentration. If this flow package is represented using an advanced transport package (SFT, LKT, MWT, or UZT), then the advanced transport package will override SSM terms specified here. | -| GWT | SSM | SOURCES | SRCTYPE | STRING | keyword indicating how concentration will be assigned for sources and sinks. Keyword must be specified as either AUX or AUXMIXED. For both options the user must provide an auxiliary variable in the corresponding flow package. The auxiliary variable must have the same name as the AUXNAME value that follows. If the AUX keyword is specified, then the auxiliary variable specified by the user will be assigned as the concenration value for groundwater sources (flows with a positive sign). For negative flow rates (sinks), groundwater will be withdrawn from the cell at the simulated concentration of the cell. The AUXMIXED option provides an alternative method for how to determine the concentration of sinks. If the cell concentration is larger than the user-specified auxiliary concentration, then the concentration of groundwater withdrawn from the cell will be assigned as the user-specified concentration. Alternatively, if the user-specified auxiliary concentration is larger than the cell concentration, then groundwater will be withdrawn at the cell concentration. Thus, the AUXMIXED option is designed to work with the Evapotranspiration (EVT) and Recharge (RCH) Packages where water may be withdrawn at a concentration that is less than the cell concentration. | +| GWT | SSM | SOURCES | SRCTYPE | STRING | keyword indicating how concentration will be assigned for sources and sinks. Keyword must be specified as either AUX or AUXMIXED. For both options the user must provide an auxiliary variable in the corresponding flow package. The auxiliary variable must have the same name as the AUXNAME value that follows. If the AUX keyword is specified, then the auxiliary variable specified by the user will be assigned as the concentration value for groundwater sources (flows with a positive sign). For negative flow rates (sinks), groundwater will be withdrawn from the cell at the simulated concentration of the cell. The AUXMIXED option provides an alternative method for how to determine the concentration of sinks. If the cell concentration is larger than the user-specified auxiliary concentration, then the concentration of groundwater withdrawn from the cell will be assigned as the user-specified concentration. Alternatively, if the user-specified auxiliary concentration is larger than the cell concentration, then groundwater will be withdrawn at the cell concentration. Thus, the AUXMIXED option is designed to work with the Evapotranspiration (EVT) and Recharge (RCH) Packages where water may be withdrawn at a concentration that is less than the cell concentration. | | GWT | SSM | SOURCES | AUXNAME | STRING | name of the auxiliary variable in the package PNAME. This auxiliary variable must exist and be specified by the user in that package. The values in this auxiliary variable will be used to set the concentration associated with the flows for that boundary package. | | GWT | SSM | FILEINPUT | PNAME | STRING | name of the flow package for which an SPC6 input file contains a source concentration. If this flow package is represented using an advanced transport package (SFT, LKT, MWT, or UZT), then the advanced transport package will override SSM terms specified here. | | GWT | SSM | FILEINPUT | SPC6 | KEYWORD | keyword to specify that record corresponds to a source sink mixing input file. | @@ -1016,12 +1018,12 @@ | GWT | SFT | OPTIONS | TS6_FILENAME | STRING | defines a time-series file defining time series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-series capability. | | GWT | SFT | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWT | SFT | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the SFT package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the SFT package. | -| GWT | SFT | PACKAGEDATA | RNO | INTEGER | integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. | +| GWT | SFT | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. | | GWT | SFT | PACKAGEDATA | STRT | DOUBLE PRECISION | real value that defines the starting concentration for the reach. | | GWT | SFT | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each reach. The values of auxiliary variables must be present for each reach. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | SFT | PACKAGEDATA | BOUNDNAME | STRING | name of the reach cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | | GWT | SFT | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWT | SFT | PERIOD | RNO | INTEGER | integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. | +| GWT | SFT | PERIOD | IFNO | INTEGER | integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. | | GWT | SFT | PERIOD | REACHSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the REACHSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Streamflow Package supports a ``DIVERSION'' flow term. Diversion water will be routed using the calculated concentration of the reach. | | GWT | SFT | PERIOD | STATUS | STRING | keyword option to define reach status. STATUS can be ACTIVE, INACTIVE, or CONSTANT. By default, STATUS is ACTIVE, which means that concentration will be calculated for the reach. If a reach is inactive, then there will be no solute mass fluxes into or out of the reach and the inactive value will be written for the reach concentration. If a reach is constant, then the concentration for the reach will be fixed at the user specified value. | | GWT | SFT | PERIOD | CONCENTRATION | STRING | real or character value that defines the concentration for the reach. The specified CONCENTRATION is only applied if the reach is a constant concentration reach. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -1052,13 +1054,13 @@ | GWT | LKT | OPTIONS | TS6_FILENAME | STRING | defines a time-series file defining time series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-series capability. | | GWT | LKT | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWT | LKT | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the LKT package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the LKT package. | -| GWT | LKT | PACKAGEDATA | LAKENO | INTEGER | integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. | +| GWT | LKT | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. | | GWT | LKT | PACKAGEDATA | STRT | DOUBLE PRECISION | real value that defines the starting concentration for the lake. | | GWT | LKT | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each lake. The values of auxiliary variables must be present for each lake. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | LKT | PACKAGEDATA | BOUNDNAME | STRING | name of the lake cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | | GWT | LKT | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWT | LKT | PERIOD | LAKENO | INTEGER | integer value that defines the lake number associated with the specified PERIOD data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. | -| GWT | LKT | PERIOD | LAKSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. | +| GWT | LKT | PERIOD | IFNO | INTEGER | integer value that defines the feature (lake) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NLAKES. | +| GWT | LKT | PERIOD | LAKSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, EXT-INFLOW, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. | | GWT | LKT | PERIOD | STATUS | STRING | keyword option to define lake status. STATUS can be ACTIVE, INACTIVE, or CONSTANT. By default, STATUS is ACTIVE, which means that concentration will be calculated for the lake. If a lake is inactive, then there will be no solute mass fluxes into or out of the lake and the inactive value will be written for the lake concentration. If a lake is constant, then the concentration for the lake will be fixed at the user specified value. | | GWT | LKT | PERIOD | CONCENTRATION | STRING | real or character value that defines the concentration for the lake. The specified CONCENTRATION is only applied if the lake is a constant concentration lake. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | LKT | PERIOD | RAINFALL | STRING | real or character value that defines the rainfall solute concentration $(ML^{-3})$ for the lake. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -1088,13 +1090,13 @@ | GWT | MWT | OPTIONS | TS6_FILENAME | STRING | defines a time-series file defining time series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-series capability. | | GWT | MWT | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWT | MWT | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the MWT package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the MWT package. | -| GWT | MWT | PACKAGEDATA | MAWNO | INTEGER | integer value that defines the well number associated with the specified PACKAGEDATA data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. | +| GWT | MWT | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. | | GWT | MWT | PACKAGEDATA | STRT | DOUBLE PRECISION | real value that defines the starting concentration for the well. | | GWT | MWT | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each well. The values of auxiliary variables must be present for each well. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | MWT | PACKAGEDATA | BOUNDNAME | STRING | name of the well cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | | GWT | MWT | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWT | MWT | PERIOD | MAWNO | INTEGER | integer value that defines the well number associated with the specified PERIOD data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. | -| GWT | MWT | PERIOD | MWTSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. | +| GWT | MWT | PERIOD | IFNO | INTEGER | integer value that defines the feature (well) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. | +| GWT | MWT | PERIOD | MWTSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RATE, and AUXILIARY. These settings are used to assign the concentration associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. | | GWT | MWT | PERIOD | STATUS | STRING | keyword option to define well status. STATUS can be ACTIVE, INACTIVE, or CONSTANT. By default, STATUS is ACTIVE, which means that concentration will be calculated for the well. If a well is inactive, then there will be no solute mass fluxes into or out of the well and the inactive value will be written for the well concentration. If a well is constant, then the concentration for the well will be fixed at the user specified value. | | GWT | MWT | PERIOD | CONCENTRATION | STRING | real or character value that defines the concentration for the well. The specified CONCENTRATION is only applied if the well is a constant concentration well. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | MWT | PERIOD | RATE | STRING | real or character value that defines the injection solute concentration $(ML^{-3})$ for the well. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -1121,12 +1123,12 @@ | GWT | UZT | OPTIONS | TS6_FILENAME | STRING | defines a time-series file defining time series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-series capability. | | GWT | UZT | OPTIONS | OBS6 | KEYWORD | keyword to specify that record corresponds to an observations file. | | GWT | UZT | OPTIONS | OBS6_FILENAME | STRING | name of input file to define observations for the UZT package. See the ``Observation utility'' section for instructions for preparing observation input files. Tables \ref{table:gwf-obstypetable} and \ref{table:gwt-obstypetable} lists observation type(s) supported by the UZT package. | -| GWT | UZT | PACKAGEDATA | UZFNO | INTEGER | integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. | +| GWT | UZT | PACKAGEDATA | IFNO | INTEGER | integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. | | GWT | UZT | PACKAGEDATA | STRT | DOUBLE PRECISION | real value that defines the starting concentration for the unsaturated zone flow cell. | | GWT | UZT | PACKAGEDATA | AUX | DOUBLE PRECISION (NAUX) | represents the values of the auxiliary variables for each unsaturated zone flow. The values of auxiliary variables must be present for each unsaturated zone flow. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | | GWT | UZT | PACKAGEDATA | BOUNDNAME | STRING | name of the unsaturated zone flow cell. BOUNDNAME is an ASCII character variable that can contain as many as 40 characters. If BOUNDNAME contains spaces in it, then the entire name must be enclosed within single quotes. | | GWT | UZT | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | -| GWT | UZT | PERIOD | UZFNO | INTEGER | integer value that defines the UZF cell number associated with the specified PERIOD data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. | +| GWT | UZT | PERIOD | IFNO | INTEGER | integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. | | GWT | UZT | PERIOD | UZTSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the UZTSETTING string include: STATUS, CONCENTRATION, INFILTRATION, UZET, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. | | GWT | UZT | PERIOD | STATUS | STRING | keyword option to define UZF cell status. STATUS can be ACTIVE, INACTIVE, or CONSTANT. By default, STATUS is ACTIVE, which means that concentration will be calculated for the UZF cell. If a UZF cell is inactive, then there will be no solute mass fluxes into or out of the UZF cell and the inactive value will be written for the UZF cell concentration. If a UZF cell is constant, then the concentration for the UZF cell will be fixed at the user specified value. | | GWT | UZT | PERIOD | CONCENTRATION | STRING | real or character value that defines the concentration for the unsaturated zone flow cell. The specified CONCENTRATION is only applied if the unsaturated zone flow cell is a constant concentration cell. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. | @@ -1164,7 +1166,7 @@ | UTL | SPC | DIMENSIONS | MAXBOUND | INTEGER | integer value specifying the maximum number of spc cells that will be specified for use during any stress period. | | UTL | SPC | PERIOD | IPER | INTEGER | integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. | | UTL | SPC | PERIOD | BNDNO | INTEGER | integer value that defines the boundary package feature number associated with the specified PERIOD data on the line. BNDNO must be greater than zero and less than or equal to MAXBOUND. | -| UTL | SPC | PERIOD | SPCSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: CONCENTRATION. | +| UTL | SPC | PERIOD | SPCSETTING | KEYSTRING | line of information that is parsed into a keyword and values. Keyword values that can be used to start the SPCSETTING string include: CONCENTRATION. | | UTL | SPC | PERIOD | CONCENTRATION | DOUBLE PRECISION | is the boundary concentration. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the CONCENTRATION for each boundary feature is zero. | | UTL | SPCA | OPTIONS | READASARRAYS | KEYWORD | indicates that array-based input will be used for the SPC Package. This keyword must be specified to use array-based input. | | UTL | SPCA | OPTIONS | PRINT_INPUT | KEYWORD | keyword to indicate that the list of spc information will be written to the listing file immediately after it is read. | diff --git a/doc/mf6io/mf6ivar/mf6ivar.py b/doc/mf6io/mf6ivar/mf6ivar.py index 4d81cdd52f0..27684de1ada 100644 --- a/doc/mf6io/mf6ivar/mf6ivar.py +++ b/doc/mf6io/mf6ivar/mf6ivar.py @@ -129,10 +129,14 @@ import os +from pathlib import Path import sys from collections import OrderedDict import re import shutil +from tempfile import TemporaryDirectory +from typing import Dict, List, Optional, Tuple +from packaging.version import Version VERBOSE = False for arg in sys.argv: @@ -360,6 +364,9 @@ def write_desc(vardict, block, blk_var_list, varexcludeprefix=None): if 'deprecated' in v: if v['deprecated'] != '': addv = False + if 'removed' in v: + if v['removed'] != '': + addv = False if addv: if v['type'] == 'keyword': n = name.upper() @@ -419,6 +426,9 @@ def write_desc_md(vardict, block, blk_var_list, varexcludeprefix=None): if 'deprecated' in v: if v['deprecated'] != '': addv = False + if 'removed' in v: + if v['removed'] != '': + addv = False if addv: if v['type'] == 'keyword': n = name.upper() @@ -603,54 +613,48 @@ def write_md(f, vardict, component, package): def write_appendix(texdir, allblocks): fname = os.path.join(texdir, 'appendixA.tex') - f = open(fname, 'w') - f.write('\\small\n\\begin{longtable}{p{1.5cm} p{1.5cm} p{3cm} c}\n') - f.write( - '\\caption{List of block names organized by component and input file ' - 'type. OPEN/CLOSE indicates whether or not the block information ' - 'can be contained in separate file} \\tabularnewline \n\n') - # f.write( - # '\\caption{List of all possible blocks} \\tabularnewline \n\\endfirsthead \n\n') - # f.write( - # '\\caption*{List of all possible blocks} \\tabularnewline\n\n') - f.write('\\hline\n\\hline\n') - f.write( - '\\textbf{Component} & \\textbf{FTYPE} & \\textbf{Blockname} & \\textbf{OPEN/CLOSE} \\\\\n') - f.write('\\hline\n\\endfirsthead\n\n\n') - - f.write('\captionsetup{textformat=simple}\n') - f.write('\caption*{\\textbf{Table A--\\arabic{table}.}{\quad}List of block' - ' names organized by component and input file type. OPEN/CLOSE ' - 'indicates whether or not the block information can be contained ' - 'in separate file.---Continued} \\tabularnewline\n') - - f.write('\n\\hline\n\\hline\n') - f.write( - '\\textbf{Component} & \\textbf{FTYPE} & \\textbf{Blockname} & \\textbf{OPEN/CLOSE} \\\\\n') - f.write('\\hline\n\\endhead\n\n\\hline\n\\endfoot\n\n\n') - - lastftype = '' - for b in allblocks: - l = b.strip().split('-') - component, ftype, blockname = l - if lastftype != ftype: - f.write('\\hline\n') - oc = 'yes' - if 'griddata' in blockname.lower(): - oc = 'no' - if 'utl' in component.lower() and \ - 'tas' in ftype.lower() and 'time' in blockname.lower(): - oc = 'no' - s = '{} & {} & {} & {} \\\\ \n'.format(component.upper(), - ftype.upper(), - blockname.upper(), oc) - f.write(s) - lastftype = ftype + with open(fname, 'w') as f: + f.write('\\small\n\\begin{longtable}{p{1.5cm} p{1.5cm} p{3cm} c}\n') + f.write( + '\\caption{List of block names organized by component and input file ' + 'type. OPEN/CLOSE indicates whether or not the block information ' + 'can be contained in separate file} \\tabularnewline \n\n') + f.write('\\hline\n\\hline\n') + f.write( + '\\textbf{Component} & \\textbf{FTYPE} & \\textbf{Blockname} & \\textbf{OPEN/CLOSE} \\\\\n') + f.write('\\hline\n\\endfirsthead\n\n\n') + + f.write('\captionsetup{textformat=simple}\n') + f.write('\caption*{\\textbf{Table A--\\arabic{table}.}{\quad}List of block' + ' names organized by component and input file type. OPEN/CLOSE ' + 'indicates whether or not the block information can be contained ' + 'in separate file.---Continued} \\tabularnewline\n') + + f.write('\n\\hline\n\\hline\n') + f.write( + '\\textbf{Component} & \\textbf{FTYPE} & \\textbf{Blockname} & \\textbf{OPEN/CLOSE} \\\\\n') + f.write('\\hline\n\\endhead\n\n\\hline\n\\endfoot\n\n\n') + + lastftype = '' + for b in allblocks: + l = b.strip().split('-') + component, ftype, blockname = l + if lastftype != ftype: + f.write('\\hline\n') + oc = 'yes' + if 'griddata' in blockname.lower(): + oc = 'no' + if 'utl' in component.lower() and \ + 'tas' in ftype.lower() and 'time' in blockname.lower(): + oc = 'no' + s = '{} & {} & {} & {} \\\\ \n'.format(component.upper(), + ftype.upper(), + blockname.upper(), oc) + f.write(s) + lastftype = ftype - f.write( - '\n\n\\hline\n\\end{longtable}\n\\label{table:blocks}\n\\normalsize\n') - f.close() - return + f.write( + '\n\n\\hline\n\\end{longtable}\n\\label{table:blocks}\n\\normalsize\n') if __name__ == '__main__': @@ -737,142 +741,141 @@ def write_appendix(texdir, allblocks): # setup a markdown file fname = os.path.join(mddir, 'mf6ivar.md') - fmd = open(fname, 'w') - write_md_header(fmd) + with open(fname, 'w') as fmd: + write_md_header(fmd) + + # construct list of dfn files to process in the order of file_order + files = os.listdir(dfndir) + for f in files: + if 'common' in f: + continue + if '.DS_Store' in f: + continue + if os.path.splitext(f)[0] not in file_order: + raise Exception('File not in file_order: ', f) + files = [fname + '.dfn' for fname in file_order if fname + '.dfn' in files] + # files = ['gwf-obs.dfn'] + + # # create rst file for markdown + # fpth = os.path.join(docdir, "mf6io.rst") + # frst = open(fpth, "w") + # s = ".. toctree::\n" + # s += " :maxdepth: 4\n" + # s += " :name: mf6-io\n\n" + # frst.write(s) - # construct list of dfn files to process in the order of file_order - files = os.listdir(dfndir) - for f in files: - if 'common' in f: - continue - if '.DS_Store' in f: - continue - if os.path.splitext(f)[0] not in file_order: - raise Exception('File not in file_order: ', f) - files = [fname + '.dfn' for fname in file_order if fname + '.dfn' in files] - # files = ['gwf-obs.dfn'] - - # # create rst file for markdown - # fpth = os.path.join(docdir, "mf6io.rst") - # frst = open(fpth, "w") - # s = ".. toctree::\n" - # s += " :maxdepth: 4\n" - # s += " :name: mf6-io\n\n" - # frst.write(s) - - for txtname in files: - component, package = os.path.splitext(txtname)[0].split('-')[0:2] - vardict = parse_mf6var_file(os.path.join(dfndir, txtname)) - - # make list of unique block names - blocks = [] - for k in vardict: - v = vardict[k] - b = v['block'] - if b not in blocks: - blocks.append(b) - - # add a full block name to allblocks - for block in blocks: - b = '{}-{}-{}'.format(component, package, block) - allblocks.append(b) - - # go through each block and write information - desc = '% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py \n\n' - for b in blocks: - blk_var_list = [] - - # Write the name of the block to the latex file - desc += '\item \\textbf{}\n\n'.format('{Block: ' + b.upper() + '}') - - desc += '\\begin{description}\n' - desc += write_desc(vardict, b, blk_var_list, - varexcludeprefix='dev_') - desc += '\\end{description}\n' - - fname = os.path.join(texdir, os.path.splitext(txtname)[ - 0] + '-' + b + '.dat') + for txtname in files: + component, package = os.path.splitext(txtname)[0].split('-')[0:2] + vardict = parse_mf6var_file(os.path.join(dfndir, txtname)) + + # make list of unique block names + blocks = [] + for k in vardict: + v = vardict[k] + b = v['block'] + if b not in blocks: + blocks.append(b) + + # add a full block name to allblocks + for block in blocks: + b = '{}-{}-{}'.format(component, package, block) + allblocks.append(b) + + # go through each block and write information + desc = '% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py \n\n' + for b in blocks: + blk_var_list = [] + + # Write the name of the block to the latex file + desc += '\item \\textbf{}\n\n'.format('{Block: ' + b.upper() + '}') + + desc += '\\begin{description}\n' + desc += write_desc(vardict, b, blk_var_list, + varexcludeprefix='dev_') + desc += '\\end{description}\n' + + fname = os.path.join(texdir, os.path.splitext(txtname)[ + 0] + '-' + b + '.dat') + f = open(fname, 'w') + s = write_block(vardict, b, blk_var_list, + varexcludeprefix='dev_') + '\n' + f.write(s) + if VERBOSE: + print(s) + f.close() + fname = os.path.join(texdir, + os.path.splitext(txtname)[0] + '-desc' + '.tex') f = open(fname, 'w') - s = write_block(vardict, b, blk_var_list, - varexcludeprefix='dev_') + '\n' + s = desc + '\n' f.write(s) if VERBOSE: print(s) f.close() - fname = os.path.join(texdir, - os.path.splitext(txtname)[0] + '-desc' + '.tex') - f = open(fname, 'w') - s = desc + '\n' - f.write(s) - if VERBOSE: - print(s) - f.close() - - # write markdown description - mdname = os.path.splitext(txtname)[0] - fname = os.path.join(docdir, mdname + '.md') - f = open(fname, 'w') - f.write("### {}\n\n".format(mdname.upper())) - f.write("#### Structure of Blocks\n\n") - f.write("_FOR EACH SIMULATION_\n\n") - desc = "" - for b in blocks: - blk_var_list = [] - - # Write the name of the block to the latex file - desc += '##### Block: {}\n\n'.format(b.upper()) - - desc += write_desc_md(vardict, b, blk_var_list, - varexcludeprefix='dev_') - - if "period" in b.lower(): - f.write("\n_FOR ANY STRESS PERIOD_\n\n") - f.write("```\n") - s = md_replace(write_block(vardict, b, blk_var_list, - varexcludeprefix='dev_', - indent=4)) + "\n" - # s = s.replace("@", "") + "\n" - f.write(s) - f.write("```\n") - if VERBOSE: - print(s) - - f.write("\n#### Explanation of Variables\n\n") - f.write(desc) - - # add examples - s = get_examples(mdname) - if len(s) > 0: - f.write(s) - # add observation table - s = get_obs_table(mdname) - if len(s) > 0: - f.write(s) - - # add observation examples - s = get_obs_examples(mdname) - if len(s) > 0: - f.write(s) - - # close the markdown file - f.close() + # write markdown description + mdname = os.path.splitext(txtname)[0] + fname = os.path.join(docdir, mdname + '.md') + f = open(fname, 'w') + f.write("### {}\n\n".format(mdname.upper())) + f.write("#### Structure of Blocks\n\n") + f.write("_FOR EACH SIMULATION_\n\n") + desc = "" + for b in blocks: + blk_var_list = [] + + # Write the name of the block to the latex file + desc += '##### Block: {}\n\n'.format(b.upper()) + + desc += write_desc_md(vardict, b, blk_var_list, + varexcludeprefix='dev_') + + if "period" in b.lower(): + f.write("\n_FOR ANY STRESS PERIOD_\n\n") + f.write("```\n") + s = md_replace(write_block(vardict, b, blk_var_list, + varexcludeprefix='dev_', + indent=4)) + "\n" + # s = s.replace("@", "") + "\n" + f.write(s) + f.write("```\n") + if VERBOSE: + print(s) + + f.write("\n#### Explanation of Variables\n\n") + f.write(desc) + + # add examples + s = get_examples(mdname) + if len(s) > 0: + f.write(s) + + # add observation table + s = get_obs_table(mdname) + if len(s) > 0: + f.write(s) + + # add observation examples + s = get_obs_examples(mdname) + if len(s) > 0: + f.write(s) + + # close the markdown file + f.close() - # # add to rst catalog - # s = " {}\n".format(os.path.basename(fname)) - # frst.write(s) + # # add to rst catalog + # s = " {}\n".format(os.path.basename(fname)) + # frst.write(s) - # write markdown - write_md(fmd, vardict, component, package) + # write markdown + write_md(fmd, vardict, component, package) - # # close restart catalog - # frst.write("\n\n") - # frst.close() + # # close restart catalog + # frst.write("\n\n") + # frst.close() - if VERBOSE: - for b in allblocks: - print(b) - write_appendix(texdir, allblocks) + if VERBOSE: + for b in allblocks: + print(b) + write_appendix(texdir, allblocks) - # markdown close - fmd.close() + diff --git a/doc/mf6io/mf6ivar/readme.md b/doc/mf6io/mf6ivar/readme.md index 3a78c3273fa..f373fffc9dc 100644 --- a/doc/mf6io/mf6ivar/readme.md +++ b/doc/mf6io/mf6ivar/readme.md @@ -693,3 +693,5 @@ In the description attribute, the capital REPLACE instructs the processor to rep The Python script [mf6ivar.py](mf6ivar.py) will process all of the definition files and create a markdown file, latex files of the variable descriptions, and text files containing the blocks. +# Deprecations +The Python script [deprecations.py](deprecations.py) will search definition files for `deprecated` or `removed` options and create a markdown file containing a table of deprecations and removals. \ No newline at end of file diff --git a/doc/mf6io/mf6ivar/tex/gwf-disu-cell2d.dat b/doc/mf6io/mf6ivar/tex/gwf-disu-cell2d.dat index 27900d67235..f6d08961367 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-disu-cell2d.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-disu-cell2d.dat @@ -1,5 +1,5 @@ BEGIN CELL2D + [ - - ... + ...] END CELL2D diff --git a/doc/mf6io/mf6ivar/tex/gwf-disu-vertices.dat b/doc/mf6io/mf6ivar/tex/gwf-disu-vertices.dat index 6831f23b5ff..a4bc80c5453 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-disu-vertices.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-disu-vertices.dat @@ -1,5 +1,5 @@ BEGIN VERTICES + [ - - ... + ...] END VERTICES diff --git a/doc/mf6io/mf6ivar/tex/gwf-evt-period.dat b/doc/mf6io/mf6ivar/tex/gwf-evt-period.dat index 380761217d9..8b5288455ce 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-evt-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-evt-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - <@surface@> <@rate@> <@depth@> <@pxdp(nseg-1)@> <@petm(nseg-1)@> [<@petm0@>] [<@aux(naux)@>] [] - <@surface@> <@rate@> <@depth@> <@pxdp(nseg-1)@> <@petm(nseg-1)@> [<@petm0@>] [<@aux(naux)@>] [] + <@surface@> <@rate@> <@depth@> [<@pxdp(nseg-1)@>] [<@petm(nseg-1)@>] [<@petm0@>] [<@aux(naux)@>] [] + <@surface@> <@rate@> <@depth@> [<@pxdp(nseg-1)@>] [<@petm(nseg-1)@>] [<@petm0@>] [<@aux(naux)@>] [] ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex index 3dbded6c6c1..987b185558b 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex @@ -37,11 +37,11 @@ \item \texttt{surface}---is the elevation of the ET surface ($L$). -\item \texttt{rate}---is the maximum ET flux rate ($LT^{-1}$). +\item \textcolor{blue}{\texttt{rate}---is the maximum ET flux rate ($LT^{-1}$).} \item \texttt{depth}---is the ET extinction depth ($L$). -\item \texttt{aux(iaux)}---is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array. +\item \textcolor{blue}{\texttt{aux}---is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array.} \end{description} diff --git a/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat b/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat index 2fe138e798b..185b433f84e 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat @@ -7,6 +7,6 @@ BEGIN PERIOD -- READARRAY DEPTH -- READARRAY - AUX(IAUX) - -- READARRAY + AUX + -- READARRAY END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-lak-connectiondata.dat b/doc/mf6io/mf6ivar/tex/gwf-lak-connectiondata.dat index 4a5c586a689..aaab3cb1544 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-lak-connectiondata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-lak-connectiondata.dat @@ -1,5 +1,5 @@ BEGIN CONNECTIONDATA - - + + ... END CONNECTIONDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-lak-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-lak-desc.tex index ad5ac4b7d71..5db6336bb82 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-lak-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-lak-desc.tex @@ -69,11 +69,11 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{lakeno}---integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. \item \texttt{strt}---real value that defines the starting stage for the lake. -\item \texttt{nlakeconn}---integer value that defines the number of GWF cells connected to this (LAKENO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. +\item \texttt{nlakeconn}---integer value that defines the number of GWF cells connected to this (IFNO) lake. There can only be one vertical lake connection to each GWF cell. NLAKECONN must be greater than zero. \item \textcolor{blue}{\texttt{aux}---represents the values of the auxiliary variables for each lake. The values of auxiliary variables must be present for each lake. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} @@ -83,15 +83,15 @@ \item \textbf{Block: CONNECTIONDATA} \begin{description} -\item \texttt{lakeno}---integer value that defines the lake number associated with the specified CONNECTIONDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (lake) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake connection information must be specified for every lake connection to the GWF model (NLAKECONN) or the program will terminate with an error. The program will also terminate with an error if connection information for a lake connection to the GWF model is specified more than once. -\item \texttt{iconn}---integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake LAKENO. +\item \texttt{iconn}---integer value that defines the GWF connection number for this lake connection entry. ICONN must be greater than zero and less than or equal to NLAKECONN for lake IFNO. \item \texttt{cellid}---is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. \item \texttt{claktype}---character string that defines the lake-GWF connection type for the lake connection. Possible lake-GWF connection type strings include: VERTICAL--character keyword to indicate the lake-GWF connection is vertical and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{33}$ tensor component defined for CELLID in the NPF package. HORIZONTAL--character keyword to indicate the lake-GWF connection is horizontal and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{11}$ tensor component defined for CELLID in the NPF package. EMBEDDEDH--character keyword to indicate the lake-GWF connection is embedded in a single cell and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{11}$ tensor component defined for CELLID in the NPF package. EMBEDDEDV--character keyword to indicate the lake-GWF connection is embedded in a single cell and connection conductance calculations use the hydraulic conductivity corresponding to the $K_{33}$ tensor component defined for CELLID in the NPF package. Embedded lakes can only be connected to a single cell (NLAKECONN = 1) and there must be a lake table associated with each embedded lake. -\item \texttt{bedleak}---character string or real value that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero or specified to be NONE. If BEDLEAK is specified to be NONE, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. +\item \texttt{bedleak}---real value or character string that defines the bed leakance for the lake-GWF connection. BEDLEAK must be greater than or equal to zero, equal to the DNODATA value (3.0E+30), or specified to be NONE. If DNODATA or NONE is specified for BEDLEAK, the lake-GWF connection conductance is solely a function of aquifer properties in the connected GWF cell and lakebed sediments are assumed to be absent. Warning messages will be issued if NONE is specified. Eventually the ability to specify NONE will be deprecated and cause MODFLOW 6 to terminate with an error. \item \texttt{belev}---real value that defines the bottom elevation for a HORIZONTAL lake-GWF connection. Any value can be specified if CLAKTYPE is VERTICAL, EMBEDDEDH, or EMBEDDEDV. If CLAKTYPE is HORIZONTAL and BELEV is not equal to TELEV, BELEV must be greater than or equal to the bottom of the GWF cell CELLID. If BELEV is equal to TELEV, BELEV is reset to the bottom of the GWF cell CELLID. @@ -105,7 +105,7 @@ \item \textbf{Block: TABLES} \begin{description} -\item \texttt{lakeno}---integer value that defines the lake number associated with the specified TABLES data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. +\item \texttt{ifno}---integer value that defines the feature (lake) number associated with the specified TABLES data on the line. IFNO must be greater than zero and less than or equal to NLAKES. The program will terminate with an error if table information for a lake is specified more than once or the number of specified tables is less than NTABLES. \item \texttt{TAB6}---keyword to specify that record corresponds to a table file. @@ -173,7 +173,7 @@ \item \textcolor{blue}{\texttt{withdrawal}---real or character value that defines the maximum withdrawal rate $(L^3 T^{-1})$ for the lake. Value must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} -\item \textcolor{blue}{\texttt{rate}---real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to active (IBOUND $>$ 0) lakes. A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero.} +\item \textcolor{blue}{\texttt{rate}---real or character value that defines the extraction rate for the lake outflow. A positive value indicates inflow and a negative value indicates outflow from the lake. RATE only applies to outlets associated with active lakes (STATUS is ACTIVE). A specified RATE is only applied if COUTTYPE for the OUTLETNO is SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each SPECIFIED lake outlet is zero.} \item \textcolor{blue}{\texttt{invert}---real or character value that defines the invert elevation for the lake outlet. A specified INVERT value is only used for active lakes if COUTTYPE for lake outlet OUTLETNO is not SPECIFIED. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} diff --git a/doc/mf6io/mf6ivar/tex/gwf-lak-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwf-lak-packagedata.dat index 7ef345a403f..11adb3c02eb 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-lak-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-lak-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-lak-tables.dat b/doc/mf6io/mf6ivar/tex/gwf-lak-tables.dat index b009e0b0d41..e81e4988592 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-lak-tables.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-lak-tables.dat @@ -1,5 +1,5 @@ BEGIN TABLES - TAB6 FILEIN - TAB6 FILEIN + TAB6 FILEIN + TAB6 FILEIN ... END TABLES diff --git a/doc/mf6io/mf6ivar/tex/gwf-maw-connectiondata.dat b/doc/mf6io/mf6ivar/tex/gwf-maw-connectiondata.dat index 2ca671003dc..9f20aa841b5 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-maw-connectiondata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-maw-connectiondata.dat @@ -1,5 +1,5 @@ BEGIN CONNECTIONDATA - - + + ... END CONNECTIONDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-maw-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-maw-desc.tex index abb1023e655..d3648dc02e9 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-maw-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-maw-desc.tex @@ -65,7 +65,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{wellno}---integer value that defines the well number associated with the specified PACKAGEDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well information must be specified for every multi-aquifer well or the program will terminate with an error. The program will also terminate with an error if information for a multi-aquifer well is specified more than once. \item \texttt{radius}---radius for the multi-aquifer well. The program will terminate with an error if the radius is less than or equal to zero. @@ -75,7 +75,7 @@ \item \texttt{condeqn}---character string that defines the conductance equation that is used to calculate the saturated conductance for the multi-aquifer well. Possible multi-aquifer well CONDEQN strings include: SPECIFIED--character keyword to indicate the multi-aquifer well saturated conductance will be specified. THIEM--character keyword to indicate the multi-aquifer well saturated conductance will be calculated using the Thiem equation, which considers the cell top and bottom, aquifer hydraulic conductivity, and effective cell and well radius. SKIN--character keyword to indicate that the multi-aquifer well saturated conductance will be calculated using the cell top and bottom, aquifer and screen hydraulic conductivity, and well and skin radius. CUMULATIVE--character keyword to indicate that the multi-aquifer well saturated conductance will be calculated using a combination of the Thiem and SKIN equations. MEAN--character keyword to indicate the multi-aquifer well saturated conductance will be calculated using the aquifer and screen top and bottom, aquifer and screen hydraulic conductivity, and well and skin radius. The CUMULATIVE conductance equation is identical to the SKIN LOSSTYPE in the Multi-Node Well (MNW2) package for MODFLOW-2005. The program will terminate with an error condition if CONDEQN is SKIN or CUMULATIVE and the calculated saturated conductance is less than zero; if an error condition occurs, it is suggested that the THEIM or MEAN conductance equations be used for these multi-aquifer wells. -\item \texttt{ngwfnodes}---integer value that defines the number of GWF nodes connected to this (WELLNO) multi-aquifer well. NGWFNODES must be greater than zero. +\item \texttt{ngwfnodes}---integer value that defines the number of GWF nodes connected to this (IFNO) multi-aquifer well. NGWFNODES must be greater than zero. \item \textcolor{blue}{\texttt{aux}---represents the values of the auxiliary variables for each multi-aquifer well. The values of auxiliary variables must be present for each multi-aquifer well. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. If the package supports time series and the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} @@ -85,15 +85,15 @@ \item \textbf{Block: CONNECTIONDATA} \begin{description} -\item \texttt{wellno}---integer value that defines the well number associated with the specified CONNECTIONDATA data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (well) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Multi-aquifer well connection information must be specified for every multi-aquifer well connection to the GWF model (NGWFNODES) or the program will terminate with an error. The program will also terminate with an error if connection information for a multi-aquifer well connection to the GWF model is specified more than once. -\item \texttt{icon}---integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well WELLNO. +\item \texttt{icon}---integer value that defines the GWF connection number for this multi-aquifer well connection entry. ICONN must be greater than zero and less than or equal to NGWFNODES for multi-aquifer well IFNO. \item \texttt{cellid}---is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. One or more screened intervals can be connected to the same CELLID if CONDEQN for a well is MEAN. The program will terminate with an error if MAW wells using SPECIFIED, THIEM, SKIN, or CUMULATIVE conductance equations have more than one connection to the same CELLID. \item \texttt{scrn\_top}---value that defines the top elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_TOP can be any value and is set to the top of the cell. If CONDEQN is MEAN, SCRN\_TOP is set to the multi-aquifer well connection cell top if the specified value is greater than the cell top. The program will terminate with an error if the screen top is less than the screen bottom. -\item \texttt{scrn\_bot}---value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. +\item \texttt{scrn\_bot}---value that defines the bottom elevation of the screen for the multi-aquifer well connection. If CONDEQN is SPECIFIED, THIEM, SKIN, or COMPOSITE, SCRN\_BOT can be any value and is set to the bottom of the cell. If CONDEQN is MEAN, SCRN\_BOT is set to the multi-aquifer well connection cell bottom if the specified value is less than the cell bottom. The program will terminate with an error if the screen bottom is greater than the screen top. \item \texttt{hk\_skin}---value that defines the skin (filter pack) hydraulic conductivity (if CONDEQN for the multi-aquifer well is SKIN, CUMULATIVE, or MEAN) or conductance (if CONDEQN for the multi-aquifer well is SPECIFIED) for each GWF node connected to the multi-aquifer well (NGWFNODES). If CONDEQN is SPECIFIED, HK\_SKIN must be greater than or equal to zero. HK\_SKIN can be any value if CONDEQN is THIEM. Otherwise, HK\_SKIN must be greater than zero. If CONDEQN is SKIN, the contrast between the cell transmissivity (the product of geometric mean horizontal hydraulic conductivity and the cell thickness) and the well transmissivity (the product of HK\_SKIN and the screen thicknesses) must be greater than one in node CELLID or the program will terminate with an error condition; if an error condition occurs, it is suggested that the HK\_SKIN be reduced to a value less than K11 and K22 in node CELLID or the THEIM or MEAN conductance equations be used for these multi-aquifer wells. @@ -105,7 +105,7 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{wellno}---integer value that defines the well number associated with the specified PERIOD data on the line. WELLNO must be greater than zero and less than or equal to NMAWWELLS. +\item \texttt{ifno}---integer value that defines the well number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. \item \texttt{mawsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: STATUS, FLOWING\_WELL, RATE, WELL\_HEAD, HEAD\_LIMIT, SHUT\_OFF, RATE\_SCALING, and AUXILIARY. @@ -130,7 +130,7 @@ \item \texttt{fwrlen}---length used to reduce the conductance of the flowing well. When the head in the well drops below the well top plus the reduction length, then the conductance is reduced. This reduction length can be used to improve the stability of simulations with flowing wells so that there is not an abrupt change in flowing well rates. -\item \textcolor{blue}{\texttt{rate}---is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (IBOUND $>$ 0) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero.} +\item \textcolor{blue}{\texttt{rate}---is the volumetric pumping rate for the multi-aquifer well. A positive value indicates recharge and a negative value indicates discharge (pumping). RATE only applies to active (STATUS is ACTIVE) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. By default, the RATE for each multi-aquifer well is zero.} \item \textcolor{blue}{\texttt{well\_head}---is the head in the multi-aquifer well. WELL\_HEAD is only applied to constant head (STATUS is CONSTANT) and inactive (STATUS is INACTIVE) multi-aquifer wells. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value. The program will terminate with an error if WELL\_HEAD is less than the bottom of the well.} diff --git a/doc/mf6io/mf6ivar/tex/gwf-maw-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwf-maw-packagedata.dat index 087d9728c06..da714ff562a 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-maw-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-maw-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-maw-period.dat b/doc/mf6io/mf6ivar/tex/gwf-maw-period.dat index 767f7419bee..9b67c1b650f 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-maw-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-maw-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex index c8ed6e6cda9..a3230eee906 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex @@ -21,7 +21,7 @@ \item \texttt{FILEIN}---keyword to specify that an input filename is expected next. -\item \texttt{tas6\_filename}---defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the Time-Variable Input section for instructions on using the time-array series capability. +\item \texttt{tas6\_filename}---defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-array series capability. \item \texttt{OBS6}---keyword to specify that record corresponds to an observations file. @@ -35,9 +35,9 @@ \item \texttt{irch}---IRCH is the layer number that defines the layer in each vertical column where recharge is applied. If IRCH is omitted, recharge by default is applied to cells in layer 1. IRCH can only be used if READASARRAYS is specified in the OPTIONS block. If IRCH is specified, it must be specified as the first variable in the PERIOD block or MODFLOW will terminate with an error. -\item \texttt{recharge}---is the recharge flux rate ($LT^{-1}$). This rate is multiplied inside the program by the surface area of the cell to calculate the volumetric recharge rate. The recharge array may be defined by a time-array series (see the "Using Time-Array Series in a Package" section). +\item \textcolor{blue}{\texttt{recharge}---is the recharge flux rate ($LT^{-1}$). This rate is multiplied inside the program by the surface area of the cell to calculate the volumetric recharge rate. The recharge array may be defined by a time-array series (see the "Using Time-Array Series in a Package" section).} -\item \texttt{aux}---is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array. +\item \textcolor{blue}{\texttt{aux}---is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array.} \end{description} diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-connectiondata.dat b/doc/mf6io/mf6ivar/tex/gwf-sfr-connectiondata.dat index 142b8e1035d..0b5fa83dad4 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-connectiondata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-connectiondata.dat @@ -1,5 +1,5 @@ BEGIN CONNECTIONDATA - [] - [] + [] + [] ... END CONNECTIONDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-crosssections.dat b/doc/mf6io/mf6ivar/tex/gwf-sfr-crosssections.dat index 83c6790a27c..8b38fa33781 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-crosssections.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-crosssections.dat @@ -1,5 +1,5 @@ BEGIN CROSSSECTIONS - TAB6 FILEIN - TAB6 FILEIN + TAB6 FILEIN + TAB6 FILEIN ... END CROSSSECTIONS diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-sfr-desc.tex index b0664a7f91f..2f72a3458a2 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-desc.tex @@ -65,9 +65,9 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{rno}---integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. -\item \texttt{cellid}---The keyword `NONE' must be specified for reaches that are not connected to an underlying GWF cell. The keyword `NONE' is used for reaches that are in cells that have IDOMAIN values less than one or are in areas not covered by the GWF model grid. Reach-aquifer flow is not calculated if the keyword `NONE' is specified. +\item \texttt{cellid}---is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. For reaches that are not connected to an underlying GWF cell, a zero should be specified for each grid dimension. For example, for a DIS grid a CELLID of 0 0 0 should be specified. Reach-aquifer flow is not calculated for unconnected reaches. The keyword NONE can be still be specified to identify unconnected reaches for backward compatibility with previous versions of MODFLOW 6 but eventually NONE will be deprecated and will cause MODFLOW 6 to terminate with an error. \item \texttt{rlen}---real value that defines the reach length. RLEN must be greater than zero. @@ -77,13 +77,13 @@ \item \texttt{rtp}---real value that defines the bottom elevation of the reach. -\item \texttt{rbth}---real value that defines the thickness of the reach streambed. RBTH can be any value if CELLID is `NONE'. Otherwise, RBTH must be greater than zero. +\item \texttt{rbth}---real value that defines the thickness of the reach streambed. RBTH can be any value if the reach is not connected to an underlying GWF cell. Otherwise, RBTH must be greater than zero. -\item \texttt{rhk}---real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if CELLID is `NONE'. Otherwise, RHK must be greater than zero. +\item \texttt{rhk}---real value that defines the hydraulic conductivity of the reach streambed. RHK can be any positive value if the reach is not connected to an underlying GWF cell. Otherwise, RHK must be greater than zero. \item \textcolor{blue}{\texttt{man}---real or character value that defines the Manning's roughness coefficient for the reach. MAN must be greater than zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} -\item \texttt{ncon}---integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for RNO is still required in the subsequent CONNECTIONDATA block. +\item \texttt{ncon}---integer value that defines the number of reaches connected to the reach. If a value of zero is specified for NCON an entry for IFNO is still required in the subsequent CONNECTIONDATA block. \item \textcolor{blue}{\texttt{ustrf}---real value that defines the fraction of upstream flow from each upstream reach that is applied as upstream inflow to the reach. The sum of all USTRF values for all reaches connected to the same upstream reach must be equal to one and USTRF must be greater than or equal to zero. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} @@ -97,7 +97,7 @@ \item \textbf{Block: CROSSSECTIONS} \begin{description} -\item \texttt{rno}---integer value that defines the reach number associated with the specified cross-section table file on the line. RNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified cross-section table file on the line. IFNO must be greater than zero and less than or equal to NREACHES. The program will also terminate with an error if table information for a reach is specified more than once. \item \texttt{TAB6}---keyword to specify that record corresponds to a cross-section table file. @@ -109,7 +109,7 @@ \item \textbf{Block: CONNECTIONDATA} \begin{description} -\item \texttt{rno}---integer value that defines the reach number associated with the specified CONNECTIONDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified CONNECTIONDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach connection information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if connection information for a reach is specified more than once. \item \texttt{ic}---integer value that defines the reach number of the reach connected to the current reach and whether it is connected to the upstream or downstream end of the reach. Negative IC numbers indicate connected reaches are connected to the downstream end of the current reach. Positive IC numbers indicate connected reaches are connected to the upstream end of the current reach. The absolute value of IC must be greater than zero and less than or equal to NREACHES. IC should not be specified when NCON is zero but must be specified otherwise. @@ -117,13 +117,13 @@ \item \textbf{Block: DIVERSIONS} \begin{description} -\item \texttt{rno}---integer value that defines the reach number associated with the specified DIVERSIONS data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified DIVERSIONS data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach diversion information must be specified for every reach with a NDV value greater than 0 or the program will terminate with an error. The program will also terminate with an error if diversion information for a given reach diversion is specified more than once. -\item \texttt{idv}---integer value that defines the downstream diversion number for the diversion for reach RNO. IDV must be greater than zero and less than or equal to NDV for reach RNO. +\item \texttt{idv}---integer value that defines the downstream diversion number for the diversion for reach IFNO. IDV must be greater than zero and less than or equal to NDV for reach IFNO. -\item \texttt{iconr}---integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach RNO. +\item \texttt{iconr}---integer value that defines the downstream reach that will receive the diverted water. IDV must be greater than zero and less than or equal to NREACHES. Furthermore, reach ICONR must be a downstream connection for reach IFNO. -\item \texttt{cprior}---character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach RNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach RNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach RNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach RNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach RNO. If $Q_{DS}$ in reach RNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach RNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach RNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach RNO. +\item \texttt{cprior}---character string value that defines the the prioritization system for the diversion, such as when insufficient water is available to meet all diversion stipulations, and is used in conjunction with the value of FLOW value specified in the STRESS\_PERIOD\_DATA section. Available diversion options include: (1) CPRIOR = `FRACTION', then the amount of the diversion is computed as a fraction of the streamflow leaving reach IFNO ($Q_{DS}$); in this case, 0.0 $\le$ DIVFLOW $\le$ 1.0. (2) CPRIOR = `EXCESS', a diversion is made only if $Q_{DS}$ for reach IFNO exceeds the value of DIVFLOW. If this occurs, then the quantity of water diverted is the excess flow ($Q_{DS} -$ DIVFLOW) and $Q_{DS}$ from reach IFNO is set equal to DIVFLOW. This represents a flood-control type of diversion, as described by Danskin and Hanson (2002). (3) CPRIOR = `THRESHOLD', then if $Q_{DS}$ in reach IFNO is less than the specified diversion flow DIVFLOW, no water is diverted from reach IFNO. If $Q_{DS}$ in reach IFNO is greater than or equal to DIVFLOW, DIVFLOW is diverted and $Q_{DS}$ is set to the remainder ($Q_{DS} -$ DIVFLOW)). This approach assumes that once flow in the stream is sufficiently low, diversions from the stream cease, and is the `priority' algorithm that originally was programmed into the STR1 Package (Prudic, 1989). (4) CPRIOR = `UPTO' -- if $Q_{DS}$ in reach IFNO is greater than or equal to the specified diversion flow DIVFLOW, $Q_{DS}$ is reduced by DIVFLOW. If $Q_{DS}$ in reach IFNO is less than DIVFLOW, DIVFLOW is set to $Q_{DS}$ and there will be no flow available for reaches connected to downstream end of reach IFNO. \end{description} \item \textbf{Block: PERIOD} @@ -131,7 +131,7 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{rno}---integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. \item \texttt{sfrsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the SFRSETTING string include: STATUS, MANNING, STAGE, INFLOW, RAINFALL, EVAPORATION, RUNOFF, DIVERSION, UPSTREAM\_FRACTION, and AUXILIARY. @@ -165,7 +165,7 @@ \item \texttt{DIVERSION}---keyword to indicate diversion record. -\item \texttt{idv}---an integer value specifying which diversion of reach RNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (RNO). +\item \texttt{idv}---an integer value specifying which diversion of reach IFNO that DIVFLOW is being specified for. Must be less or equal to ndv for the current reach (IFNO). \item \textcolor{blue}{\texttt{divflow}---real or character value that defines the volumetric diversion (DIVFLOW) rate for the streamflow routing reach. If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-diversions.dat b/doc/mf6io/mf6ivar/tex/gwf-sfr-diversions.dat index b1cb9c378b1..ba6932e2933 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-diversions.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-diversions.dat @@ -1,5 +1,5 @@ BEGIN DIVERSIONS - - + + ... END DIVERSIONS diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwf-sfr-packagedata.dat index c5d4a45c403..dd18612d650 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - <@man@> <@ustrf@> [<@aux(naux)@>] [] - <@man@> <@ustrf@> [<@aux(naux)@>] [] + <@man@> <@ustrf@> [<@aux(naux)@>] [] + <@man@> <@ustrf@> [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-sfr-period.dat b/doc/mf6io/mf6ivar/tex/gwf-sfr-period.dat index 40fc6597787..77f03fe4ad1 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-sfr-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-sfr-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-uzf-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-uzf-desc.tex index 88f4401eddc..1944e303cee 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-uzf-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-uzf-desc.tex @@ -71,7 +71,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{iuzno}---integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. IUZNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. UZF information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. \item \texttt{cellid}---is the cell identifier, and depends on the type of grid that is used for the simulation. For a structured grid that uses the DIS input file, CELLID is the layer, row, and column. For a grid that uses the DISV input file, CELLID is the layer and CELL2D number. If the model uses the unstructured discretization (DISU) input file, CELLID is the node number for the cell. @@ -99,7 +99,7 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{iuzno}---integer value that defines the UZF cell number associated with the specified PERIOD data on the line. +\item \texttt{ifno}---integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. \item \textcolor{blue}{\texttt{finf}---real or character value that defines the applied infiltration rate of the UZF cell ($LT^{-1}$). If the Options block includes a TIMESERIESFILE entry (see the ``Time-Variable Input'' section), values can be obtained from a time series by entering the time-series name in place of a numeric value.} diff --git a/doc/mf6io/mf6ivar/tex/gwf-uzf-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwf-uzf-packagedata.dat index f035038f5dc..773eb0d8c1e 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-uzf-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-uzf-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [] - [] + [] + [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwf-uzf-period.dat b/doc/mf6io/mf6ivar/tex/gwf-uzf-period.dat index 05bb378fcbc..38ce0a956ae 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-uzf-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-uzf-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - <@finf@> <@pet@> <@extdp@> <@extwc@> <@ha@> <@hroot@> <@rootact@> [<@aux(naux)@>] - <@finf@> <@pet@> <@extdp@> <@extwc@> <@ha@> <@hroot@> <@rootact@> [<@aux(naux)@>] + <@finf@> <@pet@> <@extdp@> <@extwc@> <@ha@> <@hroot@> <@rootact@> [<@aux(naux)@>] + <@finf@> <@pet@> <@extdp@> <@extwc@> <@ha@> <@hroot@> <@rootact@> [<@aux(naux)@>] ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwt-disu-cell2d.dat b/doc/mf6io/mf6ivar/tex/gwt-disu-cell2d.dat index 27900d67235..f6d08961367 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-disu-cell2d.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-disu-cell2d.dat @@ -1,5 +1,5 @@ BEGIN CELL2D + [ - - ... + ...] END CELL2D diff --git a/doc/mf6io/mf6ivar/tex/gwt-disu-vertices.dat b/doc/mf6io/mf6ivar/tex/gwt-disu-vertices.dat index 6831f23b5ff..a4bc80c5453 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-disu-vertices.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-disu-vertices.dat @@ -1,5 +1,5 @@ BEGIN VERTICES + [ - - ... + ...] END VERTICES diff --git a/doc/mf6io/mf6ivar/tex/gwt-lkt-desc.tex b/doc/mf6io/mf6ivar/tex/gwt-lkt-desc.tex index 29e18ed0fef..052725643c4 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-lkt-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwt-lkt-desc.tex @@ -47,7 +47,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{lakeno}---integer value that defines the lake number associated with the specified PACKAGEDATA data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (lake) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NLAKES. Lake information must be specified for every lake or the program will terminate with an error. The program will also terminate with an error if information for a lake is specified more than once. \item \texttt{strt}---real value that defines the starting concentration for the lake. @@ -61,9 +61,9 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{lakeno}---integer value that defines the lake number associated with the specified PERIOD data on the line. LAKENO must be greater than zero and less than or equal to NLAKES. +\item \texttt{ifno}---integer value that defines the feature (lake) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NLAKES. -\item \texttt{laksetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. +\item \texttt{laksetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the LAKSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, EXT-INFLOW, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Lake Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the lake at the calculated concentration of the lake. \begin{lstlisting}[style=blockdefinition] STATUS diff --git a/doc/mf6io/mf6ivar/tex/gwt-lkt-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwt-lkt-packagedata.dat index c3a9aeec732..c293a94d109 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-lkt-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-lkt-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwt-lkt-period.dat b/doc/mf6io/mf6ivar/tex/gwt-lkt-period.dat index dfe899b47ef..da60631beac 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-lkt-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-lkt-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwt-mwt-desc.tex b/doc/mf6io/mf6ivar/tex/gwt-mwt-desc.tex index b3bbbc87356..76beee6ffa4 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-mwt-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwt-mwt-desc.tex @@ -47,7 +47,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{mawno}---integer value that defines the well number associated with the specified PACKAGEDATA data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (well) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. Well information must be specified for every well or the program will terminate with an error. The program will also terminate with an error if information for a well is specified more than once. \item \texttt{strt}---real value that defines the starting concentration for the well. @@ -61,9 +61,9 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{mawno}---integer value that defines the well number associated with the specified PERIOD data on the line. MAWNO must be greater than zero and less than or equal to NMAWWELLS. +\item \texttt{ifno}---integer value that defines the feature (well) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NMAWWELLS. -\item \texttt{mwtsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. +\item \texttt{mwtsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the MWTSETTING string include: STATUS, CONCENTRATION, RATE, and AUXILIARY. These settings are used to assign the concentration associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Multi-Aquifer Well Package supports a ``WITHDRAWAL'' flow term. If this withdrawal term is active, then water will be withdrawn from the well at the calculated concentration of the well. \begin{lstlisting}[style=blockdefinition] STATUS diff --git a/doc/mf6io/mf6ivar/tex/gwt-mwt-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwt-mwt-packagedata.dat index 1e2b52667c3..c293a94d109 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-mwt-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-mwt-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwt-mwt-period.dat b/doc/mf6io/mf6ivar/tex/gwt-mwt-period.dat index 6c43c850d50..35f8338041f 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-mwt-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-mwt-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwt-sft-desc.tex b/doc/mf6io/mf6ivar/tex/gwt-sft-desc.tex index bed98a05116..7bd5b296985 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-sft-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwt-sft-desc.tex @@ -47,7 +47,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{rno}---integer value that defines the reach number associated with the specified PACKAGEDATA data on the line. RNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NREACHES. Reach information must be specified for every reach or the program will terminate with an error. The program will also terminate with an error if information for a reach is specified more than once. \item \texttt{strt}---real value that defines the starting concentration for the reach. @@ -61,7 +61,7 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{rno}---integer value that defines the reach number associated with the specified PERIOD data on the line. RNO must be greater than zero and less than or equal to NREACHES. +\item \texttt{ifno}---integer value that defines the feature (reach) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NREACHES. \item \texttt{reachsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the REACHSETTING string include: STATUS, CONCENTRATION, RAINFALL, EVAPORATION, RUNOFF, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. For example, the Streamflow Package supports a ``DIVERSION'' flow term. Diversion water will be routed using the calculated concentration of the reach. diff --git a/doc/mf6io/mf6ivar/tex/gwt-sft-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwt-sft-packagedata.dat index 5176b996a98..c293a94d109 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-sft-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-sft-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwt-sft-period.dat b/doc/mf6io/mf6ivar/tex/gwt-sft-period.dat index 1b56b2824e2..98ef19da015 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-sft-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-sft-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwt-ssm-desc.tex b/doc/mf6io/mf6ivar/tex/gwt-ssm-desc.tex index 0d450f542f4..d75c8508def 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-ssm-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwt-ssm-desc.tex @@ -13,7 +13,7 @@ \begin{description} \item \texttt{pname}---name of the flow package for which an auxiliary variable contains a source concentration. If this flow package is represented using an advanced transport package (SFT, LKT, MWT, or UZT), then the advanced transport package will override SSM terms specified here. -\item \texttt{srctype}---keyword indicating how concentration will be assigned for sources and sinks. Keyword must be specified as either AUX or AUXMIXED. For both options the user must provide an auxiliary variable in the corresponding flow package. The auxiliary variable must have the same name as the AUXNAME value that follows. If the AUX keyword is specified, then the auxiliary variable specified by the user will be assigned as the concenration value for groundwater sources (flows with a positive sign). For negative flow rates (sinks), groundwater will be withdrawn from the cell at the simulated concentration of the cell. The AUXMIXED option provides an alternative method for how to determine the concentration of sinks. If the cell concentration is larger than the user-specified auxiliary concentration, then the concentration of groundwater withdrawn from the cell will be assigned as the user-specified concentration. Alternatively, if the user-specified auxiliary concentration is larger than the cell concentration, then groundwater will be withdrawn at the cell concentration. Thus, the AUXMIXED option is designed to work with the Evapotranspiration (EVT) and Recharge (RCH) Packages where water may be withdrawn at a concentration that is less than the cell concentration. +\item \texttt{srctype}---keyword indicating how concentration will be assigned for sources and sinks. Keyword must be specified as either AUX or AUXMIXED. For both options the user must provide an auxiliary variable in the corresponding flow package. The auxiliary variable must have the same name as the AUXNAME value that follows. If the AUX keyword is specified, then the auxiliary variable specified by the user will be assigned as the concentration value for groundwater sources (flows with a positive sign). For negative flow rates (sinks), groundwater will be withdrawn from the cell at the simulated concentration of the cell. The AUXMIXED option provides an alternative method for how to determine the concentration of sinks. If the cell concentration is larger than the user-specified auxiliary concentration, then the concentration of groundwater withdrawn from the cell will be assigned as the user-specified concentration. Alternatively, if the user-specified auxiliary concentration is larger than the cell concentration, then groundwater will be withdrawn at the cell concentration. Thus, the AUXMIXED option is designed to work with the Evapotranspiration (EVT) and Recharge (RCH) Packages where water may be withdrawn at a concentration that is less than the cell concentration. \item \texttt{auxname}---name of the auxiliary variable in the package PNAME. This auxiliary variable must exist and be specified by the user in that package. The values in this auxiliary variable will be used to set the concentration associated with the flows for that boundary package. diff --git a/doc/mf6io/mf6ivar/tex/gwt-uzt-desc.tex b/doc/mf6io/mf6ivar/tex/gwt-uzt-desc.tex index aab78138481..bd53d44a933 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-uzt-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwt-uzt-desc.tex @@ -47,7 +47,7 @@ \item \textbf{Block: PACKAGEDATA} \begin{description} -\item \texttt{uzfno}---integer value that defines the UZF cell number associated with the specified PACKAGEDATA data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. +\item \texttt{ifno}---integer value that defines the feature (UZF object) number associated with the specified PACKAGEDATA data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. Unsaturated zone flow information must be specified for every UZF cell or the program will terminate with an error. The program will also terminate with an error if information for a UZF cell is specified more than once. \item \texttt{strt}---real value that defines the starting concentration for the unsaturated zone flow cell. @@ -61,7 +61,7 @@ \begin{description} \item \texttt{iper}---integer value specifying the starting stress period number for which the data specified in the PERIOD block apply. IPER must be less than or equal to NPER in the TDIS Package and greater than zero. The IPER value assigned to a stress period block must be greater than the IPER value assigned for the previous PERIOD block. The information specified in the PERIOD block will continue to apply for all subsequent stress periods, unless the program encounters another PERIOD block. -\item \texttt{uzfno}---integer value that defines the UZF cell number associated with the specified PERIOD data on the line. UZFNO must be greater than zero and less than or equal to NUZFCELLS. +\item \texttt{ifno}---integer value that defines the feature (UZF object) number associated with the specified PERIOD data on the line. IFNO must be greater than zero and less than or equal to NUZFCELLS. \item \texttt{uztsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the UZTSETTING string include: STATUS, CONCENTRATION, INFILTRATION, UZET, and AUXILIARY. These settings are used to assign the concentration of associated with the corresponding flow terms. Concentrations cannot be specified for all flow terms. diff --git a/doc/mf6io/mf6ivar/tex/gwt-uzt-packagedata.dat b/doc/mf6io/mf6ivar/tex/gwt-uzt-packagedata.dat index b6b04c298fe..c293a94d109 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-uzt-packagedata.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-uzt-packagedata.dat @@ -1,5 +1,5 @@ BEGIN PACKAGEDATA - [<@aux(naux)@>] [] - [<@aux(naux)@>] [] + [<@aux(naux)@>] [] + [<@aux(naux)@>] [] ... END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/gwt-uzt-period.dat b/doc/mf6io/mf6ivar/tex/gwt-uzt-period.dat index 8bd28bd48b9..5e1d29136c6 100644 --- a/doc/mf6io/mf6ivar/tex/gwt-uzt-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwt-uzt-period.dat @@ -1,5 +1,5 @@ BEGIN PERIOD - - + + ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex b/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex index bba10d98e87..3e5c0ccf826 100644 --- a/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex +++ b/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex @@ -25,7 +25,7 @@ \item \texttt{bndno}---integer value that defines the boundary package feature number associated with the specified PERIOD data on the line. BNDNO must be greater than zero and less than or equal to MAXBOUND. -\item \texttt{spcsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: CONCENTRATION. +\item \texttt{spcsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the SPCSETTING string include: CONCENTRATION. \begin{lstlisting}[style=blockdefinition] CONCENTRATION <@concentration@> diff --git a/doc/mf6io/mf6noname.tex b/doc/mf6io/mf6noname.tex index 2a1d08622d2..6671ddbe223 100644 --- a/doc/mf6io/mf6noname.tex +++ b/doc/mf6io/mf6noname.tex @@ -3,8 +3,6 @@ ERROR REPORT: - 1. mf6.exe: mfsim.nam is not present in working directory. - - + 1. mf6: mfsim.nam is not present in working directory. \end{lstlisting} } diff --git a/doc/mf6io/mf6output.tex b/doc/mf6io/mf6output.tex index 6c982d2f831..a62c97b6d73 100644 --- a/doc/mf6io/mf6output.tex +++ b/doc/mf6io/mf6output.tex @@ -2,37 +2,33 @@ \begin{lstlisting}[style=modeloutput] MODFLOW 6 U.S. GEOLOGICAL SURVEY MODULAR HYDROLOGIC MODEL - VERSION 6.3.0 03/04/2022 + VERSION 6.5.0.dev0 (preliminary) 07/13/2023 + ***DEVELOP MODE*** - MODFLOW 6 compiled Mar 02 2022 15:29:04 with Intel(R) Fortran Intel(R) 64 - Compiler Classic for applications running on Intel(R) 64, Version 2021.5.0 - Build 20211109_000000 + MODFLOW 6 compiled Jan 24 2024 12:12:59 with GCC version 13.2.0 -This software has been approved for release by the U.S. Geological -Survey (USGS). Although the software has been subjected to rigorous -review, the USGS reserves the right to update the software as needed -pursuant to further analysis and review. No warranty, expressed or -implied, is made by the USGS or the U.S. Government as to the -functionality of the software and related material nor shall the -fact of release constitute any such warranty. Furthermore, the -software is released on condition that neither the USGS nor the U.S. -Government shall be held liable for any damages resulting from its -authorized or unauthorized use. Also refer to the USGS Water -Resources Software User Rights Notice for complete use, copyright, -and distribution information. +This software is preliminary or provisional and is subject to +revision. It is being provided to meet the need for timely best +science. The software has not received final approval by the U.S. +Geological Survey (USGS). No warranty, expressed or implied, is made +by the USGS or the U.S. Government as to the functionality of the +software and related material nor shall the fact of release +constitute any such warranty. The software is provided on the +condition that neither the USGS nor the U.S. Government shall be held +liable for any damages resulting from the authorized or unauthorized +use of the software. - Run start date and time (yyyy/mm/dd hh:mm:ss): 2022/03/04 12:00:35 + Run start date and time (yyyy/mm/dd hh:mm:ss): 2024/01/24 12:13:22 Writing simulation list file: mfsim.lst Using Simulation name file: mfsim.nam Solving: Stress period: 1 Time step: 1 - Run end date and time (yyyy/mm/dd hh:mm:ss): 2022/03/04 12:00:36 - Elapsed run time: 0.156 Seconds + Run end date and time (yyyy/mm/dd hh:mm:ss): 2024/01/24 12:13:22 + Elapsed run time: 0.034 Seconds Normal termination of simulation. - \end{lstlisting} } diff --git a/doc/mf6io/mf6switches.tex b/doc/mf6io/mf6switches.tex index 280a969fdd6..bd204027dce 100644 --- a/doc/mf6io/mf6switches.tex +++ b/doc/mf6io/mf6switches.tex @@ -1,14 +1,15 @@ {\small \begin{lstlisting}[style=modeloutput] -mf6.exe - MODFLOW 6.3.0 03/04/2022 (compiled Mar 02 2022 15:29:04) -usage: mf6.exe run MODFLOW 6 using "mfsim.nam" - or: mf6.exe [options] retrieve program information +mf6 - MODFLOW 6.5.0.dev0 (preliminary) 07/13/2023 (compiled Jan 24 2024 12:12:59) +usage: mf6 run MODFLOW 6 using "mfsim.nam" + or: mf6 [options] retrieve program information -Options GNU long option Meaning +Options GNU long option Meaning -h, -? --help Show this message -v --version Display program version information. -dev --develop Display program develop option mode. -d --disclaimer Display program disclaimer. + -p --parallel Run program in parallel mode. -lic --license Display program license information. -c --compiler Display compiler information. -co --compiler-opt Display compiler options. @@ -18,19 +19,17 @@ =debug Enhanced output to STDOUT. -m --mode MODFLOW 6 simulation mode based on . =validate Check model input for - errors but do not - assemble or solve matrix - equations or write + errors but do not + assemble or solve matrix + equations or write solution output. - -Bug reporting and contributions are welcome from the community. + +Bug reporting and contributions are welcome from the community. Questions can be asked on the issues page[1]. Before creating a new issue, please take a moment to search and make sure a similar issue does not already exist. If one does exist, you can comment (most simply even with just :+1:) to show your support for that issue. - + [1] https://github.com/MODFLOW-USGS/modflow6/issues - - \end{lstlisting} } diff --git a/doc/version.py b/doc/version.py index b063daa0c02..5456e79843b 100644 --- a/doc/version.py +++ b/doc/version.py @@ -1,10 +1,3 @@ # MODFLOW 6 version file automatically created using...update_version.py -# created on...June 28, 2023 19:45:12 - -major = 6 -minor = 4 -micro = 2 -label = '' -__version__ = '{:d}.{:d}.{:d}'.format(major, minor, micro) -if label: - __version__ += '{}{}'.format(__version__, label) \ No newline at end of file +# created on...February 07, 2024 21:53:23 +__version__ = "6.4.3" diff --git a/doc/version.tex b/doc/version.tex index 6beb425516a..88c37fbb614 100644 --- a/doc/version.tex +++ b/doc/version.tex @@ -1,3 +1,3 @@ -\newcommand{\modflowversion}{mf6.4.2} -\newcommand{\modflowdate}{June 28, 2023} +\newcommand{\modflowversion}{mf6.4.3} +\newcommand{\modflowdate}{February 07, 2024} \newcommand{\currentmodflowversion}{Version \modflowversion---\modflowdate} diff --git a/environment.yml b/environment.yml index c989e3bc197..118a816e753 100644 --- a/environment.yml +++ b/environment.yml @@ -5,23 +5,26 @@ channels: - defaults dependencies: + - python - appdirs - filelock - fprettify + - fortran-language-server - jupytext - matplotlib - - meson>=1.1.0 + - meson=1.3.0 - ninja - numpy + - pyshp + - shapely - pip - pip: - git+https://github.com/modflowpy/flopy.git - git+https://github.com/modflowpy/pymake.git - git+https://github.com/Deltares/xmipy.git - git+https://github.com/MODFLOW-USGS/modflowapi.git - - modflow-devtools + - git+https://github.com/MODFLOW-USGS/modflow-devtools.git - pytest - - pytest-cases - pytest-dotenv - pytest-order - pytest-xdist diff --git a/make/makedefaults b/make/makedefaults index 7bbd4dd3293..88e1790887a 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'mf6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -57,19 +57,16 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition diff --git a/make/makefile b/make/makefile index 552d7c70a1d..885d0663ab9 100644 --- a/make/makefile +++ b/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.7) for the 'mf6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'mf6' executable. include ./makedefaults @@ -6,34 +6,35 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src SOURCEDIR2=../src/Exchange -SOURCEDIR3=../src/Distributed -SOURCEDIR4=../src/Solution -SOURCEDIR5=../src/Solution/LinearMethods -SOURCEDIR6=../src/Solution/PETSc -SOURCEDIR7=../src/Timing -SOURCEDIR8=../src/Utilities -SOURCEDIR9=../src/Utilities/Idm -SOURCEDIR10=../src/Utilities/Idm/selector -SOURCEDIR11=../src/Utilities/Idm/mf6blockfile -SOURCEDIR12=../src/Utilities/TimeSeries -SOURCEDIR13=../src/Utilities/Memory -SOURCEDIR14=../src/Utilities/OutputControl -SOURCEDIR15=../src/Utilities/ArrayRead -SOURCEDIR16=../src/Utilities/Libraries -SOURCEDIR17=../src/Utilities/Libraries/rcm -SOURCEDIR18=../src/Utilities/Libraries/blas -SOURCEDIR19=../src/Utilities/Libraries/sparskit2 -SOURCEDIR20=../src/Utilities/Libraries/daglib -SOURCEDIR21=../src/Utilities/Libraries/sparsekit -SOURCEDIR22=../src/Utilities/Vector -SOURCEDIR23=../src/Utilities/Matrix -SOURCEDIR24=../src/Utilities/Observation -SOURCEDIR25=../src/Model -SOURCEDIR26=../src/Model/Connection -SOURCEDIR27=../src/Model/GroundWaterTransport -SOURCEDIR28=../src/Model/ModelUtilities -SOURCEDIR29=../src/Model/GroundWaterFlow -SOURCEDIR30=../src/Model/Geometry +SOURCEDIR3=../src/Model +SOURCEDIR4=../src/Model/Geometry +SOURCEDIR5=../src/Model/TransportModel +SOURCEDIR6=../src/Model/ModelUtilities +SOURCEDIR7=../src/Model/Connection +SOURCEDIR8=../src/Model/GroundWaterTransport +SOURCEDIR9=../src/Model/GroundWaterFlow +SOURCEDIR10=../src/Distributed +SOURCEDIR11=../src/Solution +SOURCEDIR12=../src/Solution/PETSc +SOURCEDIR13=../src/Solution/LinearMethods +SOURCEDIR14=../src/Timing +SOURCEDIR15=../src/Utilities +SOURCEDIR16=../src/Utilities/TimeSeries +SOURCEDIR17=../src/Utilities/Libraries +SOURCEDIR18=../src/Utilities/Libraries/rcm +SOURCEDIR19=../src/Utilities/Libraries/sparsekit +SOURCEDIR20=../src/Utilities/Libraries/sparskit2 +SOURCEDIR21=../src/Utilities/Libraries/blas +SOURCEDIR22=../src/Utilities/Libraries/daglib +SOURCEDIR23=../src/Utilities/Idm +SOURCEDIR24=../src/Utilities/Idm/selector +SOURCEDIR25=../src/Utilities/Idm/mf6blockfile +SOURCEDIR26=../src/Utilities/Matrix +SOURCEDIR27=../src/Utilities/Vector +SOURCEDIR28=../src/Utilities/Observation +SOURCEDIR29=../src/Utilities/OutputControl +SOURCEDIR30=../src/Utilities/Memory +SOURCEDIR31=../src/Utilities/ArrayRead VPATH = \ ${SOURCEDIR1} \ @@ -65,20 +66,21 @@ ${SOURCEDIR26} \ ${SOURCEDIR27} \ ${SOURCEDIR28} \ ${SOURCEDIR29} \ -${SOURCEDIR30} +${SOURCEDIR30} \ +${SOURCEDIR31} .SUFFIXES: .f90 .F90 .o OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/SimVariables.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/version.o \ -$(OBJDIR)/Message.o \ $(OBJDIR)/Sim.o \ $(OBJDIR)/OpenSpec.o \ $(OBJDIR)/InputOutput.o \ @@ -88,12 +90,16 @@ $(OBJDIR)/MemoryHelper.o \ $(OBJDIR)/CharString.o \ $(OBJDIR)/Memory.o \ $(OBJDIR)/List.o \ +$(OBJDIR)/LongLineReader.o \ +$(OBJDIR)/DevFeature.o \ $(OBJDIR)/MemoryList.o \ $(OBJDIR)/TimeSeriesRecord.o \ +$(OBJDIR)/MathUtil.o \ $(OBJDIR)/BlockParser.o \ $(OBJDIR)/MemoryManager.o \ $(OBJDIR)/TimeSeries.o \ $(OBJDIR)/ats.o \ +$(OBJDIR)/GeomUtil.o \ $(OBJDIR)/TimeSeriesLink.o \ $(OBJDIR)/TimeSeriesFileList.o \ $(OBJDIR)/tdis.o \ @@ -104,60 +110,79 @@ $(OBJDIR)/DisvGeom.o \ $(OBJDIR)/ArrayReaders.o \ $(OBJDIR)/TimeSeriesManager.o \ $(OBJDIR)/SmoothingFunctions.o \ +$(OBJDIR)/MemoryManagerExt.o \ $(OBJDIR)/MatrixBase.o \ $(OBJDIR)/ListReader.o \ $(OBJDIR)/Connections.o \ -$(OBJDIR)/DiscretizationBase.o \ +$(OBJDIR)/InputDefinition.o \ $(OBJDIR)/TimeArray.o \ $(OBJDIR)/ObsOutput.o \ +$(OBJDIR)/DiscretizationBase.o \ +$(OBJDIR)/simnamidm.o \ +$(OBJDIR)/gwt1idm.o \ +$(OBJDIR)/gwt1ic1idm.o \ +$(OBJDIR)/gwt1dsp1idm.o \ +$(OBJDIR)/gwt1disv1idm.o \ +$(OBJDIR)/gwt1disu1idm.o \ +$(OBJDIR)/gwt1dis1idm.o \ +$(OBJDIR)/gwt1cnc1idm.o \ +$(OBJDIR)/gwf3wel8idm.o \ +$(OBJDIR)/gwf3riv8idm.o \ +$(OBJDIR)/gwf3rch8idm.o \ +$(OBJDIR)/gwf3rcha8idm.o \ +$(OBJDIR)/gwf3npf8idm.o \ +$(OBJDIR)/gwf3idm.o \ +$(OBJDIR)/gwf3ic8idm.o \ +$(OBJDIR)/gwf3ghb8idm.o \ +$(OBJDIR)/gwf3evt8idm.o \ +$(OBJDIR)/gwf3evta8idm.o \ +$(OBJDIR)/gwf3drn8idm.o \ +$(OBJDIR)/gwf3disv8idm.o \ +$(OBJDIR)/gwf3disu8idm.o \ +$(OBJDIR)/gwf3dis8idm.o \ +$(OBJDIR)/gwf3chd8idm.o \ +$(OBJDIR)/gwtgwtidm.o \ +$(OBJDIR)/gwfgwtidm.o \ +$(OBJDIR)/gwfgwfidm.o \ $(OBJDIR)/TimeArraySeries.o \ $(OBJDIR)/ObsOutputList.o \ $(OBJDIR)/Observe.o \ +$(OBJDIR)/IdmSimDfnSelector.o \ +$(OBJDIR)/IdmGwtDfnSelector.o \ +$(OBJDIR)/IdmGwfDfnSelector.o \ +$(OBJDIR)/IdmExgDfnSelector.o \ $(OBJDIR)/TimeArraySeriesLink.o \ $(OBJDIR)/ObsUtility.o \ $(OBJDIR)/ObsContainer.o \ $(OBJDIR)/BudgetFileReader.o \ +$(OBJDIR)/IdmDfnSelector.o \ $(OBJDIR)/TimeArraySeriesManager.o \ $(OBJDIR)/PackageMover.o \ $(OBJDIR)/Obs3.o \ $(OBJDIR)/NumericalPackage.o \ $(OBJDIR)/Budget.o \ -$(OBJDIR)/SeqVector.o \ +$(OBJDIR)/BudgetTerm.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ -$(OBJDIR)/BudgetTerm.o \ +$(OBJDIR)/SourceCommon.o \ $(OBJDIR)/BoundaryPackage.o \ -$(OBJDIR)/BaseModel.o \ -$(OBJDIR)/SparseMatrix.o \ -$(OBJDIR)/LinearSolverBase.o \ -$(OBJDIR)/ims8reordering.o \ $(OBJDIR)/VirtualBase.o \ $(OBJDIR)/STLVecInt.o \ -$(OBJDIR)/InputDefinition.o \ +$(OBJDIR)/BaseModel.o \ +$(OBJDIR)/PackageBudget.o \ +$(OBJDIR)/HeadFileReader.o \ +$(OBJDIR)/BudgetObject.o \ +$(OBJDIR)/PrintSaveManager.o \ $(OBJDIR)/SfrCrossSectionManager.o \ $(OBJDIR)/dag_module.o \ -$(OBJDIR)/BudgetObject.o \ -$(OBJDIR)/NumericalModel.o \ -$(OBJDIR)/BaseExchange.o \ -$(OBJDIR)/ImsLinearSolver.o \ -$(OBJDIR)/ims8base.o \ +$(OBJDIR)/BoundaryPackageExt.o \ $(OBJDIR)/VirtualDataLists.o \ $(OBJDIR)/VirtualDataContainer.o \ $(OBJDIR)/SimStages.o \ -$(OBJDIR)/simnamidm.o \ -$(OBJDIR)/gwt1idm.o \ -$(OBJDIR)/gwt1dsp1idm.o \ -$(OBJDIR)/gwt1disv1idm.o \ -$(OBJDIR)/gwt1disu1idm.o \ -$(OBJDIR)/gwt1dis1idm.o \ -$(OBJDIR)/gwf3npf8idm.o \ -$(OBJDIR)/gwf3idm.o \ -$(OBJDIR)/gwf3disv8idm.o \ -$(OBJDIR)/gwf3disu8idm.o \ -$(OBJDIR)/gwf3dis8idm.o \ -$(OBJDIR)/PackageBudget.o \ -$(OBJDIR)/HeadFileReader.o \ -$(OBJDIR)/PrintSaveManager.o \ +$(OBJDIR)/NumericalModel.o \ +$(OBJDIR)/FlowModelInterface.o \ +$(OBJDIR)/OutputControlData.o \ +$(OBJDIR)/gwf3ic8.o \ $(OBJDIR)/Xt3dAlgorithm.o \ $(OBJDIR)/gwf3tvbase8.o \ $(OBJDIR)/gwf3sfr8.o \ @@ -168,38 +193,39 @@ $(OBJDIR)/gwf3lak8.o \ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf3ghb8.o \ $(OBJDIR)/gwf3drn8.o \ -$(OBJDIR)/Timer.o \ -$(OBJDIR)/NumericalExchange.o \ -$(OBJDIR)/LinearSolverFactory.o \ -$(OBJDIR)/ims8linear.o \ -$(OBJDIR)/BaseSolution.o \ $(OBJDIR)/IndexMap.o \ $(OBJDIR)/VirtualModel.o \ -$(OBJDIR)/IdmSimDfnSelector.o \ -$(OBJDIR)/IdmGwtDfnSelector.o \ -$(OBJDIR)/IdmGwfDfnSelector.o \ +$(OBJDIR)/BaseExchange.o \ +$(OBJDIR)/tsp1fmi1.o \ +$(OBJDIR)/GwtSpc.o \ +$(OBJDIR)/OutputControl.o \ +$(OBJDIR)/tsp1ic1.o \ +$(OBJDIR)/TspAdvOptions.o \ $(OBJDIR)/UzfCellGroup.o \ -$(OBJDIR)/gwt1fmi1.o \ -$(OBJDIR)/OutputControlData.o \ -$(OBJDIR)/gwf3ic8.o \ $(OBJDIR)/Xt3dInterface.o \ $(OBJDIR)/gwf3tvk8.o \ -$(OBJDIR)/MemoryManagerExt.o \ $(OBJDIR)/gwf3vsc8.o \ $(OBJDIR)/GwfNpfOptions.o \ -$(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/InterfaceMap.o \ +$(OBJDIR)/SeqVector.o \ +$(OBJDIR)/ImsLinearSettings.o \ +$(OBJDIR)/ConvergenceSummary.o \ +$(OBJDIR)/ArrayReaderBase.o \ $(OBJDIR)/CellWithNbrs.o \ -$(OBJDIR)/IdmDfnSelector.o \ +$(OBJDIR)/NumericalExchange.o \ +$(OBJDIR)/tsp1ssm1.o \ +$(OBJDIR)/tsp1oc1.o \ +$(OBJDIR)/tsp1obs1.o \ +$(OBJDIR)/tsp1mvt1.o \ +$(OBJDIR)/tsp1adv1.o \ +$(OBJDIR)/gwf3disv8.o \ +$(OBJDIR)/gwf3disu8.o \ +$(OBJDIR)/gwf3dis8.o \ $(OBJDIR)/gwf3uzf8.o \ -$(OBJDIR)/gwt1apt1.o \ -$(OBJDIR)/GwtSpc.o \ -$(OBJDIR)/OutputControl.o \ -$(OBJDIR)/gwt1ic1.o \ +$(OBJDIR)/tsp1apt1.o \ $(OBJDIR)/gwt1mst1.o \ $(OBJDIR)/GwtDspOptions.o \ $(OBJDIR)/gwf3npf8.o \ -$(OBJDIR)/GwtAdvOptions.o \ $(OBJDIR)/gwf3tvs8.o \ $(OBJDIR)/GwfStorageUtils.o \ $(OBJDIR)/Mover.o \ @@ -207,29 +233,24 @@ $(OBJDIR)/GwfMvrPeriodData.o \ $(OBJDIR)/ims8misc.o \ $(OBJDIR)/GwfBuyInputData.o \ $(OBJDIR)/VirtualSolution.o \ -$(OBJDIR)/ArrayReaderBase.o \ +$(OBJDIR)/SparseMatrix.o \ +$(OBJDIR)/LinearSolverBase.o \ +$(OBJDIR)/ims8reordering.o \ +$(OBJDIR)/ModflowInput.o \ +$(OBJDIR)/Integer2dReader.o \ $(OBJDIR)/VirtualExchange.o \ -$(OBJDIR)/gwf3disu8.o \ $(OBJDIR)/GridSorting.o \ $(OBJDIR)/DisConnExchange.o \ $(OBJDIR)/CsrUtils.o \ -$(OBJDIR)/TransportModel.o \ -$(OBJDIR)/ModelPackageInputs.o \ +$(OBJDIR)/tsp1.o \ $(OBJDIR)/gwt1uzt1.o \ -$(OBJDIR)/gwt1ssm1.o \ $(OBJDIR)/gwt1src1.o \ $(OBJDIR)/gwt1sft1.o \ -$(OBJDIR)/gwt1oc1.o \ -$(OBJDIR)/gwt1obs1.o \ $(OBJDIR)/gwt1mwt1.o \ -$(OBJDIR)/gwt1mvt1.o \ $(OBJDIR)/gwt1lkt1.o \ $(OBJDIR)/gwt1ist1.o \ $(OBJDIR)/gwt1dsp1.o \ $(OBJDIR)/gwt1cnc1.o \ -$(OBJDIR)/gwt1adv1.o \ -$(OBJDIR)/gwf3disv8.o \ -$(OBJDIR)/gwf3dis8.o \ $(OBJDIR)/gwf3api8.o \ $(OBJDIR)/gwf3wel8.o \ $(OBJDIR)/gwf3rch8.o \ @@ -244,17 +265,29 @@ $(OBJDIR)/GhostNode.o \ $(OBJDIR)/gwf3evt8.o \ $(OBJDIR)/gwf3chd8.o \ $(OBJDIR)/RouterBase.o \ -$(OBJDIR)/Integer2dReader.o \ -$(OBJDIR)/GridConnection.o \ -$(OBJDIR)/DistributedVariable.o \ -$(OBJDIR)/gwt1.o \ -$(OBJDIR)/gwf3.o \ -$(OBJDIR)/SerialRouter.o \ +$(OBJDIR)/ImsLinearSolver.o \ +$(OBJDIR)/ims8base.o \ $(OBJDIR)/StructVector.o \ $(OBJDIR)/IdmLogger.o \ +$(OBJDIR)/DefinitionSelect.o \ +$(OBJDIR)/InputLoadType.o \ $(OBJDIR)/Integer1dReader.o \ $(OBJDIR)/Double2dReader.o \ $(OBJDIR)/Double1dReader.o \ +$(OBJDIR)/GridConnection.o \ +$(OBJDIR)/DistributedVariable.o \ +$(OBJDIR)/gwt1.o \ +$(OBJDIR)/gwf3.o \ +$(OBJDIR)/GwfExchangeMover.o \ +$(OBJDIR)/SerialRouter.o \ +$(OBJDIR)/Timer.o \ +$(OBJDIR)/LinearSolverFactory.o \ +$(OBJDIR)/ims8linear.o \ +$(OBJDIR)/BaseSolution.o \ +$(OBJDIR)/StructArray.o \ +$(OBJDIR)/BoundInputContext.o \ +$(OBJDIR)/AsciiInputLoadType.o \ +$(OBJDIR)/LayeredArrayReader.o \ $(OBJDIR)/ExplicitModel.o \ $(OBJDIR)/SpatialModelConnection.o \ $(OBJDIR)/GwtInterfaceModel.o \ @@ -262,17 +295,18 @@ $(OBJDIR)/GwtGwtExchange.o \ $(OBJDIR)/GwfInterfaceModel.o \ $(OBJDIR)/GwfGwfExchange.o \ $(OBJDIR)/RouterFactory.o \ +$(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/MappedMemory.o \ -$(OBJDIR)/StructArray.o \ -$(OBJDIR)/ModflowInput.o \ -$(OBJDIR)/LayeredArrayReader.o \ -$(OBJDIR)/DefinitionSelect.o \ +$(OBJDIR)/StressListInput.o \ +$(OBJDIR)/StressGridInput.o \ +$(OBJDIR)/LoadMf6File.o \ $(OBJDIR)/ExplicitSolution.o \ $(OBJDIR)/GwtGwtConnection.o \ $(OBJDIR)/GwfGwfConnection.o \ $(OBJDIR)/VirtualDataManager.o \ $(OBJDIR)/Mapper.o \ -$(OBJDIR)/LoadMf6File.o \ +$(OBJDIR)/IdmMf6File.o \ +$(OBJDIR)/ModelPackageInput.o \ $(OBJDIR)/VirtualGwtModel.o \ $(OBJDIR)/VirtualGwtExchange.o \ $(OBJDIR)/VirtualGwfModel.o \ @@ -281,10 +315,11 @@ $(OBJDIR)/SolutionGroup.o \ $(OBJDIR)/SolutionFactory.o \ $(OBJDIR)/GwfGwtExchange.o \ $(OBJDIR)/RunControl.o \ -$(OBJDIR)/IdmMf6File.o \ +$(OBJDIR)/SourceLoad.o \ +$(OBJDIR)/ModelPackageInputs.o \ $(OBJDIR)/SimulationCreate.o \ $(OBJDIR)/RunControlFactory.o \ -$(OBJDIR)/IdmSimulation.o \ +$(OBJDIR)/IdmLoad.o \ $(OBJDIR)/ConnectionBuilder.o \ $(OBJDIR)/comarg.o \ $(OBJDIR)/mf6core.o \ diff --git a/meson.build b/meson.build index faf8bd2185e..f1bca2b04f0 100644 --- a/meson.build +++ b/meson.build @@ -1,7 +1,7 @@ project( 'MODFLOW 6', 'fortran', - version: '6.4.2', + version: '6.4.3', license: 'CC0', meson_version: '>= 1.1.0', default_options : [ @@ -25,6 +25,7 @@ message('The used profile is:', profile) # parse compiler options fc = meson.get_compiler('fortran') fc_id = fc.get_id() +message('The fc_id is:', fc_id) compile_args = [] link_args = [] @@ -41,7 +42,7 @@ if fc_id == 'gcc' '-Wno-maybe-uninitialized', # "Uninitialized" flags produce false positives with allocatables '-Wno-uninitialized', ] - + # Options specific to profile if profile == 'release' compile_args += ['-ffpe-summary=overflow', '-ffpe-trap=overflow,zero,invalid'] @@ -85,18 +86,36 @@ elif fc_id == 'intel' '-diag-disable:5268', # Line too long ] link_args += '-static-intel' -endif + +# Command line options for ifx +elif fc_id == 'intel-llvm-cl' + # windows + compile_args += ['/fpe:0', # Activate all floating point exceptions + '/heap-arrays:0', + '/traceback', + '/fpp', # Activate preprocessing + '/Qdiag-disable:7416', # f2008 warning + '/Qdiag-disable:7025', # f2008 warning + '/Qdiag-disable:5268', # Line too long + ] + link_args += ['/ignore:4217', # access through ddlimport might be inefficient + '/ignore:4286' # same as 4217, but more general + ] +endif # parallel build options -is_parallel_build = get_option('parallel') +is_extended_build = get_option('extended') is_cray = get_option('cray') is_mpich = get_option('mpich') if is_cray and build_machine.system() != 'linux' error('cray=true only supported on linux systems') endif -if is_cray and not is_parallel_build - is_parallel_build = true +if not is_extended_build + is_extended_build = get_option('parallel') +endif +if is_cray and not is_extended_build + is_extended_build = true is_mpich = true endif if is_mpich @@ -106,14 +125,14 @@ if is_mpich mpifort_name = 'mpichfort' endif endif -message('Parallel build:', is_parallel_build) +message('Extended build:', is_extended_build) # windows options for petsc petsc_dir = meson.project_source_root() / '..' /'petsc-3.18.5' petsc_arch = 'arch-ci-mswin-intel-modflow6' # on windows only with intel -if build_machine.system() == 'windows' and is_parallel_build +if build_machine.system() == 'windows' and is_extended_build if fc_id != 'intel-cl' error('Parallel build on Windows only with intel compiler. Terminating...') endif @@ -123,8 +142,8 @@ endif dependencies = [ ] extra_cmp_args = [ ] -# load petsc and mpi dependencies/libraries -if is_parallel_build +# load petsc, mpi, and netcdf dependencies/libraries +if is_extended_build # find petsc if build_machine.system() != 'windows' petsc = dependency('PETSc', required : true) @@ -139,16 +158,31 @@ if is_parallel_build # find mpi if is_mpich - mpi = dependency('mpich', required : true) - mpifort = dependency(mpifort_name, required : mpi.found()) - dependencies += [ mpi, mpifort ] + mpifort = dependency(mpifort_name, required : true) + dependencies += mpifort else mpi = dependency('mpi', language : 'fortran', required : true) dependencies += mpi endif extra_cmp_args += [ '-D__WITH_MPI__'] with_mpi = true + + # find netcdf + if build_machine.system() != 'windows' + netcdf = dependency('netcdf', language : 'fortran', required : false) + else + # For CI testing only; Windows not yet supported + nc_dir = meson.project_source_root() / '..' / 'ncf' / 'netcdf-fortran-4.6.1' / 'fortran' + netcdf = fc.find_library('netcdff', dirs: [ nc_dir ], required : false, static : false) + #nc_incdir = include_directories([ nc_dir ]) + endif + if netcdf.found() + with_netcdf = true + extra_cmp_args += [ '-D__WITH_NETCDF__' ] + dependencies += [ netcdf ] + endif else + with_netcdf = false with_petsc = false with_mpi = false endif @@ -158,7 +192,7 @@ compile_args += extra_cmp_args add_project_arguments(fc.get_supported_arguments(compile_args), language: 'fortran') add_project_link_arguments(fc.get_supported_arguments(link_args), language: 'fortran') -if is_parallel_build and build_machine.system() == 'windows' +if is_extended_build and build_machine.system() == 'windows' message('Compiling PETSc Fortran modules') petsc_incdir = include_directories([petsc_dir / 'include', petsc_compiled / 'include']) petsc_src = petsc_dir / 'src' @@ -190,8 +224,11 @@ subdir('srcbmi') # build zbud6 and mf5to6 utility programs subdir('utils') -# add unit test directory -# subdir('unittests') +# add autotest directory +fs = import('fs') +if fs.is_dir('autotest') + subdir('autotest') +endif # meson tests to evaluate installation success testdir = meson.project_source_root() / '.mf6minsim' diff --git a/meson.options b/meson.options index 1ac66580078..72fba261951 100644 --- a/meson.options +++ b/meson.options @@ -1,4 +1,5 @@ -option('parallel', type : 'boolean', value : false, description : 'Parallel build') +option('extended', type : 'boolean', value : false, description : 'Extended build with external libraries') +option('parallel', type : 'boolean', value : false, description : 'Extended parallel build') option('mpich', type : 'boolean', value : false, description : 'Use MPICH version of MPI') -option('cray', type : 'boolean', value : false, description : 'Parallel build on CRAY with MPICH') +option('cray', type : 'boolean', value : false, description : 'Extended build on CRAY with MPICH') option('buildname', type : 'string', value : 'mf6', description : 'Optional build name') diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index e2be9f2e7b6..04ba48ba0dd 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -95,9 +95,13 @@ + + + + @@ -122,6 +126,7 @@ + @@ -130,10 +135,15 @@ + + + + + @@ -143,7 +153,10 @@ + + + @@ -151,62 +164,70 @@ - + + - - + - - + - - - - + + - + + + + + + + + + + + + - - + + @@ -214,12 +235,18 @@ + + + + + + @@ -260,21 +287,29 @@ + + + + + + - + - + + + @@ -353,7 +388,9 @@ - + + + @@ -361,6 +398,8 @@ + + diff --git a/msvs/mf6lib.vfproj b/msvs/mf6lib.vfproj index e89b383dde7..dee2f209199 100644 --- a/msvs/mf6lib.vfproj +++ b/msvs/mf6lib.vfproj @@ -143,13 +143,15 @@ - + + + diff --git a/pymake/excludefiles.txt b/pymake/excludefiles.txt index cc4f52a2306..33694f4ea5d 100644 --- a/pymake/excludefiles.txt +++ b/pymake/excludefiles.txt @@ -1,5 +1,6 @@ -../src/Solution/PETSc/PetscSolver.F90 ../src/Solution/PETSc/PetscConvergence.F90 +../src/Solution/PETSc/PetscImsPreconditioner.F90 +../src/Solution/PETSc/PetscSolver.F90 ../src/Solution/ParallelSolution.f90 ../src/Utilities/Matrix/PetscMatrix.F90 ../src/Utilities/Vector/PetscVector.F90 diff --git a/pymake/makefile b/pymake/makefile index 484e7798cf0..8e7065a0d6d 100644 --- a/pymake/makefile +++ b/pymake/makefile @@ -114,7 +114,6 @@ $(OBJDIR)/GwfNpfOptions.o \ $(OBJDIR)/GwfBuyInputData.o \ $(OBJDIR)/ims8misc.o \ $(OBJDIR)/LinearSolverBase.o \ -$(OBJDIR)/genericutils.o \ $(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/IndexMap.o \ $(OBJDIR)/version.o \ diff --git a/src/Distributed/InterfaceMap.f90 b/src/Distributed/InterfaceMap.f90 index d373f014b3d..ef04bba288a 100644 --- a/src/Distributed/InterfaceMap.f90 +++ b/src/Distributed/InterfaceMap.f90 @@ -1,7 +1,7 @@ module InterfaceMapModule use KindModule, only: I4B use ConstantsModule, only: LENMODELNAME, LENEXCHANGENAME - use ArrayHandlersModule, only: ExtendPtrArray, ifind + use ArrayHandlersModule, only: ifind use IndexMapModule implicit none diff --git a/src/Distributed/Mapper.f90 b/src/Distributed/Mapper.f90 index d9713d82905..16e76985762 100644 --- a/src/Distributed/Mapper.f90 +++ b/src/Distributed/Mapper.f90 @@ -51,7 +51,7 @@ subroutine add_exchange_vars(this) integer(I4B) :: iconn class(SpatialModelConnectionType), pointer :: conn class(VirtualExchangeType), pointer :: virt_exg - character(len=LENMEMPATH) :: virt_mem_path + character(len=LENMEMPATH) :: virt_mem_path, local_mem_path do iconn = 1, baseconnectionlist%Count() conn => get_smc_from_list(baseconnectionlist, iconn) @@ -60,11 +60,45 @@ subroutine add_exchange_vars(this) virt_mem_path = virt_exg%get_vrt_mem_path('NODEM1', '') call this%map_data_full(0, 'NODEM1', conn%prim_exchange%memoryPath, & 'NODEM1', virt_mem_path, (/STG_BFR_CON_DF/)) + + ! these are only present when there is a mover: + if (virt_exg%has_mover()) then + local_mem_path = create_mem_path(virt_exg%name, 'MVR') + virt_mem_path = virt_exg%get_vrt_mem_path('QPACTUAL_M1', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'QPACTUAL_M1', & + local_mem_path, 'QPACTUAL_M1', & + virt_mem_path, (/STG_BFR_EXG_FC/)) + virt_mem_path = virt_exg%get_vrt_mem_path('QAVAILABLE_M1', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'QAVAILABLE_M1', & + local_mem_path, 'QAVAILABLE_M1', & + virt_mem_path, (/STG_BFR_EXG_FC/)) + virt_mem_path = virt_exg%get_vrt_mem_path('ID_MAPPED_M1', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'ID_MAPPED_M1', & + local_mem_path, 'ID_MAPPED_M1', & + virt_mem_path, (/STG_AFT_CON_RP/)) + end if end if if (.not. virt_exg%v_model2%is_local) then virt_mem_path = virt_exg%get_vrt_mem_path('NODEM2', '') call this%map_data_full(0, 'NODEM2', conn%prim_exchange%memoryPath, & 'NODEM2', virt_mem_path, (/STG_BFR_CON_DF/)) + + ! these are only present when there is a mover: + if (virt_exg%has_mover()) then + local_mem_path = create_mem_path(virt_exg%name, 'MVR') + virt_mem_path = virt_exg%get_vrt_mem_path('QPACTUAL_M2', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'QPACTUAL_M2', & + local_mem_path, 'QPACTUAL_M2', & + virt_mem_path, (/STG_BFR_EXG_FC/)) + virt_mem_path = virt_exg%get_vrt_mem_path('QAVAILABLE_M2', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'QAVAILABLE_M2', & + local_mem_path, 'QAVAILABLE_M2', & + virt_mem_path, (/STG_BFR_EXG_FC/)) + virt_mem_path = virt_exg%get_vrt_mem_path('ID_MAPPED_M2', 'MVR') + call this%map_data_full(conn%owner%idsoln, 'ID_MAPPED_M2', & + local_mem_path, 'ID_MAPPED_M2', & + virt_mem_path, (/STG_AFT_CON_RP/)) + end if end if end do diff --git a/src/Distributed/MpiMessageBuilder.f90 b/src/Distributed/MpiMessageBuilder.f90 index 4c5c0f3c507..b92165923f8 100644 --- a/src/Distributed/MpiMessageBuilder.f90 +++ b/src/Distributed/MpiMessageBuilder.f90 @@ -713,18 +713,12 @@ subroutine get_mpi_datatype(this, virtual_data, el_displ, el_type, el_map_opt) call get_mpitype_for_int(mt, el_displ, el_type) else if (associated(mt%aint1d)) then call get_mpitype_for_int1d(mt, el_displ, el_type, el_map) - else if (associated(mt%aint2d)) then - call get_mpitype_for_int2d(mt, el_displ, el_type, el_map) - else if (associated(mt%aint3d)) then - call get_mpitype_for_int3d(mt, el_displ, el_type, el_map) else if (associated(mt%dblsclr)) then call get_mpitype_for_dbl(mt, el_displ, el_type) else if (associated(mt%adbl1d)) then call get_mpitype_for_dbl1d(mt, el_displ, el_type, el_map) else if (associated(mt%adbl2d)) then call get_mpitype_for_dbl2d(mt, el_displ, el_type, el_map) - else if (associated(mt%adbl3d)) then - call get_mpitype_for_dbl3d(mt, el_displ, el_type, el_map) else write (*, *) 'unsupported datatype in MPI messaging for ', & virtual_data%var_name, virtual_data%mem_path @@ -793,50 +787,6 @@ subroutine get_mpitype_for_int1d(mem, el_displ, el_type, el_map) end subroutine get_mpitype_for_int1d - subroutine get_mpitype_for_int2d(mem, el_displ, el_type, el_map) - type(MemoryType), pointer :: mem - integer(kind=MPI_ADDRESS_KIND) :: el_displ - integer :: el_type - integer, dimension(:), pointer :: el_map - ! local - integer :: ierr - integer :: two_integer_type - - call MPI_Get_address(mem%aint2d, el_displ, ierr) - if (associated(el_map)) then - call MPI_Type_contiguous(2, MPI_INTEGER, two_integer_type, ierr) - call MPI_Type_create_indexed_block( & - size(el_map), 1, el_map, two_integer_type, el_type, ierr) - else - call MPI_Type_contiguous(mem%isize, MPI_INTEGER, el_type, ierr) - end if - call MPI_Type_commit(el_type, ierr) - call MPI_Type_free(two_integer_type, ierr) - - end subroutine get_mpitype_for_int2d - - subroutine get_mpitype_for_int3d(mem, el_displ, el_type, el_map) - type(MemoryType), pointer :: mem - integer(kind=MPI_ADDRESS_KIND) :: el_displ - integer :: el_type - integer, dimension(:), pointer :: el_map - ! local - integer :: ierr - integer :: three_integer_type - - call MPI_Get_address(mem%aint3d, el_displ, ierr) - if (associated(el_map)) then - call MPI_Type_contiguous(3, MPI_INTEGER, three_integer_type, ierr) - call MPI_Type_create_indexed_block( & - size(el_map), 1, el_map, three_integer_type, el_type, ierr) - else - call MPI_Type_contiguous(mem%isize, MPI_INTEGER, el_type, ierr) - end if - call MPI_Type_commit(el_type, ierr) - call MPI_Type_free(three_integer_type, ierr) - - end subroutine get_mpitype_for_int3d - subroutine get_mpitype_for_dbl(mem, el_displ, el_type) type(MemoryType), pointer :: mem integer(kind=MPI_ADDRESS_KIND) :: el_displ @@ -876,41 +826,19 @@ subroutine get_mpitype_for_dbl2d(mem, el_displ, el_type, el_map) integer, dimension(:), pointer :: el_map ! local integer :: ierr - integer :: two_double_type + integer :: entry_type call MPI_Get_address(mem%adbl2d, el_displ, ierr) if (associated(el_map)) then - call MPI_Type_contiguous(2, MPI_DOUBLE_PRECISION, two_double_type, ierr) + call MPI_Type_contiguous( & + size(mem%adbl2d, dim=1), MPI_DOUBLE_PRECISION, entry_type, ierr) call MPI_Type_create_indexed_block( & - size(el_map), 1, el_map, two_double_type, el_type, ierr) + size(el_map), 1, el_map, entry_type, el_type, ierr) else call MPI_Type_contiguous(mem%isize, MPI_DOUBLE_PRECISION, el_type, ierr) end if call MPI_Type_commit(el_type, ierr) - call MPI_Type_free(two_double_type, ierr) end subroutine get_mpitype_for_dbl2d - subroutine get_mpitype_for_dbl3d(mem, el_displ, el_type, el_map) - type(MemoryType), pointer :: mem - integer(kind=MPI_ADDRESS_KIND) :: el_displ - integer :: el_type - integer, dimension(:), pointer :: el_map - ! local - integer :: ierr - integer :: three_double_type - - call MPI_Get_address(mem%adbl3d, el_displ, ierr) - if (associated(el_map)) then - call MPI_Type_contiguous(3, MPI_DOUBLE_PRECISION, three_double_type, ierr) - call MPI_Type_create_indexed_block( & - size(el_map), 1, el_map, three_double_type, el_type, ierr) - else - call MPI_Type_contiguous(mem%isize, MPI_DOUBLE_PRECISION, el_type, ierr) - end if - call MPI_Type_commit(el_type, ierr) - call MPI_Type_free(three_double_type, ierr) - - end subroutine get_mpitype_for_dbl3d - end module MpiMessageBuilderModule diff --git a/src/Distributed/MpiRouter.f90 b/src/Distributed/MpiRouter.f90 index cf0e544e016..e3cc403b832 100644 --- a/src/Distributed/MpiRouter.f90 +++ b/src/Distributed/MpiRouter.f90 @@ -129,7 +129,7 @@ subroutine mr_initialize(this) call this%message_builder%set_monitor(this%imon) ! write initial info - write (this%imon, '(a,/)') "initialize MPI Router:" + write (this%imon, '(a,/)') ">> initialize MPI Router:" write (this%imon, '(2x,a,i0)') "process id: ", proc_id write (this%imon, '(2x,a,i0)') "nr. of processes: ", nr_procs write (this%imon, '(2x,a,i0)') "nr. of models: ", nr_models @@ -138,6 +138,7 @@ subroutine mr_initialize(this) do i = 1, nr_models write (this%imon, '(4x,2i8)') i, this%model_proc_ids(i) end do + write (this%imon, '(a,/)') "<< initialize done" end if end subroutine mr_initialize @@ -175,8 +176,7 @@ subroutine mr_route_all(this, stage) integer(I4B) :: stage if (this%enable_monitor) then - write (this%imon, '(/,a)') "routing all" - write (this%imon, '(2a)') "routing stage: ", STG_TO_STR(stage) + write (this%imon, '(/,2a)') ">> routing all: ", STG_TO_STR(stage) end if ! route all @@ -185,7 +185,7 @@ subroutine mr_route_all(this, stage) call this%deactivate() if (this%enable_monitor) then - write (this%imon, '(2a,/)') "end routing all: ", STG_TO_STR(stage) + write (this%imon, '(a,/)') "<< end routing all" !call mem_print_detailed(this%imon) end if @@ -200,8 +200,8 @@ subroutine mr_route_sln(this, virtual_sol, stage) integer(I4B) :: stage if (this%enable_monitor) then - write (this%imon, '(/,a,i0)') "routing solution: ", virtual_sol%solution_id - write (this%imon, '(2a)') "routing stage: ", STG_TO_STR(stage) + write (this%imon, '(/,a,i0,2a)') ">> routing solution: ", & + virtual_sol%solution_id, ", ", STG_TO_STR(stage) end if ! route for this solution @@ -210,7 +210,7 @@ subroutine mr_route_sln(this, virtual_sol, stage) call this%deactivate() if (this%enable_monitor) then - write (this%imon, '(2a)') "end routing solution: ", STG_TO_STR(stage) + write (this%imon, '(a)') "<< end routing solution" end if end subroutine mr_route_sln diff --git a/src/Distributed/MpiRunControl.F90 b/src/Distributed/MpiRunControl.F90 index 32aa468a577..e37f50c174a 100644 --- a/src/Distributed/MpiRunControl.F90 +++ b/src/Distributed/MpiRunControl.F90 @@ -59,7 +59,6 @@ subroutine mpi_ctrl_start(this) inquire (file=petsc_db_file, exist=petsc_db_exists) if (.not. petsc_db_exists) then - write (*, *) 'WARNING. PETSc database file not found: '//petsc_db_file call PetscInitialize(PETSC_NULL_CHARACTER, ierr) CHKERRQ(ierr) else diff --git a/src/Distributed/VirtualDataManager.f90 b/src/Distributed/VirtualDataManager.f90 index d1bb0688be4..a91b5e7eabe 100644 --- a/src/Distributed/VirtualDataManager.f90 +++ b/src/Distributed/VirtualDataManager.f90 @@ -3,14 +3,16 @@ module VirtualDataManagerModule use STLVecIntModule use VirtualDataListsModule, only: virtual_model_list, virtual_exchange_list use VirtualBaseModule, only: MAP_NODE_TYPE, MAP_CONN_TYPE - use VirtualModelModule, only: get_virtual_model - use VirtualExchangeModule, only: get_virtual_exchange + use VirtualModelModule, only: get_virtual_model, get_virtual_model_from_list + use VirtualExchangeModule, only: get_virtual_exchange, & + get_virtual_exchange_from_list use VirtualSolutionModule use VirtualDataContainerModule use RouterBaseModule use RouterFactoryModule, only: create_router use ListsModule, only: basesolutionlist - use NumericalSolutionModule, only: NumericalSolutionType + use NumericalSolutionModule, only: NumericalSolutionType, & + CastAsNumericalSolutionClass use NumericalModelModule, only: NumericalModelType, GetNumericalModelFromList use NumericalExchangeModule, only: NumericalExchangeType, & GetNumericalExchangeFromList @@ -30,6 +32,7 @@ module VirtualDataManagerModule procedure :: create => vds_create procedure :: init => vds_init procedure :: add_solution => vds_add_solution + procedure :: set_halo => vds_set_halo procedure :: reduce_halo => vds_reduce_halo procedure :: synchronize => vds_synchronize procedure :: synchronize_sln => vds_synchronize_sln @@ -90,6 +93,7 @@ subroutine vds_add_solution(this, num_sol) integer(I4B) :: model_id, exg_id type(STLVecInt) :: model_ids, exchange_ids class(VirtualDataContainerType), pointer :: vdc + logical :: found this%nr_solutions = this%nr_solutions + 1 virt_sol => this%virtual_solutions(this%nr_solutions) @@ -102,16 +106,34 @@ subroutine vds_add_solution(this, num_sol) virt_sol%solution_id = num_sol%id virt_sol%numerical_solution => num_sol - ! 1) adding all local models from the solution + ! 1) adding all local models with a virtual model counterpart from the solution do im = 1, num_sol%modellist%Count() num_mod => GetNumericalModelFromList(num_sol%modellist, im) - call model_ids%push_back(num_mod%id) + found = .false. + do i = 1, virtual_model_list%Count() + vdc => get_virtual_model_from_list(virtual_model_list, i) + if (num_mod%id == vdc%id) then + found = .true. + exit + end if + end do + if (found) then + call model_ids%push_back(num_mod%id) + end if end do - ! 2) adding all local exchanges + ! 2) adding all local exchanges with a virtual exchange counterpart do ix = 1, num_sol%exchangelist%Count() exg => GetDisConnExchangeFromList(num_sol%exchangelist, ix) if (.not. associated(exg)) cycle ! interface model is handled separately + found = .false. + do i = 1, virtual_exchange_list%Count() + vdc => get_virtual_exchange_from_list(virtual_exchange_list, i) + if (exg%id == vdc%id) then + found = .true. + exit + end if + end do call exchange_ids%push_back_unique(exg%id) end do @@ -153,6 +175,69 @@ subroutine vds_add_solution(this, num_sol) end subroutine vds_add_solution + !> @brief Restrict the models and exchanges in the halo + !< to the set that has an actual chance of being used + subroutine vds_set_halo(this) + use ListsModule, only: basesolutionlist + use VirtualDataListsModule + use VirtualModelModule + use VirtualExchangeModule + class(VirtualDataManagerType) :: this + ! local + integer(I4B) :: i, imod, isol, iexg + type(STLVecInt) :: halo_model_ids + class(VirtualModelType), pointer :: vm + class(VirtualExchangeType), pointer :: ve + class(SpatialModelConnectionType), pointer :: conn + class(*), pointer :: sln_ptr + + call halo_model_ids%init() + + ! add halo models to list with ids (unique) + do isol = 1, basesolutionlist%Count() + sln_ptr => basesolutionlist%GetItem(isol) + select type (sln_ptr) + class is (NumericalSolutionType) + do iexg = 1, sln_ptr%exchangelist%Count() + conn => get_smc_from_list(sln_ptr%exchangelist, iexg) + if (.not. associated(conn)) cycle + + ! add halo model ids to the list + do i = 1, conn%halo_models%size + call halo_model_ids%push_back_unique(conn%halo_models%at(i)) + end do + end do + end select + end do + + ! deactivate models that are not local, and not in halo + do imod = 1, virtual_model_list%Count() + vm => get_virtual_model_from_list(virtual_model_list, imod) + if (.not. vm%is_local) then + if (.not. halo_model_ids%contains(vm%id)) then + vm%is_active = .false. + end if + end if + end do + + ! deactivate exchanges that are not local and outside halo + do iexg = 1, virtual_exchange_list%Count() + ve => get_virtual_exchange_from_list(virtual_exchange_list, iexg) + if (ve%v_model1%is_local .or. ve%v_model2%is_local) then + cycle + end if + if (halo_model_ids%contains(ve%v_model1%id) .and. & + halo_model_ids%contains(ve%v_model2%id)) then + cycle + end if + + ve%is_active = .false. + end do + + call halo_model_ids%destroy() + + end subroutine vds_set_halo + !> @brief Reduce the halo for all solutions. This will !< activate the mapping tables in the virtual data items. subroutine vds_reduce_halo(this) @@ -173,7 +258,7 @@ subroutine vds_reduce_halo(this) ! merge the interface maps over this process do isol = 1, this%nr_solutions virt_sol => this%virtual_solutions(isol) - num_sol => virt_sol%numerical_solution + num_sol => CastAsNumericalSolutionClass(virt_sol%numerical_solution) do iexg = 1, num_sol%exchangelist%Count() conn => get_smc_from_list(num_sol%exchangelist, iexg) if (.not. associated(conn)) cycle @@ -191,7 +276,8 @@ subroutine vds_reduce_halo(this) do isol = 1, this%nr_solutions write (outunit, '(a,i0,/)') "interface mape for solution ", & this%virtual_solutions(isol)%solution_id - call this%virtual_solutions(isol)%interface_map%print_interface(outunit) + virt_sol => this%virtual_solutions(isol) + call virt_sol%interface_map%print_interface(outunit) end do close (outunit) end if @@ -230,13 +316,16 @@ subroutine prepare_all(this, stage) integer(I4B) :: i class(VirtualDataContainerType), pointer :: vdc - ! prepare all virtual data for this stage + ! prepare all virtual data for this stage, + ! cycle inactive to avoid redundant mem allocs do i = 1, virtual_model_list%Count() vdc => get_vdc_from_list(virtual_model_list, i) + if (.not. vdc%is_active) cycle call vdc%prepare_stage(stage) end do do i = 1, virtual_exchange_list%Count() vdc => get_vdc_from_list(virtual_exchange_list, i) + if (.not. vdc%is_active) cycle call vdc%prepare_stage(stage) end do diff --git a/src/Distributed/VirtualExchange.f90 b/src/Distributed/VirtualExchange.f90 index f0554dab259..e849f990724 100644 --- a/src/Distributed/VirtualExchange.f90 +++ b/src/Distributed/VirtualExchange.f90 @@ -82,6 +82,7 @@ module VirtualExchangeModule procedure :: prepare_stage => vx_prepare_stage procedure :: get_send_items => vx_get_send_items procedure :: get_recv_items => vx_get_recv_items + procedure :: has_mover => vx_has_mover procedure :: destroy => vx_destroy ! private procedure, private :: init_virtual_data @@ -241,6 +242,16 @@ subroutine vx_get_send_items(this, stage, rank, virtual_items) end subroutine vx_get_send_items + !> @brief Checks if there is an active mover in the exchange + !< + function vx_has_mover(this) result(has_mover) + class(VirtualExchangeType) :: this + logical(LGP) :: has_mover + + has_mover = .false. + + end function vx_has_mover + subroutine vx_destroy(this) class(VirtualExchangeType) :: this diff --git a/src/Distributed/VirtualGwfExchange.f90 b/src/Distributed/VirtualGwfExchange.f90 index 4c3670d0316..c49f3b79cd4 100644 --- a/src/Distributed/VirtualGwfExchange.f90 +++ b/src/Distributed/VirtualGwfExchange.f90 @@ -1,5 +1,8 @@ module VirtualGwfExchangeModule - use KindModule, only: I4B + use KindModule, only: I4B, LGP + use STLVecIntModule + use SimStagesModule + use VirtualBaseModule use VirtualDataContainerModule, only: VDC_GWFEXG_TYPE use VirtualExchangeModule use VirtualDataListsModule, only: virtual_exchange_list @@ -8,10 +11,30 @@ module VirtualGwfExchangeModule public :: add_virtual_gwf_exchange + !> For synchronization of GWF specific exchange data: + !< the exchange movers. type, public, extends(VirtualExchangeType) :: VirtualGwfExchangeType + type(VirtualIntType), pointer :: inmvr => null() + type(VirtualIntType), pointer :: mvr_maxmvr => null() + type(VirtualDbl1dType), pointer :: mvr_qpactual_m1 => null() + type(VirtualDbl1dType), pointer :: mvr_qpactual_m2 => null() + type(VirtualDbl1dType), pointer :: mvr_qavailable_m1 => null() + type(VirtualDbl1dType), pointer :: mvr_qavailable_m2 => null() + type(VirtualInt1dType), pointer :: mvr_id_mapped_m1 => null() + type(VirtualInt1dType), pointer :: mvr_id_mapped_m2 => null() + ! private + logical(LGP), private :: has_mvr !< backing field for function contains procedure :: create => vfx_create + procedure :: prepare_stage => vfx_prepare_stage procedure :: destroy => vfx_destroy + procedure :: get_send_items => vfx_get_send_items + procedure :: get_recv_items => vfx_get_recv_items + procedure :: has_mover => vfx_has_mover + ! private + procedure, private :: allocate_data + procedure, private :: deallocate_data + procedure, private :: init_virtual_data end type VirtualGwfExchangeType contains @@ -47,12 +70,252 @@ subroutine vfx_create(this, name, exg_id, m1_id, m2_id) call this%VirtualExchangeType%create(name, exg_id, m1_id, m2_id) this%container_type = VDC_GWFEXG_TYPE + call this%allocate_data() + call this%init_virtual_data() + + this%has_mvr = .false. + end subroutine vfx_create + subroutine init_virtual_data(this) + class(VirtualGwfExchangeType) :: this + ! local + logical(LGP) :: is_nodem1_local + logical(LGP) :: is_nodem2_local + + is_nodem1_local = this%v_model1%is_local + is_nodem2_local = this%v_model2%is_local + call this%set(this%inmvr%base(), 'INMVR', '', MAP_ALL_TYPE) + call this%set(this%mvr_maxmvr%base(), 'MAXMVR', 'MVR', MAP_ALL_TYPE) + ! these follow locality of nodem1,2 + call this%set(this%mvr_qpactual_m1%base(), 'QPACTUAL_M1', 'MVR', & + MAP_ALL_TYPE, is_nodem1_local) + call this%set(this%mvr_qpactual_m2%base(), 'QPACTUAL_M2', 'MVR', & + MAP_ALL_TYPE, is_nodem2_local) + call this%set(this%mvr_qavailable_m1%base(), 'QAVAILABLE_M1', 'MVR', & + MAP_ALL_TYPE, is_nodem1_local) + call this%set(this%mvr_qavailable_m2%base(), 'QAVAILABLE_M2', 'MVR', & + MAP_ALL_TYPE, is_nodem2_local) + call this%set(this%mvr_id_mapped_m1%base(), 'ID_MAPPED_M1', 'MVR', & + MAP_ALL_TYPE, is_nodem1_local) + call this%set(this%mvr_id_mapped_m2%base(), 'ID_MAPPED_M2', 'MVR', & + MAP_ALL_TYPE, is_nodem2_local) + + end subroutine init_virtual_data + + subroutine vfx_prepare_stage(this, stage) + class(VirtualGwfExchangeType) :: this + integer(I4B) :: stage + ! local + integer(I4B) :: nmax + + ! prepare base exchange data items + call this%VirtualExchangeType%prepare_stage(stage) + + if (stage == STG_AFT_EXG_DF) then + + call this%map(this%inmvr%base(), (/STG_AFT_EXG_DF/)) + + else if (stage == STG_AFT_CON_CR) then + + ! at this point we know: + if (this%inmvr%get() > 0) then + this%has_mvr = .true. + end if + + else if (stage == STG_BFR_CON_AR) then + + ! only when MVR is active + if (this%inmvr%get() > 0) then + call this%map(this%mvr_maxmvr%base(), (/STG_BFR_CON_AR/)) + end if + + else if (stage == STG_AFT_CON_AR) then + + ! only when MVR is active + if (this%inmvr%get() > 0) then + nmax = this%mvr_maxmvr%get() + if (nmax > 0) then + call this%map(this%mvr_qpactual_m1%base(), nmax, (/STG_BFR_EXG_FC/)) + call this%map(this%mvr_qpactual_m2%base(), nmax, (/STG_BFR_EXG_FC/)) + call this%map(this%mvr_qavailable_m1%base(), nmax, (/STG_BFR_EXG_FC/)) + call this%map(this%mvr_qavailable_m2%base(), nmax, (/STG_BFR_EXG_FC/)) + call this%map(this%mvr_id_mapped_m1%base(), nmax, (/STG_AFT_CON_RP/)) + call this%map(this%mvr_id_mapped_m2%base(), nmax, (/STG_AFT_CON_RP/)) + else + call this%map(this%mvr_qpactual_m1%base(), 0, (/STG_NEVER/)) + call this%map(this%mvr_qpactual_m2%base(), 0, (/STG_NEVER/)) + call this%map(this%mvr_qavailable_m1%base(), 0, (/STG_NEVER/)) + call this%map(this%mvr_qavailable_m2%base(), 0, (/STG_NEVER/)) + call this%map(this%mvr_id_mapped_m1%base(), 0, (/STG_NEVER/)) + call this%map(this%mvr_id_mapped_m2%base(), 0, (/STG_NEVER/)) + end if + end if + + end if + + end subroutine vfx_prepare_stage + + subroutine vfx_get_recv_items(this, stage, rank, virtual_items) + class(VirtualGwfExchangeType) :: this + integer(I4B) :: stage + integer(I4B) :: rank + type(STLVecInt) :: virtual_items + ! local + integer(I4B) :: qpactual_m1_idx, qpactual_m2_idx + integer(I4B) :: qavailable_m1_idx, qavailable_m2_idx + integer(I4B) :: id_mapped_m1_idx, id_mapped_m2_idx + class(*), pointer :: vdi + + ! get base items to receive + call this%VirtualExchangeType%get_recv_items(stage, rank, & + virtual_items) + + ! add more MVR items that follow nodem1/nodem2 pattern, + ! see comments in VirtualExchange for more details. + vdi => this%mvr_qpactual_m1 + qpactual_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qpactual_m2 + qpactual_m2_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qavailable_m1 + qavailable_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qavailable_m2 + qavailable_m2_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_id_mapped_m1 + id_mapped_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_id_mapped_m2 + id_mapped_m2_idx = this%virtual_data_list%GetIndex(vdi) + + if (this%v_model1%is_local .and. & + this%v_model2%orig_rank == rank) then + ! this is our dual exchange on the other rank, + ! only receive qpactual_m2 + if (this%mvr_qpactual_m2%check_stage(stage)) then + call virtual_items%push_back(qpactual_m2_idx) + end if + if (this%mvr_qavailable_m2%check_stage(stage)) then + call virtual_items%push_back(qavailable_m2_idx) + end if + if (this%mvr_id_mapped_m2%check_stage(stage)) then + call virtual_items%push_back(id_mapped_m2_idx) + end if + else if (this%v_model2%is_local .and. & + this%v_model1%orig_rank == rank) then + ! the reverse case... + if (this%mvr_qpactual_m1%check_stage(stage)) then + call virtual_items%push_back(qpactual_m1_idx) + end if + if (this%mvr_qavailable_m1%check_stage(stage)) then + call virtual_items%push_back(qavailable_m1_idx) + end if + if (this%mvr_id_mapped_m1%check_stage(stage)) then + call virtual_items%push_back(id_mapped_m1_idx) + end if + end if + + end subroutine vfx_get_recv_items + + subroutine vfx_get_send_items(this, stage, rank, virtual_items) + class(VirtualGwfExchangeType) :: this + integer(I4B) :: stage + integer(I4B) :: rank + type(STLVecInt) :: virtual_items + ! local + integer(I4B) :: qpactual_m1_idx, qpactual_m2_idx + integer(I4B) :: qavailable_m1_idx, qavailable_m2_idx + integer(I4B) :: id_mapped_m1_idx, id_mapped_m2_idx + class(*), pointer :: vdi + + ! get base items to send + call this%VirtualExchangeType%get_send_items(stage, rank, & + virtual_items) + + ! add more MVR items that follow nodem1/nodem2 pattern + vdi => this%mvr_qpactual_m1 + qpactual_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qpactual_m2 + qpactual_m2_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qavailable_m1 + qavailable_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_qavailable_m2 + qavailable_m2_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_id_mapped_m1 + id_mapped_m1_idx = this%virtual_data_list%GetIndex(vdi) + vdi => this%mvr_id_mapped_m2 + id_mapped_m2_idx = this%virtual_data_list%GetIndex(vdi) + + if (this%v_model1%is_local .and. & + this%v_model2%orig_rank == rank) then + ! this is our dual exchange on the other rank, + ! only add qpactual_m1 + if (this%mvr_qpactual_m1%check_stage(stage)) then + call virtual_items%push_back(qpactual_m1_idx) + end if + if (this%mvr_qavailable_m1%check_stage(stage)) then + call virtual_items%push_back(qavailable_m1_idx) + end if + if (this%mvr_id_mapped_m1%check_stage(stage)) then + call virtual_items%push_back(id_mapped_m1_idx) + end if + else if (this%v_model2%is_local .and. & + this%v_model1%orig_rank == rank) then + ! the reverse case... + if (this%mvr_qpactual_m2%check_stage(stage)) then + call virtual_items%push_back(qpactual_m2_idx) + end if + if (this%mvr_qavailable_m2%check_stage(stage)) then + call virtual_items%push_back(qavailable_m2_idx) + end if + if (this%mvr_id_mapped_m2%check_stage(stage)) then + call virtual_items%push_back(id_mapped_m2_idx) + end if + end if + + end subroutine vfx_get_send_items + + !> @brief Override + !< + function vfx_has_mover(this) result(has_mover) + class(VirtualGwfExchangeType) :: this + logical(LGP) :: has_mover + + has_mover = this%has_mvr + + end function vfx_has_mover + + subroutine allocate_data(this) + class(VirtualGwfExchangeType) :: this + + allocate (this%inmvr) + allocate (this%mvr_maxmvr) + allocate (this%mvr_qpactual_m1) + allocate (this%mvr_qpactual_m2) + allocate (this%mvr_qavailable_m1) + allocate (this%mvr_qavailable_m2) + allocate (this%mvr_id_mapped_m1) + allocate (this%mvr_id_mapped_m2) + + end subroutine allocate_data + + subroutine deallocate_data(this) + class(VirtualGwfExchangeType) :: this + + deallocate (this%inmvr) + deallocate (this%mvr_maxmvr) + deallocate (this%mvr_qpactual_m1) + deallocate (this%mvr_qpactual_m2) + deallocate (this%mvr_qavailable_m1) + deallocate (this%mvr_qavailable_m2) + deallocate (this%mvr_id_mapped_m1) + deallocate (this%mvr_id_mapped_m2) + + end subroutine deallocate_data + subroutine vfx_destroy(this) class(VirtualGwfExchangeType) :: this call this%VirtualExchangeType%destroy() + call this%deallocate_data() end subroutine vfx_destroy diff --git a/src/Distributed/VirtualGwfModel.f90 b/src/Distributed/VirtualGwfModel.f90 index 86a973e5a13..0f6d2390ade 100644 --- a/src/Distributed/VirtualGwfModel.f90 +++ b/src/Distributed/VirtualGwfModel.f90 @@ -16,6 +16,7 @@ module VirtualGwfModelModule type(VirtualIntType), pointer :: npf_iangle2 => null() type(VirtualIntType), pointer :: npf_iangle3 => null() type(VirtualIntType), pointer :: npf_iwetdry => null() + type(VirtualIntType), pointer :: inbuy => null() type(VirtualInt1dType), pointer :: npf_icelltype => null() type(VirtualDbl1dType), pointer :: npf_k11 => null() type(VirtualDbl1dType), pointer :: npf_k22 => null() @@ -24,6 +25,7 @@ module VirtualGwfModelModule type(VirtualDbl1dType), pointer :: npf_angle2 => null() type(VirtualDbl1dType), pointer :: npf_angle3 => null() type(VirtualDbl1dType), pointer :: npf_wetdry => null() + type(VirtualDbl1dType), pointer :: buy_dense => null() contains ! public procedure :: create => vgwf_create @@ -78,6 +80,7 @@ subroutine init_virtual_data(this) call this%set(this%npf_iangle2%base(), 'IANGLE2', 'NPF', MAP_ALL_TYPE) call this%set(this%npf_iangle3%base(), 'IANGLE3', 'NPF', MAP_ALL_TYPE) call this%set(this%npf_iwetdry%base(), 'IWETDRY', 'NPF', MAP_ALL_TYPE) + call this%set(this%inbuy%base(), 'INBUY', '', MAP_ALL_TYPE) call this%set(this%npf_icelltype%base(), 'ICELLTYPE', 'NPF', MAP_NODE_TYPE) call this%set(this%npf_k11%base(), 'K11', 'NPF', MAP_NODE_TYPE) call this%set(this%npf_k22%base(), 'K22', 'NPF', MAP_NODE_TYPE) @@ -86,6 +89,7 @@ subroutine init_virtual_data(this) call this%set(this%npf_angle2%base(), 'ANGLE2', 'NPF', MAP_NODE_TYPE) call this%set(this%npf_angle3%base(), 'ANGLE3', 'NPF', MAP_NODE_TYPE) call this%set(this%npf_wetdry%base(), 'WETDRY', 'NPF', MAP_NODE_TYPE) + call this%set(this%buy_dense%base(), 'DENSE', 'BUY', MAP_NODE_TYPE) end subroutine init_virtual_data @@ -104,6 +108,7 @@ subroutine vgwf_prepare_stage(this, stage) call this%map(this%npf_iangle2%base(), (/STG_AFT_MDL_DF/)) call this%map(this%npf_iangle3%base(), (/STG_AFT_MDL_DF/)) call this%map(this%npf_iwetdry%base(), (/STG_AFT_MDL_DF/)) + call this%map(this%inbuy%base(), (/STG_AFT_MDL_DF/)) else if (stage == STG_BFR_CON_AR) then @@ -142,6 +147,12 @@ subroutine vgwf_prepare_stage(this, stage) call this%map(this%npf_wetdry%base(), 0, (/STG_NEVER/)) end if + if (this%inbuy%get() > 0) then + call this%map(this%buy_dense%base(), nr_nodes, (/STG_BFR_EXG_CF/)) + else + call this%map(this%buy_dense%base(), 0, (/STG_NEVER/)) + end if + end if end subroutine vgwf_prepare_stage @@ -161,6 +172,7 @@ subroutine allocate_data(this) allocate (this%npf_iangle2) allocate (this%npf_iangle3) allocate (this%npf_iwetdry) + allocate (this%inbuy) allocate (this%npf_icelltype) allocate (this%npf_k11) allocate (this%npf_k22) @@ -169,6 +181,7 @@ subroutine allocate_data(this) allocate (this%npf_angle2) allocate (this%npf_angle3) allocate (this%npf_wetdry) + allocate (this%buy_dense) end subroutine allocate_data @@ -179,6 +192,7 @@ subroutine deallocate_data(this) deallocate (this%npf_iangle2) deallocate (this%npf_iangle3) deallocate (this%npf_iwetdry) + deallocate (this%inbuy) deallocate (this%npf_icelltype) deallocate (this%npf_k11) deallocate (this%npf_k22) @@ -187,6 +201,7 @@ subroutine deallocate_data(this) deallocate (this%npf_angle2) deallocate (this%npf_angle3) deallocate (this%npf_wetdry) + deallocate (this%buy_dense) end subroutine deallocate_data diff --git a/src/Distributed/VirtualGwtModel.f90 b/src/Distributed/VirtualGwtModel.f90 index 4d0b526da89..75e796886bc 100644 --- a/src/Distributed/VirtualGwtModel.f90 +++ b/src/Distributed/VirtualGwtModel.f90 @@ -89,7 +89,7 @@ subroutine init_virtual_data(this) call this%set(this%fmi_gwfhead%base(), 'GWFHEAD', 'FMI', MAP_NODE_TYPE) call this%set(this%fmi_gwfsat%base(), 'GWFSAT', 'FMI', MAP_NODE_TYPE) call this%set(this%fmi_gwfspdis%base(), 'GWFSPDIS', 'FMI', MAP_NODE_TYPE) - call this%set(this%fmi_gwfflowja%base(), 'GWFFLOWJA', 'FMI', MAP_NODE_TYPE) + call this%set(this%fmi_gwfflowja%base(), 'GWFFLOWJA', 'FMI', MAP_CONN_TYPE) call this%set(this%mst_thetam%base(), 'THETAM', 'MST', MAP_NODE_TYPE) call this%set(this%indsp%base(), 'INDSP', '', MAP_ALL_TYPE) call this%set(this%inmst%base(), 'INMST', '', MAP_ALL_TYPE) @@ -117,6 +117,9 @@ subroutine vgwt_prepare_stage(this, stage) else if (stage == STG_BFR_CON_AR) then + nr_nodes = this%element_maps(MAP_NODE_TYPE)%nr_virt_elems + nr_conns = this%element_maps(MAP_CONN_TYPE)%nr_virt_elems + call this%map(this%x%base(), nr_nodes, & (/STG_BFR_CON_AR, STG_BFR_EXG_AD, STG_BFR_EXG_CF/)) call this%map(this%ibound%base(), nr_nodes, (/STG_BFR_CON_AR/)) diff --git a/src/Distributed/VirtualModel.f90 b/src/Distributed/VirtualModel.f90 index 4a5f761e865..8eca0628f6c 100644 --- a/src/Distributed/VirtualModel.f90 +++ b/src/Distributed/VirtualModel.f90 @@ -13,9 +13,15 @@ module VirtualModelModule public :: get_virtual_model_from_list public :: get_virtual_model + interface get_virtual_model + module procedure get_virtual_model_by_id, & + get_virtual_model_by_name + end interface + type, public, extends(VirtualDataContainerType) :: VirtualModelType class(NumericalModelType), pointer :: local_model ! CON + type(VirtualIntType), pointer :: con_ianglex => null() type(VirtualInt1dType), pointer :: con_ia => null() type(VirtualInt1dType), pointer :: con_ja => null() type(VirtualInt1dType), pointer :: con_jas => null() @@ -44,6 +50,8 @@ module VirtualModelModule type(VirtualDbl1dType), pointer :: x => null() type(VirtualDbl1dType), pointer :: x_old => null() type(VirtualInt1dType), pointer :: ibound => null() + ! Base Model fields + type(VirtualIntType), pointer :: idsoln => null() contains ! public procedure :: create => vm_create @@ -86,6 +94,7 @@ subroutine init_virtual_data(this) class(VirtualModelType) :: this ! CON + call this%set(this%con_ianglex%base(), 'IANGLEX', 'CON', MAP_ALL_TYPE) call this%set(this%con_ia%base(), 'IA', 'CON', MAP_ALL_TYPE) call this%set(this%con_ja%base(), 'JA', 'CON', MAP_ALL_TYPE) call this%set(this%con_jas%base(), 'JAS', 'CON', MAP_ALL_TYPE) @@ -114,6 +123,8 @@ subroutine init_virtual_data(this) call this%set(this%x%base(), 'X', '', MAP_NODE_TYPE) call this%set(this%x_old%base(), 'XOLD', '', MAP_NODE_TYPE) call this%set(this%ibound%base(), 'IBOUND', '', MAP_NODE_TYPE) + ! Base model + call this%set(this%idsoln%base(), 'IDSOLN', '', MAP_ALL_TYPE) end subroutine init_virtual_data @@ -126,6 +137,8 @@ subroutine vm_prepare_stage(this, stage) if (stage == STG_AFT_MDL_DF) then + call this%map(this%idsoln%base(), (/STG_AFT_MDL_DF/)) + call this%map(this%con_ianglex%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_ndim%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_nodes%base(), (/STG_AFT_MDL_DF/)) call this%map(this%dis_nodesuser%base(), (/STG_AFT_MDL_DF/)) @@ -167,7 +180,11 @@ subroutine vm_prepare_stage(this, stage) call this%map(this%con_hwva%base(), njas, (/STG_BFR_CON_DF/)) call this%map(this%con_cl1%base(), njas, (/STG_BFR_CON_DF/)) call this%map(this%con_cl2%base(), njas, (/STG_BFR_CON_DF/)) - call this%map(this%con_anglex%base(), njas, (/STG_BFR_CON_DF/)) + if (this%con_ianglex%get() > 0) then + call this%map(this%con_anglex%base(), njas, (/STG_BFR_CON_DF/)) + else + call this%map(this%con_anglex%base(), 0, (/STG_NEVER/)) + end if end if @@ -216,6 +233,7 @@ end subroutine vm_destroy subroutine allocate_data(this) class(VirtualModelType) :: this + allocate (this%con_ianglex) allocate (this%con_ia) allocate (this%con_ja) allocate (this%con_jas) @@ -242,6 +260,7 @@ subroutine allocate_data(this) allocate (this%x) allocate (this%x_old) allocate (this%ibound) + allocate (this%idsoln) end subroutine allocate_data @@ -249,6 +268,7 @@ subroutine deallocate_data(this) class(VirtualModelType) :: this ! CON + deallocate (this%con_ianglex) deallocate (this%con_ia) deallocate (this%con_ja) deallocate (this%con_jas) @@ -276,6 +296,8 @@ subroutine deallocate_data(this) deallocate (this%x) deallocate (this%x_old) deallocate (this%ibound) + ! Base model + deallocate (this%idsoln) end subroutine deallocate_data @@ -322,9 +344,9 @@ function eq_numerical_model(this, num_model) result(is_equal) end function eq_numerical_model -!> @brief Returns a virtual model with the specified id -!< from the global list - function get_virtual_model(model_id) result(virtual_model) + !> @brief Returns a virtual model with the specified id + !< from the global list, or null + function get_virtual_model_by_id(model_id) result(virtual_model) use VirtualDataListsModule, only: virtual_model_list integer(I4B) :: model_id class(VirtualModelType), pointer :: virtual_model @@ -344,6 +366,30 @@ function get_virtual_model(model_id) result(virtual_model) end select end do - end function get_virtual_model + end function get_virtual_model_by_id + + !> @brief Returns a virtual model with the specified name + !< from the global list, or null + function get_virtual_model_by_name(model_name) result(virtual_model) + use VirtualDataListsModule, only: virtual_model_list + character(len=*) :: model_name + class(VirtualModelType), pointer :: virtual_model + ! local + integer(I4B) :: i + class(*), pointer :: vm + + virtual_model => null() + do i = 1, virtual_model_list%Count() + vm => virtual_model_list%GetItem(i) + select type (vm) + class is (VirtualModelType) + if (vm%name == model_name) then + virtual_model => vm + return + end if + end select + end do + + end function get_virtual_model_by_name end module VirtualModelModule diff --git a/src/Distributed/VirtualSolution.f90 b/src/Distributed/VirtualSolution.f90 index 94a7c94ca5b..0433ba6a8b2 100644 --- a/src/Distributed/VirtualSolution.f90 +++ b/src/Distributed/VirtualSolution.f90 @@ -2,7 +2,6 @@ module VirtualSolutionModule use KindModule, only: I4B use ListModule use VirtualDataContainerModule, only: VdcPtrType - use NumericalSolutionModule ! TODO_MJR: this should not be here!! use InterfaceMapModule implicit none private @@ -13,7 +12,7 @@ module VirtualSolutionModule integer(I4B) :: solution_id = -1 type(VdcPtrType), dimension(:), pointer :: models => null() !< the models as virtual data containers (wrapped) type(VdcPtrType), dimension(:), pointer :: exchanges => null() !< the exchanges as virtual data containers (wrapped) - class(NumericalSolutionType), pointer :: numerical_solution => null() !< points back to the actual numerical solution + class(*), pointer :: numerical_solution => null() !< points back to the actual numerical solution type(InterfaceMapType), pointer :: interface_map => null() !< contains the aggregate interface map for the solution !! NB: the aggregation is over multiple interface models !! and there is no unique numbering there. The target diff --git a/src/Exchange/BaseExchange.f90 b/src/Exchange/BaseExchange.f90 index 5b323c6ea52..afc1406f79a 100644 --- a/src/Exchange/BaseExchange.f90 +++ b/src/Exchange/BaseExchange.f90 @@ -14,8 +14,11 @@ module BaseExchangeModule type, abstract :: BaseExchangeType character(len=LENEXCHANGENAME) :: name !< the name of this exchange character(len=LENMEMPATH) :: memoryPath !< the location in the memory manager where the variables are stored + character(len=LENMEMPATH) :: input_mempath integer(I4B) :: id + contains + procedure(exg_df), deferred :: exg_df procedure(exg_ar), deferred :: exg_ar procedure :: exg_rp @@ -42,18 +45,13 @@ subroutine exg_ar(this) contains + !> @brief Read and prepare + !< subroutine exg_rp(this) -! ****************************************************************************** -! exg_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: readnewdata ! -- dummy class(BaseExchangeType) :: this -! ------------------------------------------------------------------------------ ! ! -- Check with TDIS on whether or not it is time to RP if (.not. readnewdata) return @@ -64,17 +62,11 @@ subroutine exg_rp(this) return end subroutine exg_rp + !> @brief Calculate time step length + !< subroutine exg_calculate_delt(this) -! ****************************************************************************** -! exg_calculate_delt -- Calculate time step length -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BaseExchangeType) :: this -! ------------------------------------------------------------------------------ ! ! -- Nothing to do for TU ! @@ -82,78 +74,59 @@ subroutine exg_calculate_delt(this) return end subroutine exg_calculate_delt + !> @brief Run output routines + !< subroutine exg_ot(this) -! ****************************************************************************** -! exg_ot -- Output -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BaseExchangeType) :: this -! ------------------------------------------------------------------------------ ! ! -- Return return end subroutine exg_ot + !> @brief Final processing + !< subroutine exg_fp(this) -! ****************************************************************************** -! exg_fp -- Final processing -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BaseExchangeType) :: this -! ------------------------------------------------------------------------------ ! ! -- Return return end subroutine exg_fp + !> @brief Deallocate memory + !< subroutine exg_da(this) -! ****************************************************************************** -! exg_da -- Deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BaseExchangeType) :: this -! ------------------------------------------------------------------------------ ! ! -- Return return end subroutine exg_da - !> @brief should return true when the exchange should be - !! added to the solution where the model resides + !> @brief Should return true when the exchange should be added to the + !! solution where the model resides !< function connects_model(this, model) result(is_connected) + ! -- dummy class(BaseExchangeType) :: this !< the instance of the exchange class(BaseModelType), pointer, intent(in) :: model !< the model to which the exchange might hold a connection + ! -- return logical(LGP) :: is_connected !< true, when connected - + ! is_connected = .false. - + ! + ! -- Return + return end function + !> @brief Cast the object passed in as BaseExchangeType and return it + !< function CastAsBaseExchangeClass(obj) result(res) -! ****************************************************************************** -! CastAsBaseExchangeClass -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(*), pointer, intent(inout) :: obj ! -- return class(BaseExchangeType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -162,47 +135,41 @@ function CastAsBaseExchangeClass(obj) result(res) class is (BaseExchangeType) res => obj end select + ! + ! -- Return return end function CastAsBaseExchangeClass + !> @brief Add the exchange object (BaseExchangeType) to a list + !< subroutine AddBaseExchangeToList(list, exchange) -! ****************************************************************************** -! AddBaseExchangeToList -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list class(BaseExchangeType), pointer, intent(inout) :: exchange ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => exchange call list%Add(obj) ! + ! -- Return return end subroutine AddBaseExchangeToList + !> @brief Retrieve a specific BaseExchangeType object from a list + !< function GetBaseExchangeFromList(list, idx) result(res) -! ****************************************************************************** -! GetBaseExchangeFromList -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx class(BaseExchangeType), pointer :: res ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => list%GetItem(idx) res => CastAsBaseExchangeClass(obj) ! + ! -- Return return end function GetBaseExchangeFromList diff --git a/src/Exchange/DisConnExchange.f90 b/src/Exchange/DisConnExchange.f90 index b8f5118009d..b41402dc366 100644 --- a/src/Exchange/DisConnExchange.f90 +++ b/src/Exchange/DisConnExchange.f90 @@ -2,10 +2,10 @@ module DisConnExchangeModule use KindModule, only: I4B, DP, LGP use SimVariablesModule, only: errmsg use ConstantsModule, only: LENAUXNAME, LENBOUNDNAME, LINELENGTH + use SimModule, only: store_error, count_errors, store_error_filename use CharacterStringModule use ListModule, only: ListType use MemoryManagerModule, only: mem_allocate, mem_reallocate - use BlockParserModule, only: BlockParserType use NumericalModelModule, only: NumericalModelType use VirtualModelModule, only: VirtualModelType use NumericalExchangeModule, only: NumericalExchangeType @@ -28,7 +28,7 @@ module DisConnExchangeModule class(VirtualModelType), pointer :: v_model1 => null() !< virtual model 1 class(VirtualModelType), pointer :: v_model2 => null() !< virtual model 2 logical(LGP) :: is_datacopy !< when true, this exchange is just a data copy on another process and - !! not responsible for controlling movers, observations, ... + !! not responsible for controlling movers, observations, ... TODO_MJR: refactor this with the new mover!!! integer(I4B), pointer :: nexg => null() !< number of exchanges integer(I4B), dimension(:), pointer, contiguous :: nodem1 => null() !< node numbers in model 1 @@ -49,12 +49,12 @@ module DisConnExchangeModule integer(I4B), pointer :: ianglex => null() !< flag indicating anglex was read, if read, ianglex is index in auxvar integer(I4B), pointer :: icdist => null() !< flag indicating cdist was read, if read, icdist is index in auxvar integer(I4B), pointer :: iprpak => null() !< print input flag + integer(I4B), pointer :: iprflow => null() !< print flag for cell by cell flows + integer(I4B), pointer :: ipakcb => null() !< save flag for cell by cell flows integer(I4B), pointer :: inamedbound => null() !< flag to read boundnames integer(I4B), pointer :: ixt3d => null() !< flag indicating if XT3D should be applied on the interface: 0 = off, 1 = lhs, 2 = rhs - logical(LGP) :: dev_ifmod_on !< development option, forces interface model for this exchange - - type(BlockParserType) :: parser !< block parser for input file (controlled from derived type) + logical(LGP), pointer :: dev_ifmod_on !< development option, forces interface model for this exchange contains @@ -64,50 +64,67 @@ module DisConnExchangeModule procedure :: use_interface_model ! protected - procedure, pass(this) :: parse_option - procedure, pass(this) :: read_dimensions - procedure, pass(this) :: read_data + procedure, pass(this) :: source_options + procedure, pass(this) :: source_dimensions + procedure, pass(this) :: source_data + procedure, pass(this) :: noder + procedure, pass(this) :: cellstr end type DisConnExchangeType + !> @ brief DisConnExchangeFoundType + !! + !! This type is used to simplify the tracking of common parameters + !! that are sourced from the input context. + !< + type DisConnExchangeFoundType + logical :: naux = .false. + logical :: ipakcb = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: boundnames = .false. + logical :: auxiliary = .false. + logical :: dev_ifmod_on = .false. + logical :: nexg = .false. + end type DisConnExchangeFoundType + contains - !> @brief Parse option from exchange file + !> @brief Source options from input context !< - function parse_option(this, keyword, iout) result(parsed) + subroutine source_options(this, iout) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value use ArrayHandlersModule, only: ifind - use InputOutputModule, only: urdaux + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object - character(len=LINELENGTH), intent(in) :: keyword !< the option name integer(I4B), intent(in) :: iout !< for logging - logical(LGP) :: parsed !< true when parsed - ! local - integer(I4B) :: istart - integer(I4B) :: istop - integer(I4B) :: lloc - integer(I4B) :: n - integer(I4B) :: ival - - character(len=:), allocatable :: line - character(len=LENAUXNAME), dimension(:), allocatable :: caux - - parsed = .true. - - select case (keyword) - case ('AUXILIARY') - call this%parser%GetRemainingLine(line) - lloc = 1 - call urdaux(this%naux, this%parser%iuactive, iout, lloc, istart, & - istop, caux, line, 'GWF_GWF_Exchange') + ! -- local + type(DisConnExchangeFoundType) :: found + integer(I4B) :: ival, n + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%naux, 'NAUX', this%input_mempath, found%naux) + call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb) + call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak) + call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow) + call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, & + found%boundnames) + call mem_set_value(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%input_mempath, & + found%dev_ifmod_on) + ! + ! -- reallocate aux arrays if aux variables provided + if (found%naux .and. this%naux > 0) then call mem_reallocate(this%auxname, LENAUXNAME, this%naux, & 'AUXNAME', this%memoryPath) call mem_reallocate(this%auxname_cst, LENAUXNAME, this%naux, & 'AUXNAME_CST', this%memoryPath) + call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, & + found%auxiliary) + ! do n = 1, this%naux - this%auxname(n) = caux(n) - this%auxname_cst(n) = caux(n) + this%auxname(n) = this%auxname_cst(n) end do - deallocate (caux) ! ! -- If ANGLDEGX is an auxiliary variable, then anisotropy can be ! used in either model. Store ANGLDEGX position in this%ianglex @@ -115,250 +132,329 @@ function parse_option(this, keyword, iout) result(parsed) if (ival > 0) then this%ianglex = ival end if + ! ival = ifind(this%auxname, 'CDIST') if (ival > 0) then this%icdist = ival end if - case ('PRINT_INPUT') - this%iprpak = 1 + end if + ! + if (found%ipakcb) then + this%ipakcb = -1 + write (iout, '(4x,a)') & + 'EXCHANGE FLOWS WILL BE SAVED TO BINARY BUDGET FILES.' + end if + ! + if (found%iprpak) then write (iout, '(4x,a)') & 'THE LIST OF EXCHANGES WILL BE PRINTED.' - case ('XT3D') - this%ixt3d = 1 - write (iout, '(4x,a)') 'XT3D WILL BE APPLIED ON THE INTERFACE' - case ('BOUNDNAMES') - this%inamedbound = 1 + end if + ! + if (found%iprflow) then + write (iout, '(4x,a)') & + 'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.' + end if + ! + if (found%boundnames) then write (iout, '(4x,a)') 'EXCHANGE BOUNDARIES HAVE NAMES IN LAST COLUMN' - case ('DEV_INTERFACEMODEL_ON') - call this%parser%DevOpt() - this%dev_ifmod_on = .true. + end if + ! + if (found%dev_ifmod_on) then write (iout, '(4x,2a)') 'Interface model coupling approach manually & &activated for ', trim(this%name) - case default - ! not parsed here, assuming it is in derived type - parsed = .false. - end select - - end function parse_option + end if + ! + ! -- Return + return + end subroutine source_options - !> @brief Read dimensions from file + !> @brief Source dimension from input context !< - subroutine read_dimensions(this, iout) - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error + subroutine source_dimensions(this, iout) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object - integer(I4B), intent(in) :: iout !< output file unit - ! local - character(len=LINELENGTH) :: keyword - integer(I4B) :: ierr - logical :: isfound, endOfBlock - - ! get dimensions block - call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & - supportOpenClose=.true.) + integer(I4B), intent(in) :: iout !< for logging + ! -- local + type(DisConnExchangeFoundType) :: found + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%nexg, 'NEXG', this%input_mempath, found%nexg) + ! + write (iout, '(1x,a)') 'PROCESSING EXCHANGE DIMENSIONS' + ! + if (found%nexg) then + write (iout, '(4x,a,i0)') 'NEXG = ', this%nexg + end if + ! + write (iout, '(1x,a)') 'END OF EXCHANGE DIMENSIONS' + ! + ! -- return + return + end subroutine source_dimensions - ! parse NEXG - if (isfound) then - write (iout, '(1x,a)') 'PROCESSING EXCHANGE DIMENSIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case ('NEXG') - this%nexg = this%parser%GetInteger() - write (iout, '(4x,a,i0)') 'NEXG = ', this%nexg - case default - errmsg = "Unknown dimension '"//trim(keyword)//"'." - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - write (iout, '(1x,a)') 'END OF EXCHANGE DIMENSIONS' + !> @brief Returns reduced node number from user + !< specified cell id. + function noder(this, model, cellid, iout) + ! -- modules + use GeomUtilModule, only: get_node + ! -- dummy + class(DisConnExchangeType) :: this !< instance of exchange object + class(NumericalModelType), pointer, intent(in) :: model + integer(I4B), dimension(:), pointer, intent(in) :: cellid + integer(I4B), intent(in) :: iout !< the output file unit + integer(I4B) :: noder, node + ! + if (model%dis%ndim == 1) then + node = cellid(1) + elseif (model%dis%ndim == 2) then + node = get_node(cellid(1), 1, cellid(2), & + model%dis%mshape(1), 1, & + model%dis%mshape(2)) else - call store_error('Required dimensions block not found.') - call this%parser%StoreErrorUnit() + node = get_node(cellid(1), cellid(2), cellid(3), & + model%dis%mshape(1), & + model%dis%mshape(2), & + model%dis%mshape(3)) end if + noder = model%dis%get_nodenumber(node, 0) + ! + ! -- return + return + end function noder + !> @brief + !< + function cellstr(this, ndim, cellid, iout) + ! -- modules + ! -- dummy + class(DisConnExchangeType) :: this !< instance of exchange object + integer(I4B) :: ndim !< model DIS dimension + integer(I4B), dimension(:), pointer, intent(in) :: cellid + integer(I4B), intent(in) :: iout !< the output file unit + character(len=20) :: cellstr + character(len=*), parameter :: fmtndim1 = & + "('(',i0,')')" + character(len=*), parameter :: fmtndim2 = & + "('(',i0,',',i0,')')" + character(len=*), parameter :: fmtndim3 = & + "('(',i0,',',i0,',',i0,')')" + ! + cellstr = '' + ! + select case (ndim) + case (1) + write (cellstr, fmtndim1) cellid(1) + case (2) + write (cellstr, fmtndim2) cellid(1), cellid(2) + case (3) + write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3) + case default + end select + ! + ! -- return return - end subroutine read_dimensions + end function cellstr - !> @brief Read exchange data block from file + !> @brief Source exchange data from input context !< - subroutine read_data(this, iout) - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, store_error_unit, count_errors + subroutine source_data(this, iout) + ! -- modules + use MemoryManagerModule, only: mem_setptr + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object integer(I4B), intent(in) :: iout !< the output file unit - ! local - character(len=20) :: cellid1, cellid2 + ! -- local + integer(I4B), dimension(:, :), contiguous, pointer :: cellidm1 + integer(I4B), dimension(:, :), contiguous, pointer :: cellidm2 + integer(I4B), dimension(:), contiguous, pointer :: ihc + real(DP), dimension(:), contiguous, pointer :: cl1 + real(DP), dimension(:), contiguous, pointer :: cl2 + real(DP), dimension(:), contiguous, pointer :: hwva + real(DP), dimension(:, :), contiguous, pointer :: auxvar + type(CharacterStringType), dimension(:), contiguous, pointer :: boundname + integer(I4B) :: ndim1, ndim2 + character(len=20) :: cellstr1, cellstr2 character(len=2) :: cnfloat - integer(I4B) :: lloc, ierr, nerr, iaux + integer(I4B) :: nerr, iaux integer(I4B) :: iexg, nodem1, nodem2 - logical :: isfound, endOfBlock - - character(len=*), parameter :: fmtexglabel = "(5x, 3a10, 50(a16))" + ! -- format + character(len=*), parameter :: fmtexglabel = "(1x, 3a10, 50(a16))" character(len=*), parameter :: fmtexgdata = & "(5x, a, 1x, a ,I10, 50(1pg16.6))" character(len=40) :: fmtexgdata2 - - ! get data block - call this%parser%GetBlock('EXCHANGEDATA', isfound, ierr, & - supportOpenClose=.true.) - if (isfound) then - write (iout, '(1x,a)') 'PROCESSING EXCHANGEDATA' - if (this%iprpak /= 0) then - if (this%inamedbound == 0) then - write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', & - 'CL1', 'CL2', 'HWVA', (adjustr(this%auxname(iaux)), & - iaux=1, this%naux) - else - write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', 'CL1', 'CL2', & - 'HWVA', (adjustr(this%auxname(iaux)), iaux=1, this%naux), & - ' BOUNDNAME ' - ! Define format suitable for writing input data, - ! any auxiliary variables, and boundname. - write (cnfloat, '(i0)') 3 + this%naux - fmtexgdata2 = '(5x, a, 1x, a, i10, '//trim(cnfloat)// & - '(1pg16.6), 1x, a)' - end if + ! + call mem_setptr(cellidm1, 'CELLIDM1', this%input_mempath) + call mem_setptr(cellidm2, 'CELLIDM2', this%input_mempath) + call mem_setptr(ihc, 'IHC', this%input_mempath) + call mem_setptr(cl1, 'CL1', this%input_mempath) + call mem_setptr(cl2, 'CL2', this%input_mempath) + call mem_setptr(hwva, 'HWVA', this%input_mempath) + call mem_setptr(auxvar, 'AUX', this%input_mempath) + call mem_setptr(boundname, 'BOUNDNAME', this%input_mempath) + ndim1 = size(cellidm1, dim=1) + ndim2 = size(cellidm2, dim=1) + ! + write (iout, '(1x,a)') 'PROCESSING EXCHANGEDATA' + ! + if (this%iprpak /= 0) then + if (this%inamedbound == 0) then + write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', & + 'CL1', 'CL2', 'HWVA', (adjustr(this%auxname(iaux)), & + iaux=1, this%naux) + else + write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', 'CL1', 'CL2', & + 'HWVA', (adjustr(this%auxname(iaux)), iaux=1, this%naux), & + ' BOUNDNAME ' + ! Define format suitable for writing input data, + ! any auxiliary variables, and boundname. + write (cnfloat, '(i0)') 3 + this%naux + fmtexgdata2 = '(5x, a, 1x, a, i10, '//trim(cnfloat)// & + '(1pg16.6), 1x, a)' end if - do iexg = 1, this%nexg - call this%parser%GetNextLine(endOfBlock) - lloc = 1 - ! - ! -- Read and check node 1 - call this%parser%GetCellid(this%v_model1%dis_ndim%get(), cellid1, & - flag_string=.true.) - if (associated(this%model1)) then - nodem1 = this%model1%dis%noder_from_cellid(cellid1, & - this%parser%iuactive, & - iout, flag_string=.true.) - this%nodem1(iexg) = nodem1 - else - this%nodem1(iexg) = -1 - end if - ! - ! -- Read and check node 2 - call this%parser%GetCellid(this%v_model2%dis_ndim%get(), cellid2, & - flag_string=.true.) - if (associated(this%model2)) then - nodem2 = this%model2%dis%noder_from_cellid(cellid2, & - this%parser%iuactive, & - iout, flag_string=.true.) - this%nodem2(iexg) = nodem2 - else - this%nodem2(iexg) = -1 - end if + end if + ! + do iexg = 1, this%nexg + ! + if (associated(this%model1)) then ! - ! -- Read rest of input line - this%ihc(iexg) = this%parser%GetInteger() - this%cl1(iexg) = this%parser%GetDouble() - this%cl2(iexg) = this%parser%GetDouble() - this%hwva(iexg) = this%parser%GetDouble() - do iaux = 1, this%naux - this%auxvar(iaux, iexg) = this%parser%GetDouble() - end do - if (this%inamedbound == 1) then - call this%parser%GetStringCaps(this%boundname(iexg)) - end if + ! -- Determine reduced node number + nodem1 = this%noder(this%model1, cellidm1(:, iexg), iout) + this%nodem1(iexg) = nodem1 ! - ! -- Write the data to listing file if requested - if (this%iprpak /= 0) then - if (this%inamedbound == 0) then - write (iout, fmtexgdata) trim(cellid1), trim(cellid2), & - this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), & - this%hwva(iexg), & - (this%auxvar(iaux, iexg), iaux=1, this%naux) - else - write (iout, fmtexgdata2) trim(cellid1), trim(cellid2), & - this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), & - this%hwva(iexg), & - (this%auxvar(iaux, iexg), iaux=1, this%naux), & - trim(this%boundname(iexg)) - end if - end if + else + this%nodem1(iexg) = -1 + end if + ! + if (associated(this%model2)) then ! - ! -- Check to see if nodem1 is outside of active domain - if (associated(this%model1)) then - if (nodem1 <= 0) then - write (errmsg, *) & - trim(adjustl(this%model1%name))// & - ' Cell is outside active grid domain ('// & - trim(adjustl(cellid1))//').' - call store_error(errmsg) - end if - end if + ! -- Determine reduced node number + nodem2 = this%noder(this%model2, cellidm2(:, iexg), iout) + this%nodem2(iexg) = nodem2 ! - ! -- Check to see if nodem2 is outside of active domain - if (associated(this%model2)) then - if (nodem2 <= 0) then - write (errmsg, *) & - trim(adjustl(this%model2%name))// & - ' Cell is outside active grid domain ('// & - trim(adjustl(cellid2))//').' - call store_error(errmsg) - end if - end if + else + this%nodem2(iexg) = -1 + end if + ! + ! -- Read rest of input line + this%ihc(iexg) = ihc(iexg) + this%cl1(iexg) = cl1(iexg) + this%cl2(iexg) = cl2(iexg) + this%hwva(iexg) = hwva(iexg) + do iaux = 1, this%naux + this%auxvar(iaux, iexg) = auxvar(iaux, iexg) end do + if (this%inamedbound == 1) then + this%boundname(iexg) = boundname(iexg) + end if ! - ! -- Stop if errors - nerr = count_errors() - if (nerr > 0) then - call store_error('Errors encountered in exchange input file.') - call this%parser%StoreErrorUnit() + ! -- Write the data to listing file if requested + if (this%iprpak /= 0) then + cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout) + cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout) + if (this%inamedbound == 0) then + write (iout, fmtexgdata) trim(cellstr1), trim(cellstr2), & + this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), & + this%hwva(iexg), & + (this%auxvar(iaux, iexg), iaux=1, this%naux) + else + write (iout, fmtexgdata2) trim(cellstr1), trim(cellstr2), & + this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), & + this%hwva(iexg), & + (this%auxvar(iaux, iexg), iaux=1, this%naux), & + trim(this%boundname(iexg)) + end if end if ! - write (iout, '(1x,a)') 'END OF EXCHANGEDATA' - else - errmsg = 'Required exchangedata block not found.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() + ! -- Check to see if nodem1 is outside of active domain + if (associated(this%model1)) then + if (nodem1 <= 0) then + cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout) + write (errmsg, *) & + trim(adjustl(this%model1%name))// & + ' Cell is outside active grid domain ('// & + trim(adjustl(cellstr1))//').' + call store_error(errmsg) + end if + end if + ! + ! -- Check to see if nodem2 is outside of active domain + if (associated(this%model2)) then + if (nodem2 <= 0) then + cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout) + write (errmsg, *) & + trim(adjustl(this%model2%name))// & + ' Cell is outside active grid domain ('// & + trim(adjustl(cellstr2))//').' + call store_error(errmsg) + end if + end if + end do + ! + write (iout, '(1x,a)') 'END OF EXCHANGEDATA' + ! + ! -- Stop if errors + nerr = count_errors() + if (nerr > 0) then + call store_error('Errors encountered in exchange input file.') + call store_error_filename(this%filename) end if ! - ! -- return + ! -- Return return - end subroutine read_data + end subroutine source_data !> @brief Allocate scalars and initialize to defaults !< subroutine allocate_scalars(this) + ! -- modules use MemoryManagerModule, only: mem_allocate + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object - + ! allocate (this%filename) this%filename = '' - + ! call mem_allocate(this%nexg, 'NEXG', this%memoryPath) call mem_allocate(this%naux, 'NAUX', this%memoryPath) call mem_allocate(this%ianglex, 'IANGLEX', this%memoryPath) call mem_allocate(this%icdist, 'ICDIST', this%memoryPath) call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath) call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath) + call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath) + call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath) call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath) + call mem_allocate(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%memoryPath) call mem_allocate(this%auxname, LENAUXNAME, 0, & 'AUXNAME', this%memoryPath) call mem_allocate(this%auxname_cst, LENAUXNAME, 0, & 'AUXNAME_CST', this%memoryPath) - + ! this%nexg = 0 this%naux = 0 this%ianglex = 0 this%icdist = 0 this%ixt3d = 0 + this%iprpak = 0 + this%iprflow = 0 + this%ipakcb = 0 this%inamedbound = 0 - + ! this%dev_ifmod_on = .false. - + ! + ! -- Return + return end subroutine allocate_scalars !> @brief Allocate array data, using the number of !! connected nodes @param nexg !< subroutine allocate_arrays(this) + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object - + ! call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath) call mem_allocate(this%nodem2, this%nexg, 'NODEM2', this%memoryPath) call mem_allocate(this%ihc, this%nexg, 'IHC', this%memoryPath) @@ -368,7 +464,7 @@ subroutine allocate_arrays(this) ! NB: auxname array is allocated while parsing call mem_allocate(this%auxvar, this%naux, this%nexg, & 'AUXVAR', this%memoryPath) - + ! ! allocate boundname if (this%inamedbound == 1) then allocate (this%boundname(this%nexg)) @@ -376,28 +472,36 @@ subroutine allocate_arrays(this) allocate (this%boundname(1)) end if this%boundname(:) = '' - + ! + ! -- Return + return end subroutine allocate_arrays !> @brief Should interface model be used to handle these !! exchanges, to be overridden for inheriting types !< function use_interface_model(this) result(use_im) + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object + ! -- return logical(LGP) :: use_im !< flag whether interface model should be used !! for this exchange instead - + ! ! use im when one of the models is not local use_im = .not. (this%v_model1%is_local .and. this%v_model2%is_local) - + ! + ! -- Return + return end function use_interface_model !> @brief Clean up all scalars and arrays !< subroutine disconnex_da(this) + ! -- modules use MemoryManagerModule, only: mem_deallocate + ! -- dummy class(DisConnExchangeType) :: this !< instance of exchange object - + ! ! arrays call mem_deallocate(this%nodem1) call mem_deallocate(this%nodem2) @@ -406,9 +510,9 @@ subroutine disconnex_da(this) call mem_deallocate(this%cl2) call mem_deallocate(this%hwva) call mem_deallocate(this%auxvar) - + ! deallocate (this%boundname) - + ! ! scalars call mem_deallocate(this%nexg) call mem_deallocate(this%naux) @@ -418,13 +522,20 @@ subroutine disconnex_da(this) call mem_deallocate(this%icdist) call mem_deallocate(this%ixt3d) call mem_deallocate(this%iprpak) + call mem_deallocate(this%iprflow) + call mem_deallocate(this%ipakcb) call mem_deallocate(this%inamedbound) - + call mem_deallocate(this%dev_ifmod_on) + ! + ! -- Return + return end subroutine disconnex_da function CastAsDisConnExchangeClass(obj) result(res) implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return class(DisConnExchangeType), pointer :: res ! res => null() @@ -434,6 +545,8 @@ function CastAsDisConnExchangeClass(obj) result(res) class is (DisConnExchangeType) res => obj end select + ! + ! -- Return return end function CastAsDisConnExchangeClass @@ -448,6 +561,7 @@ subroutine AddDisConnExchangeToList(list, exchange) obj => exchange call list%Add(obj) ! + ! -- Return return end subroutine AddDisConnExchangeToList @@ -456,6 +570,7 @@ function GetDisConnExchangeFromList(list, idx) result(res) ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx + ! -- return class(DisConnExchangeType), pointer :: res ! -- local class(*), pointer :: obj @@ -463,6 +578,7 @@ function GetDisConnExchangeFromList(list, idx) result(res) obj => list%GetItem(idx) res => CastAsDisConnExchangeClass(obj) ! + ! -- Return return end function GetDisConnExchangeFromList diff --git a/src/Exchange/GhostNode.f90 b/src/Exchange/GhostNode.f90 index d6e124cf1f7..fa5267ba83d 100644 --- a/src/Exchange/GhostNode.f90 +++ b/src/Exchange/GhostNode.f90 @@ -32,7 +32,9 @@ module GhostNodeModule integer(I4B), dimension(:), pointer, contiguous :: idiagm => null() ! amat diagonal position of m integer(I4B), dimension(:, :), pointer, contiguous :: jposinrown => null() ! amat j position in row n integer(I4B), dimension(:, :), pointer, contiguous :: jposinrowm => null() ! amat j position in row m + contains + procedure :: gnc_df procedure :: gnc_ac procedure :: gnc_mc @@ -53,20 +55,14 @@ module GhostNodeModule contains + !> @brief Create new GNC exchange object + !< subroutine gnc_cr(gncobj, name_parent, inunit, iout) -! ****************************************************************************** -! gnc_cr -- Create new GNC exchange object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy type(GhostNodeType), pointer, intent(inout) :: gncobj character(len=*), intent(in) :: name_parent integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ ! ! -- Allocate the gnc exchange object allocate (gncobj) @@ -82,17 +78,13 @@ subroutine gnc_cr(gncobj, name_parent, inunit, iout) gncobj%inunit = inunit gncobj%iout = iout ! - ! -- return + ! -- Return return end subroutine gnc_cr + !> @brief Initialize a gnc object + !< subroutine gnc_df(this, m1, m2) -! ****************************************************************************** -! gnc_df -- Initialize a gnc object. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use NumericalModelModule, only: NumericalModelType use SimModule, only: store_error, store_error_unit @@ -101,8 +93,6 @@ subroutine gnc_df(this, m1, m2) class(GhostNodeType) :: this class(NumericalModelType), target :: m1 class(NumericalModelType), target, optional :: m2 - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Point or set attributes this%m1 => m1 @@ -139,18 +129,15 @@ subroutine gnc_df(this, m1, m2) end if end if ! - ! -- return + ! -- Return return end subroutine gnc_df + !> @brief Single or Two-Model GNC Add Connections + !! + !! For implicit GNC, expand the sparse solution matrix + !< subroutine gnc_ac(this, sparse) -! ****************************************************************************** -! gnc_ac -- Single or Two-Model GNC Add Connections -! Subroutine: (1) For implicit GNC, expand the sparse solution matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix ! -- dummy @@ -158,7 +145,6 @@ subroutine gnc_ac(this, sparse) type(sparsematrix), intent(inout) :: sparse ! -- local integer(I4B) :: ignc, jidx, noden, nodem, nodej -! ------------------------------------------------------------------------------ ! ! -- Expand the sparse matrix for ghost node connections. No need to add ! connection between n and m as they must be connected some other way @@ -179,23 +165,20 @@ subroutine gnc_ac(this, sparse) end do end if ! - ! -- return + ! -- Return return end subroutine gnc_ac + !> @brief Single or Two-Model GNC Map Connections + !! + !! Fill the following mapping arrays: + !! this%idiagn, this%idiagm (diagonal positions in solution amat) + !! this%idxglo (nm connection in solution amat) + !! this%idxsymglo (mn connection in solution amat) + !! this%jposinrown (position of j in row n of solution amat) + !! this%jposinrowm (position of j in row m of solution amat) + !< subroutine gnc_mc(this, matrix_sln) -! ****************************************************************************** -! gnc_mc -- Single or Two-Model GNC Map Connections -! Subroutine: (1) Fill the following mapping arrays: -! this%idiagn, this%idiagm (diagonal positions in solution amat) -! this%idxglo (nm connection in solution amat) -! this%idxsymglo (mn connection in solution amat) -! this%jposinrown (position of j in row n of solution amat) -! this%jposinrowm (position of j in row m of solution amat) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error, store_error_unit, count_errors use SimVariablesModule, only: errmsg @@ -208,7 +191,6 @@ subroutine gnc_mc(this, matrix_sln) character(len=*), parameter :: fmterr = & "('GHOST NODE ERROR. Cell ', i0, ' in model ', a, & &' is not connected to cell ', i0, ' in model ', a)" -! ------------------------------------------------------------------------------ ! ! -- Find the location of Cnm in the global solution and store it in ! this%idxglo @@ -271,18 +253,14 @@ subroutine gnc_mc(this, matrix_sln) end do end if ! - ! -- return + ! -- Return return end subroutine gnc_mc + !> @brief Store the n-m Picard conductance in cond prior to the Newton terms + !! terms being added + !< subroutine gnc_fmsav(this, kiter, matrix) -! ****************************************************************************** -! gnc_fmsav -- Store the n-m Picard conductance in cond prior to the Newton -! terms being added. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO ! -- dummy @@ -292,7 +270,6 @@ subroutine gnc_fmsav(this, kiter, matrix) ! -- local integer(I4B) :: ignc, ipos real(DP) :: cond -! ------------------------------------------------------------------------------ ! ! -- An ipos value of zero indicates that noden is not connected to ! nodem, and therefore the conductance is zero. @@ -306,19 +283,16 @@ subroutine gnc_fmsav(this, kiter, matrix) this%cond(ignc) = cond end do gncloop ! - ! -- return + ! -- Return return end subroutine gnc_fmsav + !> @brief Fill matrix terms + !! + !! Add the GNC terms to the solution matrix or model rhs depending on whether + !! whether GNC is implicit or explicit + !< subroutine gnc_fc(this, kiter, matrix) -! ****************************************************************************** -! gnc_fc -- Fill matrix terms -! Subroutine: (1) Add the GNC terms to the solution matrix or model rhs depending -! on whether GNC is implicit or explicit -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO ! -- dummy @@ -328,7 +302,6 @@ subroutine gnc_fc(this, kiter, matrix) ! -- local integer(I4B) :: ignc, j, noden, nodem, ipos, jidx, iposjn, iposjm real(DP) :: cond, alpha, aterm, rterm -! ------------------------------------------------------------------------------ ! ! -- If this is a single model gnc (not an exchange across models), then ! pull conductances out of the system matrix and store them in this%cond @@ -364,30 +337,26 @@ subroutine gnc_fc(this, kiter, matrix) end do jloop end do gncloop ! - ! -- return + ! -- Return return end subroutine gnc_fc + !> @brief Fill GNC Newton terms + !! + !! Required arguments: + !! kiter : outer iteration number + !! matrix_sln: the solution matrix + !! condsat is of size(njas) if single model, otherwise nexg + !! + !! Optional arguments: + !! ihc_opt : an optional vector of size(nexg), which contains a horizontal + !! connection code (0=vertical, 1=horizontal, 2=vertically staggered) + !! ivarcv_opt : variable vertical conductance flag (default is 0) + !! ictm1_opt : icelltype for model 1 integer vector (default is 1) + !! ictm2_opt : icelltype for model 2 integer vector (default is 1) + !< subroutine gnc_fn(this, kiter, matrix_sln, condsat, ihc_opt, & ivarcv_opt, ictm1_opt, ictm2_opt) -! ****************************************************************************** -! gnc_fn -- Fill GNC Newton terms -! -! Required arguments: -! kiter : outer iteration number -! matrix_sln: the solution matrix -! condsat is of size(njas) if single model, otherwise nexg -! -! Optional arguments: -! ihc_opt : an optional vector of size(nexg), which contains a horizontal -! connection code (0=vertical, 1=horizontal, 2=vertically staggered) -! ivarcv_opt : variable vertical conductance flag (default is 0) -! ictm1_opt : icelltype for model 1 integer vector (default is 1) -! ictm2_opt : icelltype for model 2 integer vector (default is 1) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO use SmoothingModule, only: sQuadraticSaturationDerivative @@ -406,7 +375,6 @@ subroutine gnc_fn(this, kiter, matrix_sln, condsat, ihc_opt, & integer(I4B) :: iups, ictup real(DP) :: csat, alpha, consterm, term, derv real(DP) :: xup, topup, botup -! ------------------------------------------------------------------------------ ! ! -- Set the ivarcv to indicate whether or not the vertical conductance ! is a function of water table @@ -491,18 +459,15 @@ subroutine gnc_fn(this, kiter, matrix_sln, condsat, ihc_opt, & end do jloop end do gncloop ! - ! -- return + ! -- Return return end subroutine gnc_fn + !> @brief Single Model GNC Output + !! + !! Output GNC deltaQgnc values + !< subroutine gnc_ot(this, ibudfl) -! ****************************************************************************** -! gnc_ot -- Single Model GNC Output -! Subroutine: (1) Output GNC deltaQgnc values -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GhostNodeType) :: this integer(I4B), intent(in) :: ibudfl @@ -512,7 +477,6 @@ subroutine gnc_ot(this, ibudfl) character(len=LINELENGTH) :: nodenstr, nodemstr ! -- format character(len=*), parameter :: fmtgnc = "(i10, 2a10, 2(1pg15.6))" -! ------------------------------------------------------------------------------ ! ! -- Process each gnc and output deltaQgnc if (ibudfl /= 0 .and. this%iprflow /= 0) then @@ -529,25 +493,19 @@ subroutine gnc_ot(this, ibudfl) end do end if ! - ! -- return + ! -- Return return end subroutine gnc_ot + !> @brief Add GNC to flowja + !< subroutine gnc_cq(this, flowja) -! ****************************************************************************** -! gnc_cq -- Add GNC to flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GhostNodeType) :: this real(DP), dimension(:), intent(inout) :: flowja ! -- local integer(I4B) :: ignc, n1, n2, ipos, isympos real(DP) :: deltaQgnc - ! -- format -! ------------------------------------------------------------------------------ ! ! -- go through each gnc and add deltagnc to flowja do ignc = 1, this%nexg @@ -567,21 +525,18 @@ subroutine gnc_cq(this, flowja) ! end do ! - ! -- return + ! -- Return return end subroutine gnc_cq + !> @brief Single Model deltaQgnc (ghost node correction flux) + !! + !! Calculate the deltaQgnc value for any GNC in the GNC list + !< function deltaQgnc(this, ignc) -! ****************************************************************************** -! deltaQgnc -- Single Model deltaQgnc (ghost node correction flux) -! Subroutine: (1) Calculate the deltaQgnc value for any GNC in the GNC list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO - ! -- return + ! -- Return real(DP) :: deltaQgnc ! -- dummy class(GhostNodeType) :: this @@ -589,7 +544,6 @@ function deltaQgnc(this, ignc) ! -- local integer(I4B) :: noden, nodem, nodej, jidx real(DP) :: sigalj, alpha, hd, aterm, cond -! ------------------------------------------------------------------------------ ! ! -- initialize values deltaQgnc = DZERO @@ -613,22 +567,17 @@ function deltaQgnc(this, ignc) deltaQgnc = aterm * cond end if ! - ! -- return + ! -- Return return end function deltaQgnc + !> @brief Allocate gnc scalar variables + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate gnc scalar variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GhostNodeType) :: this -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -646,22 +595,17 @@ subroutine allocate_scalars(this) this%nexg = 0 this%numjs = 0 ! + ! -- Return return end subroutine allocate_scalars + !> @brief Allocate gnc scalar variables + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- allocate gnc scalar variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GhostNodeType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate memory for arrays call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath) @@ -689,18 +633,13 @@ subroutine allocate_arrays(this) return end subroutine allocate_arrays + !> @brief Deallocate memory + !< subroutine gnc_da(this) -! ****************************************************************************** -! gnc_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GhostNodeType) :: this -! ------------------------------------------------------------------------------ ! call mem_deallocate(this%smgnc) call mem_deallocate(this%implicit) @@ -730,14 +669,11 @@ subroutine gnc_da(this) return end subroutine gnc_da + !> @brief Read a gnc options block + !! + !! Read options from input file + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -- read a gnc options block -! Subroutine: (1) read options from input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error use SimVariablesModule, only: errmsg @@ -747,7 +683,6 @@ subroutine read_options(this) character(len=LINELENGTH) :: keyword integer(I4B) :: ierr logical :: isfound, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, & @@ -789,18 +724,15 @@ subroutine read_options(this) ! -- Set the iasym flag if the correction is implicit if (this%implicit) this%iasym = 1 ! - ! -- return + ! -- Return return end subroutine read_options + !> @brief Single Model GNC Read Dimensions + !! + !! Read dimensions (size of gnc list) from input file + !< subroutine read_dimensions(this) -! ****************************************************************************** -! read_dimensions -- Single Model GNC Read Dimensions -! Subroutine: (1) read dimensions (size of gnc list) from input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error use SimVariablesModule, only: errmsg @@ -810,7 +742,6 @@ subroutine read_dimensions(this) character(len=LINELENGTH) :: keyword integer(I4B) :: ierr logical :: isfound, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -842,18 +773,15 @@ subroutine read_dimensions(this) call store_error('Required DIMENSIONS block not found.', terminate=.TRUE.) end if ! - ! -- return + ! -- Return return end subroutine read_dimensions + !> @brief Read a GNCDATA block + !! + !! Read list of GNCs from input file + !< subroutine read_data(this) -! ****************************************************************************** -! read_data -- Read a GNCDATA block -! Subroutine: (1) read list of GNCs from input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error, count_errors use SimVariablesModule, only: errmsg @@ -866,8 +794,6 @@ subroutine read_data(this) integer(I4B) :: ignc, jidx, nodeun, nodeum, nerr integer(I4B), dimension(:), allocatable :: nodesuj logical :: isfound, endOfBlock - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Construct the fmtgnc format write (fmtgnc, '("(2i10,",i0,"i10,",i0, "(1pg15.6))")') this%numjs, & @@ -981,17 +907,13 @@ subroutine read_data(this) ! -- deallocate nodesuj array deallocate (nodesuj) ! - ! -- return + ! -- Return return end subroutine read_data + !> @brief Convert the user-based node number into a reduced number + !< subroutine nodeu_to_noder(this, nodeu, noder, model) -! ****************************************************************************** -! nodeu_to_noder -- Convert the user-based node number into a reduced number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use NumericalModelModule, only: NumericalModelType use SimModule, only: store_error @@ -1001,8 +923,6 @@ subroutine nodeu_to_noder(this, nodeu, noder, model) integer(I4B), intent(in) :: nodeu integer(I4B), intent(inout) :: noder class(NumericalModelType), intent(in) :: model - ! -- local -! ------------------------------------------------------------------------------ ! if (nodeu < 1 .or. nodeu > model%dis%nodesuser) then write (errmsg, *) & diff --git a/src/Exchange/GwfExchangeMover.f90 b/src/Exchange/GwfExchangeMover.f90 new file mode 100644 index 00000000000..6c132343551 --- /dev/null +++ b/src/Exchange/GwfExchangeMover.f90 @@ -0,0 +1,286 @@ +module GwfExgMoverModule + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: LENMODELNAME, LENPACKAGENAME, DZERO, DNODATA + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use MemoryHelperModule, only: split_mem_path + use VirtualModelModule + use BaseDisModule + use GwfMvrModule + use PackageMoverModule, only: PackageMoverType, set_packagemover_pointer + implicit none + private + + public :: exg_mvr_cr + + !> @brief Extends model mover for exchanges to also handle the + !< parallel case where the models are not on the same process. + type, public, extends(GwfMvrType) :: GwfExgMoverType + class(VirtualModelType), pointer :: model1 => null() !< virtual model 1 + class(VirtualModelType), pointer :: model2 => null() !< virtual model 2 + logical(LGP), dimension(:), pointer, contiguous :: prov_is_m1 => null() !< .true. when the providing package is part of model 1 + real(DP), dimension(:), pointer, contiguous :: qpactual_m1 => null() !< stores qpactual for synchronization when provider is in model 1 + real(DP), dimension(:), pointer, contiguous :: qpactual_m2 => null() !< stores qpactual for synchronization when provider is in model 2 + real(DP), dimension(:), pointer, contiguous :: qavailable_m1 => null() !< stores qavailable for synchronization when provider is in model 1 + real(DP), dimension(:), pointer, contiguous :: qavailable_m2 => null() !< stores qavailable for synchronization when provider is in model 2 + integer(I4B), dimension(:), pointer, contiguous :: id_mapped_m1 => null() !< stores the mapped feature ids for synchronization when provider is in model 1 + integer(I4B), dimension(:), pointer, contiguous :: id_mapped_m2 => null() !< stores the mapped feature ids for synchronization when provider is in model 2 + contains + procedure :: mvr_da => xmvr_da + procedure :: xmvr_cf + procedure :: mvr_fc => xmvr_fc + procedure :: mvr_bd => xmvr_bd + procedure :: check_packages => xmvr_check_packages + procedure :: assign_packagemovers => xmvr_assign_packagemovers + procedure :: initialize_movers => xmvr_initialize_movers + procedure :: allocate_arrays => xmvr_allocate_arrays + end type + +contains + + subroutine exg_mvr_cr(exg_mvr, name_parent, inunit, iout, dis) + class(GwfExgMoverType), pointer :: exg_mvr + character(len=*), intent(in) :: name_parent + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + class(DisBaseType), pointer :: dis + + allocate (exg_mvr) + + ! Init through base + call exg_mvr%mvr_init(name_parent, inunit, iout, dis, 1) + + end subroutine exg_mvr_cr + + subroutine xmvr_check_packages(this) + use ConstantsModule, only: LINELENGTH + use MemoryManagerModule, only: mem_setptr + use SimModule, only: store_error, count_errors, store_error_unit + class(GwfExgMoverType), intent(inout) :: this + ! local + character(len=LENMODELNAME) :: mname + character(len=LENPACKAGENAME) :: pname + class(VirtualModelType), pointer :: vm + character(len=LINELENGTH) :: errmsg + integer(I4B) :: i + integer(I4B), pointer :: imover_ptr + + do i = 1, size(this%pckMemPaths) + ! check only when local + call split_mem_path(this%pckMemPaths(i), mname, pname) + vm => get_virtual_model(mname) + if (vm%is_local) then + ! check if PackageMover is active in package: + imover_ptr => null() + call mem_setptr(imover_ptr, 'IMOVER', trim(this%pckMemPaths(i))) + if (imover_ptr == 0) then + write (errmsg, '(a, a, a)') & + 'ERROR. MODEL AND PACKAGE "', & + trim(this%pckMemPaths(i)), & + '" DOES NOT HAVE MOVER SPECIFIED IN OPTIONS BLOCK.' + call store_error(errmsg) + end if + end if + end do + + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + + end subroutine xmvr_check_packages + + !> @brief Overrides GWF MVR routine to skip assigning + !< pointers when the package is not local + subroutine xmvr_assign_packagemovers(this) + class(GwfExgMoverType), intent(inout) :: this !< this exchange mover + ! local + integer(I4B) :: i + character(len=LENMODELNAME) :: mname + character(len=LENPACKAGENAME) :: pname + class(VirtualModelType), pointer :: vm + + do i = 1, size(this%pckMemPaths) + if (this%pakmovers(i)%memoryPath == '') then + ! is it local? + call split_mem_path(this%pckMemPaths(i), mname, pname) + vm => get_virtual_model(mname) + if (vm%is_local) then + ! yes, we need the pointers + call set_packagemover_pointer(this%pakmovers(i), & + trim(this%pckMemPaths(i))) + end if + end if + end do + end subroutine xmvr_assign_packagemovers + + !> @brief Overrides mover initialization in GWF MVR to + !! deactivate remote parts and build up sync. arrays + !< for mapped feature ids + subroutine xmvr_initialize_movers(this, nr_active_movers) + class(GwfExgMoverType) :: this + integer(I4B) :: nr_active_movers + ! local + integer(I4B) :: i + character(len=LENMODELNAME) :: mname + character(len=LENPACKAGENAME) :: pname + class(VirtualModelType), pointer :: vm + class(PackageMoverType), allocatable :: pkg_mvr + + call this%GwfMvrType%initialize_movers(nr_active_movers) + + this%prov_is_m1 = .false. + + ! deactivate remote parts + do i = 1, nr_active_movers + call split_mem_path(this%mvr(i)%mem_path_src, mname, pname) + vm => get_virtual_model(mname) + this%mvr(i)%is_provider_active = vm%is_local + this%prov_is_m1(i) = associated(vm, this%model1) + call split_mem_path(this%mvr(i)%mem_path_tgt, mname, pname) + vm => get_virtual_model(mname) + this%mvr(i)%is_receiver_active = vm%is_local + end do + + ! loop over mvr's, if provider is active, + ! store mapped feature index in array for sync + allocate (pkg_mvr) + + do i = 1, nr_active_movers + if (this%mvr(i)%is_provider_active) then + ! store mapped feature id in array (for synchronization when parallel) + call set_packagemover_pointer(pkg_mvr, this%mvr(i)%mem_path_src) + if (this%prov_is_m1(i)) then + this%id_mapped_m1(i) = pkg_mvr%iprmap(this%mvr(i)%iRchNrSrc) + this%id_mapped_m2(i) = -1 + else + this%id_mapped_m1(i) = -1 + this%id_mapped_m2(i) = pkg_mvr%iprmap(this%mvr(i)%iRchNrSrc) + end if + end if + end do + + end subroutine xmvr_initialize_movers + + !> @brief Calculates qpactual and stores it for synchronization + !< + subroutine xmvr_cf(this) + class(GwfExgMoverType) :: this + ! local + integer(I4B) :: i + + do i = 1, this%nmvr + if (this%mvr(i)%is_provider_active) then + + call this%mvr(i)%update_provider() + + ! copy calculated rate to arrays for synchronization: + if (this%prov_is_m1(i)) then + this%qpactual_m1(i) = this%mvr(i)%qpactual + this%qavailable_m1(i) = this%mvr(i)%qavailable + this%qpactual_m2(i) = DNODATA + this%qavailable_m2(i) = DNODATA + else + this%qpactual_m1(i) = DNODATA + this%qavailable_m1(i) = DNODATA + this%qpactual_m2(i) = this%mvr(i)%qpactual + this%qavailable_m2(i) = this%mvr(i)%qavailable + end if + end if + end do + + end subroutine xmvr_cf + + !> @brief Assign synced qpactual to mover and update receiver + !< + subroutine xmvr_fc(this) + class(GwfExgMoverType) :: this + ! local + integer(I4B) :: i + + do i = 1, this%nmvr + ! TODO_MJR: this should only be around the update call, + ! such that every mover has a valid qpactual ??!! + if (this%mvr(i)%is_receiver_active) then + + ! copy from synchronization arrays back into movers: + if (this%prov_is_m1(i)) then + this%mvr(i)%qpactual = this%qpactual_m1(i) + this%mvr(i)%qavailable = this%qavailable_m1(i) + else + this%mvr(i)%qpactual = this%qpactual_m2(i) + this%mvr(i)%qavailable = this%qavailable_m2(i) + end if + + call this%mvr(i)%update_receiver() + end if + end do + + end subroutine xmvr_fc + + !> @brief Overrides budget routine to first assign the + !< mapped features ids from the synchronization arrays + subroutine xmvr_bd(this) + class(GwfExgMoverType) :: this + ! local + integer(I4B) :: i + + ! copy from synchronization arrays back into movers: + do i = 1, this%nmvr + if (this%prov_is_m1(i)) then + this%mvr(i)%iRchNrSrcMapped = this%id_mapped_m1(i) + else + this%mvr(i)%iRchNrSrcMapped = this%id_mapped_m2(i) + end if + end do + + call this%fill_budobj() + + end subroutine xmvr_bd + + subroutine xmvr_allocate_arrays(this) + class(GwfExgMoverType) :: this + ! local + integer(I4B) :: i + + call this%GwfMvrType%allocate_arrays() + + allocate (this%prov_is_m1(this%maxmvr)) + call mem_allocate(this%qpactual_m1, this%maxmvr, 'QPACTUAL_M1', & + this%memoryPath) + call mem_allocate(this%qpactual_m2, this%maxmvr, 'QPACTUAL_M2', & + this%memoryPath) + call mem_allocate(this%qavailable_m1, this%maxmvr, 'QAVAILABLE_M1', & + this%memoryPath) + call mem_allocate(this%qavailable_m2, this%maxmvr, 'QAVAILABLE_M2', & + this%memoryPath) + call mem_allocate(this%id_mapped_m1, this%maxmvr, 'ID_MAPPED_M1', & + this%memoryPath) + call mem_allocate(this%id_mapped_m2, this%maxmvr, 'ID_MAPPED_M2', & + this%memoryPath) + + do i = 1, this%maxmvr + this%id_mapped_m1(i) = 0 + this%id_mapped_m2(i) = 0 + this%qpactual_m1(i) = DNODATA + this%qpactual_m2(i) = DNODATA + this%qavailable_m1(i) = DNODATA + this%qavailable_m2(i) = DNODATA + end do + + end subroutine xmvr_allocate_arrays + + subroutine xmvr_da(this) + class(GwfExgMoverType) :: this + + call this%GwfMvrType%mvr_da() + + deallocate (this%prov_is_m1) + call mem_deallocate(this%qpactual_m1) + call mem_deallocate(this%qpactual_m2) + call mem_deallocate(this%qavailable_m1) + call mem_deallocate(this%qavailable_m2) + call mem_deallocate(this%id_mapped_m1) + call mem_deallocate(this%id_mapped_m2) + + end subroutine xmvr_da + +end module GwfExgMoverModule diff --git a/src/Exchange/GwfGwfExchange.f90 b/src/Exchange/GwfGwfExchange.f90 index ad89b404457..c501c52501f 100644 --- a/src/Exchange/GwfGwfExchange.f90 +++ b/src/Exchange/GwfGwfExchange.f90 @@ -11,9 +11,11 @@ module GwfGwfExchangeModule use KindModule, only: DP, I4B, LGP use SimVariablesModule, only: errmsg - use SimModule, only: store_error + use SimModule, only: count_errors, store_error, store_error_filename, & + store_error_unit use BaseModelModule, only: BaseModelType, GetBaseModelFromList use BaseExchangeModule, only: BaseExchangeType, AddBaseExchangeToList + use BaseDisModule, only: DisBaseType use ConstantsModule, only: LENBOUNDNAME, NAMEDBOUNDFLAG, LINELENGTH, & TABCENTER, TABLEFT, LENAUXNAME, DNODATA use ListModule, only: ListType @@ -22,12 +24,10 @@ module GwfGwfExchangeModule use GwfModule, only: GwfModelType use VirtualModelModule, only: VirtualModelType use GhostNodeModule, only: GhostNodeType - use GwfMvrModule, only: GwfMvrType + use GwfExgMoverModule, only: GwfExgMoverType use ObserveModule, only: ObserveType use ObsModule, only: ObsType - use SimModule, only: count_errors, store_error, store_error_unit use SimVariablesModule, only: errmsg, model_loc_idx - use BlockParserModule, only: BlockParserType use TableModule, only: TableType, table_cr use MatrixBaseModule @@ -43,15 +43,12 @@ module GwfGwfExchangeModule !! !! This derived type contains information and methods for !! connecting two GWF models. - !! !< type, extends(DisConnExchangeType) :: GwfExchangeType - type(GwfModelType), pointer :: gwfmodel1 => null() !< pointer to GWF Model 1 - type(GwfModelType), pointer :: gwfmodel2 => null() !< pointer to GWF Model 2 + class(GwfModelType), pointer :: gwfmodel1 => null() !< pointer to GWF Model 1 + class(GwfModelType), pointer :: gwfmodel2 => null() !< pointer to GWF Model 2 ! ! -- GWF specific option block: - integer(I4B), pointer :: iprflow => null() !< print flag for cell by cell flows - integer(I4B), pointer :: ipakcb => null() !< save flag for cell by cell flows integer(I4B), pointer :: inewton => null() !< newton flag (1 newton is on) integer(I4B), pointer :: icellavg => null() !< cell averaging integer(I4B), pointer :: ivarcv => null() !< variable cv @@ -59,7 +56,7 @@ module GwfGwfExchangeModule integer(I4B), pointer :: ingnc => null() !< unit number for gnc (0 if off) type(GhostNodeType), pointer :: gnc => null() !< gnc object integer(I4B), pointer :: inmvr => null() !< unit number for mover (0 if off) - type(GwfMvrType), pointer :: mvr => null() !< water mover object + class(GwfExgMoverType), pointer :: mvr => null() !< water mover object integer(I4B), pointer :: inobs => null() !< unit number for GWF-GWF observations type(ObsType), pointer :: obs => null() !< observation object ! @@ -96,14 +93,14 @@ module GwfGwfExchangeModule procedure :: use_interface_model procedure :: allocate_scalars procedure :: allocate_arrays - procedure :: read_options - procedure :: parse_option + procedure :: source_options procedure :: read_gnc procedure :: read_mvr procedure, private :: calc_cond_sat procedure, private :: condcalc procedure, private :: rewet procedure, private :: qcalc + procedure, private :: gwf_gwf_chd_bd procedure :: gwf_gwf_bdsav procedure, private :: gwf_gwf_bdsav_model procedure, private :: gwf_gwf_df_obs @@ -119,10 +116,10 @@ module GwfGwfExchangeModule !> @ brief Create GWF GWF exchange !! - !< Create a new GWF to GWF exchange object. - subroutine gwfexchange_create(filename, name, id, m1_id, m2_id) + !! Create a new GWF to GWF exchange object. + !< + subroutine gwfexchange_create(filename, name, id, m1_id, m2_id, input_mempath) ! -- modules - use ConstantsModule, only: LINELENGTH use BaseModelModule, only: BaseModelType use VirtualModelModule, only: get_virtual_model use ListsModule, only: baseexchangelist @@ -134,6 +131,7 @@ subroutine gwfexchange_create(filename, name, id, m1_id, m2_id) integer(I4B), intent(in) :: id !< id for the exchange integer(I4B), intent(in) :: m1_id !< id for model 1 integer(I4B), intent(in) :: m2_id !< id for model 2 + character(len=*), intent(in) :: input_mempath ! -- local type(GwfExchangeType), pointer :: exchange class(BaseModelType), pointer :: mb @@ -149,6 +147,7 @@ subroutine gwfexchange_create(filename, name, id, m1_id, m2_id) exchange%id = id exchange%name = name exchange%memoryPath = create_mem_path(exchange%name) + exchange%input_mempath = input_mempath ! ! -- allocate scalars and set defaults call exchange%allocate_scalars() @@ -199,14 +198,13 @@ subroutine gwfexchange_create(filename, name, id, m1_id, m2_id) ! -- Create the obs package call obs_cr(exchange%obs, exchange%inobs) ! - ! -- return + ! -- Return return end subroutine gwfexchange_create !> @ brief Define GWF GWF exchange !! !! Define GWF to GWF exchange object. - !! !< subroutine gwf_gwf_df(this) ! -- modules @@ -216,38 +214,31 @@ subroutine gwf_gwf_df(this) ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType ! -- local - integer(I4B) :: inunit ! - ! -- open the file - inunit = getunit() + ! -- log the exchange write (iout, '(/a,a)') ' Creating exchange: ', this%name - call openfile(inunit, iout, this%filename, 'GWF-GWF') - ! - call this%parser%Initialize(inunit, iout) ! ! -- Ensure models are in same solution - if (associated(this%gwfmodel1) .and. associated(this%gwfmodel2)) then - if (this%gwfmodel1%idsoln /= this%gwfmodel2%idsoln) then - call store_error('Two models are connected in a GWF '// & - 'exchange but they are in different solutions. '// & - 'GWF models must be in same solution: '// & - trim(this%gwfmodel1%name)//' '// & - trim(this%gwfmodel2%name)) - call this%parser%StoreErrorUnit() - end if + if (this%v_model1%idsoln%get() /= this%v_model2%idsoln%get()) then + call store_error('Two models are connected in a GWF '// & + 'exchange but they are in different solutions. '// & + 'GWF models must be in same solution: '// & + trim(this%v_model1%name)//' '// & + trim(this%v_model2%name)) + call store_error_filename(this%filename) end if ! - ! -- read options - call this%read_options(iout) + ! -- source options + call this%source_options(iout) ! - ! -- read dimensions - call this%read_dimensions(iout) + ! -- source dimensions + call this%source_dimensions(iout) ! ! -- allocate arrays call this%allocate_arrays() ! - ! -- read exchange data - call this%read_data(iout) + ! -- source exchange data + call this%source_data(iout) ! ! -- call each model and increase the edge count if (associated(this%gwfmodel1)) then @@ -268,9 +259,6 @@ subroutine gwf_gwf_df(this) call this%read_mvr(iout) end if ! - ! -- close the file - close (inunit) - ! ! -- Store obs call this%gwf_gwf_df_obs() if (associated(this%gwfmodel1)) then @@ -280,19 +268,20 @@ subroutine gwf_gwf_df(this) ! -- validate call this%validate_exchange() ! - ! -- return + ! -- Return return end subroutine gwf_gwf_df !> @brief validate exchange data after reading !< subroutine validate_exchange(this) + ! -- modules class(GwfExchangeType) :: this !< GwfExchangeType - ! local + ! -- local logical(LGP) :: has_k22, has_spdis, has_vsc - + ! ! Periodic boundary condition in exchange don't allow XT3D (=interface model) - if (associated(this%model1, this%model2)) then + if (this%v_model1 == this%v_model2) then if (this%ixt3d > 0) then write (errmsg, '(3a)') 'GWF-GWF exchange ', trim(this%name), & ' is a periodic boundary condition which cannot'// & @@ -300,7 +289,7 @@ subroutine validate_exchange(this) call store_error(errmsg, terminate=.TRUE.) end if end if - + ! ! XT3D needs angle information if (this%ixt3d > 0 .and. this%ianglex == 0) then write (errmsg, '(3a)') 'GWF-GWF exchange ', trim(this%name), & @@ -308,7 +297,7 @@ subroutine validate_exchange(this) ' auxiliary variable because XT3D is enabled' call store_error(errmsg, terminate=.TRUE.) end if - + ! ! determine if specific functionality is demanded, ! in model 1 or model 2 (in parallel, only one of ! the models is checked, but the exchange is duplicated) @@ -325,7 +314,7 @@ subroutine validate_exchange(this) has_spdis = has_spdis .or. (this%gwfmodel2%npf%icalcspdis /= 0) has_vsc = has_vsc .or. (this%gwfmodel2%npf%invsc /= 0) end if - + ! ! If horizontal anisotropy is in either model1 or model2, ! ANGLDEGX must be provided as an auxiliary variable for this ! GWF-GWF exchange (this%ianglex > 0). @@ -338,7 +327,7 @@ subroutine validate_exchange(this) call store_error(errmsg, terminate=.TRUE.) end if end if - + ! ! If specific discharge is needed for model1 or model2, ! ANGLDEGX must be provided as an auxiliary variable for this ! GWF-GWF exchange (this%ianglex > 0). @@ -360,7 +349,7 @@ subroutine validate_exchange(this) call store_error(errmsg, terminate=.TRUE.) end if end if - + ! ! If viscosity is on in either model, then terminate with an ! error as viscosity package doesn't work yet with exchanges. if (has_vsc) then @@ -369,13 +358,14 @@ subroutine validate_exchange(this) ' in both of the connected models.' call store_error(errmsg, terminate=.TRUE.) end if - + ! + ! -- Return + return end subroutine validate_exchange !> @ brief Add connections !! - !! override parent exg_ac so that gnc can add connections here. - !! + !! Override parent exg_ac so that gnc can add connections here. !< subroutine gwf_gwf_ac(this, sparse) ! -- modules @@ -406,7 +396,6 @@ end subroutine gwf_gwf_ac !> @ brief Map connections !! !! Map the connections in the global matrix - !! !< subroutine gwf_gwf_mc(this, matrix_sln) ! -- modules @@ -437,10 +426,8 @@ end subroutine gwf_gwf_mc !> @ brief Allocate and read !! !! Allocated and read and calculate saturated conductance - !! !< subroutine gwf_gwf_ar(this) - ! -- modules ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType ! @@ -460,7 +447,6 @@ end subroutine gwf_gwf_ar !> @ brief Read and prepare !! !! Read new data for mover and obs - !! !< subroutine gwf_gwf_rp(this) ! -- modules @@ -484,13 +470,10 @@ end subroutine gwf_gwf_rp !> @ brief Advance !! !! Advance mover and obs - !! !< subroutine gwf_gwf_ad(this) - ! -- modules ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType - ! -- local ! ! -- Advance mover if (this%inmvr > 0) call this%mvr%mvr_ad() @@ -505,7 +488,6 @@ end subroutine gwf_gwf_ad !> @ brief Calculate coefficients !! !! Rewet as necessary - !! !< subroutine gwf_gwf_cf(this, kiter) ! -- dummy @@ -513,6 +495,9 @@ subroutine gwf_gwf_cf(this, kiter) integer(I4B), intent(in) :: kiter ! -- local ! + ! -- Call mvr fc routine + if (this%inmvr > 0) call this%mvr%xmvr_cf() + ! ! -- Rewet cells across models using the wetdry parameters in each model's ! npf package, and the head in the connected model. call this%rewet(kiter) @@ -524,7 +509,6 @@ end subroutine gwf_gwf_cf !> @ brief Fill coefficients !! !! Calculate conductance and fill coefficient matrix - !! !< subroutine gwf_gwf_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) ! -- modules @@ -596,7 +580,6 @@ end subroutine gwf_gwf_fc !> @ brief Fill Newton !! !! Fill amatsln with Newton terms - !! !< subroutine gwf_gwf_fn(this, kiter, matrix_sln) ! -- modules @@ -707,16 +690,13 @@ end subroutine gwf_gwf_fn !! !! Calculate flow between two cells and store in simvals, also set !! information needed for specific discharge calculation - !! !< subroutine gwf_gwf_cq(this, icnvg, isuppress_output, isolnid) - ! -- modules ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType integer(I4B), intent(inout) :: icnvg integer(I4B), intent(in) :: isuppress_output integer(I4B), intent(in) :: isolnid - ! -- local ! ! -- calculate flow and store in simvals call this%gwf_gwf_calc_simvals() @@ -727,21 +707,24 @@ subroutine gwf_gwf_cq(this, icnvg, isuppress_output, isolnid) ! -- add exchange flows to model's flowja diagonal call this%gwf_gwf_add_to_flowja() ! - ! -- return + ! -- Return return end subroutine gwf_gwf_cq - !> @brief Calculate flow rates for the exchanges and - !< store them in a member array + !> @brief Calculate flow rates for the exchanges and store them in a member + !! array + !< subroutine gwf_gwf_calc_simvals(this) + ! -- modules use ConstantsModule, only: DZERO + ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType - ! local + ! -- local integer(I4B) :: i integer(I4B) :: n1, n2 integer(I4B) :: ibdn1, ibdn2 real(DP) :: rrate - + ! do i = 1, this%nexg rrate = DZERO n1 = this%nodem1(i) @@ -756,48 +739,58 @@ subroutine gwf_gwf_calc_simvals(this) end if this%simvals(i) = rrate end do - + ! + ! -- Return return end subroutine gwf_gwf_calc_simvals - !> @brief Add exchange flow to each model flowja diagonal - !< position so that residual is calculated correctly. + !> @brief Add exchange flow to each model flowja diagonal position so that + !! residual is calculated correctly. + !< subroutine gwf_gwf_add_to_flowja(this) + ! -- modules class(GwfExchangeType) :: this !< GwfExchangeType - ! local + ! -- local integer(I4B) :: i integer(I4B) :: n integer(I4B) :: idiag real(DP) :: flow - + ! do i = 1, this%nexg - + ! if (associated(this%gwfmodel1)) then - flow = this%simvals(i) n = this%nodem1(i) - idiag = this%gwfmodel1%ia(n) - this%gwfmodel1%flowja(idiag) = this%gwfmodel1%flowja(idiag) + flow + if (this%gwfmodel1%ibound(n) > 0) then + flow = this%simvals(i) + idiag = this%gwfmodel1%ia(n) + this%gwfmodel1%flowja(idiag) = this%gwfmodel1%flowja(idiag) + flow + end if end if - + ! if (associated(this%gwfmodel2)) then - flow = -this%simvals(i) n = this%nodem2(i) - idiag = this%gwfmodel2%ia(n) - this%gwfmodel2%flowja(idiag) = this%gwfmodel2%flowja(idiag) + flow + if (this%gwfmodel2%ibound(n) > 0) then + flow = -this%simvals(i) + idiag = this%gwfmodel2%ia(n) + this%gwfmodel2%flowja(idiag) = this%gwfmodel2%flowja(idiag) + flow + end if end if - + ! end do - + ! + ! -- Return return end subroutine gwf_gwf_add_to_flowja !> @brief Set flow rates to the edges in the models !< subroutine gwf_gwf_set_flow_to_npf(this) + ! -- modules use ConstantsModule, only: DZERO, DPIO180 use GwfNpfModule, only: thksatnm + ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType - ! local + ! -- local integer(I4B) :: iusg integer(I4B) :: i integer(I4B) :: n1, n2 @@ -816,7 +809,7 @@ subroutine gwf_gwf_set_flow_to_npf(this) real(DP) :: area real(DP) :: thksat real(DP) :: angle - + ! ! -- Return if there neither model needs to calculate specific discharge if (this%gwfmodel1%npf%icalcspdis == 0 .and. & this%gwfmodel2%npf%icalcspdis == 0) return @@ -901,13 +894,13 @@ subroutine gwf_gwf_set_flow_to_npf(this) ! end do ! + ! -- Return return end subroutine gwf_gwf_set_flow_to_npf !> @ brief Budget !! !! Accumulate budget terms - !! !< subroutine gwf_gwf_bd(this, icnvg, isuppress_output, isolnid) ! -- modules @@ -922,7 +915,6 @@ subroutine gwf_gwf_bd(this, icnvg, isuppress_output, isolnid) character(len=LENBUDTXT), dimension(1) :: budtxt real(DP), dimension(2, 1) :: budterm real(DP) :: ratin, ratout - ! -- formats ! ! -- initialize budtxt(1) = ' FLOW-JA-FACE' @@ -944,20 +936,88 @@ subroutine gwf_gwf_bd(this, icnvg, isuppress_output, isolnid) call this%gwfmodel2%model_bdentry(budterm, budtxt, this%name) end if ! + ! -- Add any flows from one model into a constant head in another model + ! as a separate budget term called FLOW-JA-FACE-CHD + call this%gwf_gwf_chd_bd() + ! ! -- Call mvr bd routine if (this%inmvr > 0) call this%mvr%mvr_bd() ! - ! -- return + ! -- Return return end subroutine gwf_gwf_bd + !> @ brief gwf-gwf-chd-bd + !! + !! Account for flow from an external model into a chd cell + !< + subroutine gwf_gwf_chd_bd(this) + ! -- modules + use ConstantsModule, only: DZERO, LENBUDTXT, LENPACKAGENAME + use BudgetModule, only: rate_accumulator + ! -- dummy + class(GwfExchangeType) :: this !< GwfExchangeType + ! -- local + character(len=LENBUDTXT), dimension(1) :: budtxt + integer(I4B) :: n + integer(I4B) :: i + real(DP), dimension(2, 1) :: budterm + real(DP) :: ratin, ratout + real(DP) :: q + ! + ! -- initialize + budtxt(1) = 'FLOW-JA-FACE-CHD' + ! + ! -- Add the constant-head budget terms for flow from model 2 into model 1 + if (associated(this%gwfmodel1)) then + ratin = DZERO + ratout = DZERO + do i = 1, this%nexg + n = this%nodem1(i) + if (this%gwfmodel1%ibound(n) < 0) then + q = this%simvals(i) + if (q > DZERO) then + ratout = ratout + q + else + ratin = ratin - q + end if + end if + end do + budterm(1, 1) = ratin + budterm(2, 1) = ratout + call this%gwfmodel1%model_bdentry(budterm, budtxt, this%name) + end if + ! + ! -- Add the constant-head budget terms for flow from model 1 into model 2 + if (associated(this%gwfmodel2)) then + ratin = DZERO + ratout = DZERO + do i = 1, this%nexg + n = this%nodem2(i) + if (this%gwfmodel2%ibound(n) < 0) then + ! -- flip flow sign as flow is relative to model 1 + q = -this%simvals(i) + if (q > DZERO) then + ratout = ratout + q + else + ratin = ratin - q + end if + end if + end do + budterm(1, 1) = ratin + budterm(2, 1) = ratout + call this%gwfmodel2%model_bdentry(budterm, budtxt, this%name) + end if + ! + ! -- Return + return + end subroutine gwf_gwf_chd_bd + !> @ brief Budget save !! !! Output individual flows to listing file and binary budget files - !! !< subroutine gwf_gwf_bdsav(this) - ! -- modules ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType ! -- local @@ -986,16 +1046,18 @@ subroutine gwf_gwf_bdsav(this) call this%gwf_gwf_save_simvals() end if ! - ! -- return + ! -- Return return end subroutine gwf_gwf_bdsav subroutine gwf_gwf_bdsav_model(this, model) + ! -- modules use ConstantsModule, only: DZERO, LENBUDTXT, LENPACKAGENAME use TdisModule, only: kstp, kper + ! -- dummy class(GwfExchangeType) :: this !< this exchange - type(GwfModelType), pointer :: model !< the model to save budget for - ! local + class(GwfModelType), pointer :: model !< the model to save budget for + ! -- local character(len=LENPACKAGENAME + 4) :: packname character(len=LENBUDTXT), dimension(1) :: budtxt type(TableType), pointer :: output_tab @@ -1008,7 +1070,7 @@ subroutine gwf_gwf_bdsav_model(this, model) integer(I4B) :: ibinun real(DP) :: ratin, ratout, rrate logical(LGP) :: is_for_model1 - + ! budtxt(1) = ' FLOW-JA-FACE' packname = 'EXG '//this%name packname = adjustr(packname) @@ -1115,7 +1177,6 @@ subroutine gwf_gwf_bdsav_model(this, model) call output_tab%print_list_entry(i, trim(adjustl(nodestr)), & -rrate, bname) end if - end if end if if (rrate < DZERO) then @@ -1141,18 +1202,19 @@ subroutine gwf_gwf_bdsav_model(this, model) end if ! end do - + ! + ! -- Return + return end subroutine gwf_gwf_bdsav_model !> @ brief Output !! !! Write output - !! !< subroutine gwf_gwf_ot(this) ! -- modules use SimVariablesModule, only: iout - use ConstantsModule, only: DZERO, LINELENGTH + use ConstantsModule, only: DZERO ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType ! -- local @@ -1215,191 +1277,119 @@ subroutine gwf_gwf_ot(this) ! -- OBS output call this%obs%obs_ot() ! - ! -- return + ! -- Return return end subroutine gwf_gwf_ot - !> @ brief Read options - !! - !! Read the options block + !> @ brief Source options !! + !! Source the options block !< - subroutine read_options(this, iout) + subroutine source_options(this, iout) ! -- modules - use ConstantsModule, only: LINELENGTH, LENAUXNAME, DEM6 - use MemoryManagerModule, only: mem_allocate - use SimModule, only: store_error, store_error_unit + use ConstantsModule, only: LENVARNAME, DEM6 + use InputOutputModule, only: getunit, openfile + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use ExgGwfgwfInputModule, only: ExgGwfgwfParamFoundType + use SourceCommonModule, only: filein_fname ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType integer(I4B), intent(in) :: iout ! -- local - character(len=LINELENGTH) :: keyword - logical :: isfound - logical :: endOfBlock - integer(I4B) :: ierr - ! - ! -- get options block - call this%parser%GetBlock('OPTIONS', isfound, ierr, & - supportOpenClose=.true., blockRequired=.false.) - ! - ! -- parse options block if detected - if (isfound) then - write (iout, '(1x,a)') 'PROCESSING GWF-GWF EXCHANGE OPTIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) then - exit - end if - call this%parser%GetStringCaps(keyword) - - ! first parse option in base - if (this%DisConnExchangeType%parse_option(keyword, iout)) then - cycle - end if - - ! it's probably ours - if (this%parse_option(keyword, iout)) then - cycle - end if - - ! unknown option - errmsg = "Unknown GWF-GWF exchange option '"//trim(keyword)//"'." - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end do - - write (iout, '(1x,a)') 'END OF GWF-GWF EXCHANGE OPTIONS' + type(ExgGwfgwfParamFoundType) :: found + character(len=LENVARNAME), dimension(3) :: cellavg_method = & + &[character(len=LENVARNAME) :: 'HARMONIC', 'LOGARITHMIC', 'AMT-LMK'] + character(len=LINELENGTH) :: gnc_fname, mvr_fname + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%icellavg, 'CELL_AVERAGING', this%input_mempath, & + cellavg_method, found%cell_averaging) + call mem_set_value(this%inewton, 'NEWTON', this%input_mempath, found%newton) + call mem_set_value(this%ixt3d, 'XT3D', this%input_mempath, found%xt3d) + call mem_set_value(this%ivarcv, 'VARIABLECV', this%input_mempath, & + found%variablecv) + call mem_set_value(this%idewatcv, 'DEWATERED', this%input_mempath, & + found%dewatered) + ! + write (iout, '(1x,a)') 'PROCESSING GWF-GWF EXCHANGE OPTIONS' + ! + ! -- source base class options + call this%DisConnExchangeType%source_options(iout) + ! + if (found%cell_averaging) then + ! -- count from 0 + this%icellavg = this%icellavg - 1 + write (iout, '(4x,a,a)') & + 'CELL AVERAGING METHOD HAS BEEN SET TO: ', & + trim(cellavg_method(this%icellavg + 1)) end if ! - ! -- set omega value used for saturation calculations - if (this%inewton > 0) then - this%satomega = DEM6 + if (found%newton) then + write (iout, '(4x,a)') & + 'NEWTON-RAPHSON method used for unconfined cells' end if ! - ! -- return - return - end subroutine read_options - - !> @brief parse option from exchange file - !< - function parse_option(this, keyword, iout) result(parsed) - use InputOutputModule, only: getunit, openfile - class(GwfExchangeType) :: this !< GwfExchangeType - character(len=LINELENGTH), intent(in) :: keyword !< the option name - integer(I4B), intent(in) :: iout !< for logging - logical(LGP) :: parsed !< true when parsed - ! local - character(len=LINELENGTH) :: fname - integer(I4B) :: inobs - character(len=LINELENGTH) :: subkey - character(len=:), allocatable :: line - - parsed = .true. - - sel_opt:select case(keyword) - case ('PRINT_FLOWS') - this%iprflow = 1 - write (iout, '(4x,a)') & - 'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.' - case ('SAVE_FLOWS') - this%ipakcb = -1 - write (iout, '(4x,a)') & - 'EXCHANGE FLOWS WILL BE SAVED TO BINARY BUDGET FILES.' - case ('ALTERNATIVE_CELL_AVERAGING') - call this%parser%GetStringCaps(subkey) - select case (subkey) - case ('LOGARITHMIC') - this%icellavg = 1 - case ('AMT-LMK') - this%icellavg = 2 - case default - errmsg = "Unknown cell averaging method '"//trim(subkey)//"'." - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - write (iout, '(4x,a,a)') & - 'CELL AVERAGING METHOD HAS BEEN SET TO: ', trim(subkey) - case ('VARIABLECV') - this%ivarcv = 1 - write (iout, '(4x,a)') & - 'VERTICAL CONDUCTANCE VARIES WITH WATER TABLE.' - call this%parser%GetStringCaps(subkey) - if (subkey == 'DEWATERED') then - this%idewatcv = 1 + if (found%xt3d) then + write (iout, '(4x,a)') 'XT3D WILL BE APPLIED ON THE INTERFACE' + end if + ! + if (found%variablecv) then + write (iout, '(4x,a)') & + 'VERTICAL CONDUCTANCE VARIES WITH WATER TABLE.' + end if + ! + if (found%dewatered) then write (iout, '(4x,a)') & 'VERTICAL CONDUCTANCE ACCOUNTS FOR DEWATERED PORTION OF '// & 'AN UNDERLYING CELL.' end if - case ('NEWTON') - this%inewton = 1 - write (iout, '(4x,a)') & - 'NEWTON-RAPHSON method used for unconfined cells' - case ('GNC6') - call this%parser%GetStringCaps(subkey) - if (subkey /= 'FILEIN') then - call store_error('GNC6 keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - if (fname == '') then - call store_error('No GNC6 file specified.') - call this%parser%StoreErrorUnit() - end if - this%ingnc = getunit() - call openfile(this%ingnc, iout, fname, 'GNC') - write (iout, '(4x,a)') & - 'GHOST NODES WILL BE READ FROM ', trim(fname) - case ('MVR6') - if (this%is_datacopy) then - call this%parser%GetRemainingLine(line) - exit sel_opt - end if - call this%parser%GetStringCaps(subkey) - if (subkey /= 'FILEIN') then - call store_error('MVR6 keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() + ! + ! -- enforce 0 or 1 GNC6_FILENAME entries in option block + if (filein_fname(gnc_fname, 'GNC6_FILENAME', this%input_mempath, & + this%filename)) then + this%ingnc = getunit() + call openfile(this%ingnc, iout, gnc_fname, 'GNC') + write (iout, '(4x,a)') & + 'GHOST NODES WILL BE READ FROM ', trim(gnc_fname) end if - call this%parser%GetString(fname) - if (fname == '') then - call store_error('No MVR6 file specified.') - call this%parser%StoreErrorUnit() + ! + ! -- enforce 0 or 1 MVR6_FILENAME entries in option block + if (filein_fname(mvr_fname, 'MVR6_FILENAME', this%input_mempath, & + this%filename)) then + this%inmvr = getunit() + call openfile(this%inmvr, iout, mvr_fname, 'MVR') + write (iout, '(4x,a)') & + 'WATER MOVER INFORMATION WILL BE READ FROM ', trim(mvr_fname) end if - this%inmvr = getunit() - call openfile(this%inmvr, iout, fname, 'MVR') - write (iout, '(4x,a)') & - 'WATER MOVER INFORMATION WILL BE READ FROM ', trim(fname) - case ('OBS6') - if (this%is_datacopy) then - call this%parser%GetRemainingLine(line) - exit sel_opt + ! + ! -- enforce 0 or 1 OBS6_FILENAME entries in option block + if (.not. this%is_datacopy) then + if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', & + this%input_mempath, this%filename)) then + this%obs%active = .true. + this%obs%inUnitObs = GetUnit() + call openfile(this%obs%inUnitObs, iout, this%obs%inputFilename, 'OBS') + end if end if - call this%parser%GetStringCaps(subkey) - if (subkey /= 'FILEIN') then - call store_error('OBS8 keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() + ! + write (iout, '(1x,a)') 'END OF GWF-GWF EXCHANGE OPTIONS' + ! + ! -- set omega value used for saturation calculations + if (this%inewton > 0) then + this%satomega = DEM6 end if - this%obs%active = .true. - call this%parser%GetString(this%obs%inputFilename) - inobs = GetUnit() - call openfile(inobs, iout, this%obs%inputFilename, 'OBS') - this%obs%inUnitObs = inobs - case default - parsed = .false. - end select sel_opt - - end function parse_option + ! + ! -- Return + return + end subroutine source_options !> @ brief Read ghost nodes !! !! Read and process ghost nodes - !! !< subroutine read_gnc(this) ! -- modules - use SimModule, only: store_error, store_error_unit, count_errors use ConstantsModule, only: LINELENGTH ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType @@ -1447,21 +1437,21 @@ subroutine read_gnc(this) ! -- close the file close (this%ingnc) ! - ! -- return + ! -- Return return end subroutine read_gnc !> @ brief Read mover !! !! Read and process movers - !! !< subroutine read_mvr(this, iout) ! -- modules - use GwfMvrModule, only: mvr_cr + use GwfExgMoverModule, only: exg_mvr_cr ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType integer(I4B), intent(in) :: iout + class(DisBaseType), pointer :: dis ! -- local ! ! -- Create and initialize the mover object Here, dis is set to the one @@ -1470,8 +1460,15 @@ subroutine read_mvr(this, iout) ! the dis object does not convert from reduced to user node numbers. ! So in this case, the dis object is just writing unconverted package ! numbers to the binary budget file. - call mvr_cr(this%mvr, this%name, this%inmvr, iout, this%gwfmodel1%dis, & - iexgmvr=1) + dis => null() + if (this%v_model1%is_local) then + dis => this%gwfmodel1%dis + else if (this%v_model2%is_local) then + dis => this%gwfmodel2%dis + end if + call exg_mvr_cr(this%mvr, this%name, this%inmvr, iout, dis) + this%mvr%model1 => this%v_model1 + this%mvr%model2 => this%v_model2 ! ! -- Return return @@ -1480,7 +1477,6 @@ end subroutine read_mvr !> @ brief Rewet !! !! Check if rewetting should propagate from one model to another - !! !< subroutine rewet(this, kiter) ! -- modules @@ -1549,7 +1545,7 @@ subroutine calc_cond_sat(this) real(DP) :: csat real(DP) :: fawidth real(DP), dimension(3) :: vg - + ! do iexg = 1, this%nexg ! ihc = this%ihc(iexg) @@ -1617,13 +1613,14 @@ subroutine calc_cond_sat(this) ! -- store csat in condsat this%condsat(iexg) = csat end do - + ! + ! -- Return + return end subroutine calc_cond_sat !> @ brief Calculate the conductance !! !! Calculate the conductance based on state - !! !< subroutine condcalc(this) ! -- modules @@ -1718,7 +1715,6 @@ end subroutine condcalc !> @ brief Allocate scalars !! !! Allocate scalar variables - !! !< subroutine allocate_scalars(this) ! -- modules @@ -1726,16 +1722,9 @@ subroutine allocate_scalars(this) use ConstantsModule, only: DZERO ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType - ! -- local ! call this%DisConnExchangeType%allocate_scalars() ! - call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath) - call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath) - this%iprpak = 0 - this%iprflow = 0 - this%ipakcb = 0 - ! call mem_allocate(this%icellavg, 'ICELLAVG', this%memoryPath) call mem_allocate(this%ivarcv, 'IVARCV', this%memoryPath) call mem_allocate(this%idewatcv, 'IDEWATCV', this%memoryPath) @@ -1753,21 +1742,19 @@ subroutine allocate_scalars(this) this%inobs = 0 this%satomega = DZERO ! - ! -- return + ! -- Return return end subroutine allocate_scalars !> @ brief Deallocate !! !! Deallocate memory associated with this object - !! !< subroutine gwf_gwf_da(this) ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType - ! -- local ! ! -- objects if (this%ingnc > 0) then @@ -1802,8 +1789,6 @@ subroutine gwf_gwf_da(this) ! ! -- scalars deallocate (this%filename) - call mem_deallocate(this%iprflow) - call mem_deallocate(this%ipakcb) ! call mem_deallocate(this%icellavg) call mem_deallocate(this%ivarcv) @@ -1817,14 +1802,13 @@ subroutine gwf_gwf_da(this) ! -- deallocate base call this%DisConnExchangeType%disconnex_da() ! - ! -- return + ! -- Return return end subroutine gwf_gwf_da !> @ brief Allocate arrays !! !! Allocate arrays - !! !< subroutine allocate_arrays(this) ! -- modules @@ -1892,14 +1876,13 @@ subroutine allocate_arrays(this) end if end if ! - ! -- return + ! -- Return return end subroutine allocate_arrays !> @ brief Define observations !! !! Define the observations associated with this object - !! !< subroutine gwf_gwf_df_obs(this) ! -- dummy @@ -1912,14 +1895,13 @@ subroutine gwf_gwf_df_obs(this) call this%obs%StoreObsType('flow-ja-face', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => gwf_gwf_process_obsID ! - ! -- return + ! -- Return return end subroutine gwf_gwf_df_obs !> @ brief Read and prepare observations !! !! Handle observation exchanges exchange-boundary names. - !! !< subroutine gwf_gwf_rp_obs(this) ! -- modules @@ -1984,7 +1966,7 @@ subroutine gwf_gwf_rp_obs(this) ! ! -- write summary of error messages if (count_errors() > 0) then - call store_error_unit(this%inobs) + call store_error_filename(this%obs%inputFilename) end if ! ! -- Return @@ -1994,19 +1976,18 @@ end subroutine gwf_gwf_rp_obs !> @ brief Final processing !! !! Conduct any final processing - !! !< subroutine gwf_gwf_fp(this) ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType ! + ! -- Return return end subroutine gwf_gwf_fp !> @ brief Calculate flow !! !! Calculate the flow for the specified exchange and node numbers - !! !< function qcalc(this, iexg, n1, n2) ! -- return @@ -2021,7 +2002,7 @@ function qcalc(this, iexg, n1, n2) ! -- Calculate flow between nodes in the two models qcalc = this%cond(iexg) * (this%gwfmodel2%x(n2) - this%gwfmodel1%x(n1)) ! - ! -- return + ! -- Return return end function qcalc @@ -2029,7 +2010,6 @@ end function qcalc !! !! Return flag indicating whether or not this exchange will cause the !! coefficient matrix to be asymmetric. - !! !< function gwf_gwf_get_iasym(this) result(iasym) ! -- dummy @@ -2048,7 +2028,7 @@ function gwf_gwf_get_iasym(this) result(iasym) if (this%gnc%iasym /= 0) iasym = 1 end if ! - ! -- return + ! -- Return return end function gwf_gwf_get_iasym @@ -2056,11 +2036,14 @@ end function gwf_gwf_get_iasym !! coefficients for solving @param model !< function gwf_gwf_connects_model(this, model) result(is_connected) + ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType class(BaseModelType), pointer, intent(in) :: model !< the model to which the exchange might hold a connection + ! -- return logical(LGP) :: is_connected !< true, when connected - + ! is_connected = .false. + ! ! only connected when model is GwfModelType of course select type (model) class is (GwfModelType) @@ -2070,31 +2053,36 @@ function gwf_gwf_connects_model(this, model) result(is_connected) is_connected = .true. end if end select - + ! + ! -- Return + return end function gwf_gwf_connects_model !> @brief Should interface model be used for this exchange !< function use_interface_model(this) result(use_im) + ! -- dummy class(GwfExchangeType) :: this !< GwfExchangeType + ! -- return logical(LGP) :: use_im !< true when interface model should be used - + ! use_im = this%DisConnExchangeType%use_interface_model() use_im = use_im .or. (this%ixt3d > 0) - + ! + ! -- Return + return end function !> @ brief Save simulated flow observations !! !! Save the simulated flows for each exchange - !! !< subroutine gwf_gwf_save_simvals(this) - ! -- dummy - use SimModule, only: store_error, store_error_unit + ! -- modules use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO use ObserveModule, only: ObserveType + ! -- dummy class(GwfExchangeType), intent(inout) :: this ! -- local integer(I4B) :: i @@ -2122,20 +2110,20 @@ subroutine gwf_gwf_save_simvals(this) errmsg = 'Unrecognized observation type: '// & trim(obsrv%ObsTypeId) call store_error(errmsg) - call store_error_unit(this%inobs) + call store_error_filename(this%obs%inputFilename) end select call this%obs%SaveOneSimval(obsrv, v) end do end do end if ! + ! -- Return return end subroutine gwf_gwf_save_simvals !> @ brief Obs ID processer !! !! Process observations for this exchange - !! !< subroutine gwf_gwf_process_obsID(obsrv, dis, inunitobs, iout) ! -- modules @@ -2171,17 +2159,19 @@ subroutine gwf_gwf_process_obsID(obsrv, dis, inunitobs, iout) obsrv%intPak1 = NAMEDBOUNDFLAG end if ! + ! -- Return return end subroutine gwf_gwf_process_obsID !> @ brief Cast polymorphic object as exchange !! !! Cast polymorphic object as exchange - !! !< function CastAsGwfExchange(obj) result(res) implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return class(GwfExchangeType), pointer :: res ! res => null() @@ -2191,19 +2181,21 @@ function CastAsGwfExchange(obj) result(res) class is (GwfExchangeType) res => obj end select + ! + ! -- Return return end function CastAsGwfExchange !> @ brief Get exchange from list !! !! Return an exchange from the list for specified index - !! !< function GetGwfExchangeFromList(list, idx) result(res) implicit none ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx + ! -- return class(GwfExchangeType), pointer :: res ! -- local class(*), pointer :: obj @@ -2211,6 +2203,7 @@ function GetGwfExchangeFromList(list, idx) result(res) obj => list%GetItem(idx) res => CastAsGwfExchange(obj) ! + ! -- Return return end function GetGwfExchangeFromList diff --git a/src/Exchange/GwfGwtExchange.f90 b/src/Exchange/GwfGwtExchange.f90 index 986b84fd990..9313efcce59 100644 --- a/src/Exchange/GwfGwtExchange.f90 +++ b/src/Exchange/GwfGwtExchange.f90 @@ -41,13 +41,9 @@ module GwfGwtExchangeModule contains + !> @brief Create a new GWF to GWT exchange object + !< subroutine gwfgwt_cr(filename, id, m1_id, m2_id) -! ****************************************************************************** -! gwfgwt_cr -- Create a new GWF to GWT exchange object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: model_loc_idx ! -- dummy @@ -59,7 +55,6 @@ subroutine gwfgwt_cr(filename, id, m1_id, m2_id) class(BaseExchangeType), pointer :: baseexchange => null() type(GwfGwtExchangeType), pointer :: exchange => null() character(len=20) :: cint -! ------------------------------------------------------------------------------ ! ! -- Create a new exchange and add it to the baseexchangelist container allocate (exchange) @@ -82,25 +77,19 @@ subroutine gwfgwt_cr(filename, id, m1_id, m2_id) ! -- set model pointers call exchange%set_model_pointers() ! - ! -- return + ! -- Return return end subroutine gwfgwt_cr + !> @brief Allocate and read + !< subroutine set_model_pointers(this) -! ****************************************************************************** -! set_model_pointers -- allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfGwtExchangeType) :: this ! -- local class(BaseModelType), pointer :: mb => null() type(GwfModelType), pointer :: gwfmodel => null() type(GwtModelType), pointer :: gwtmodel => null() -! ------------------------------------------------------------------------------ ! ! -- set gwfmodel gwfmodel => null() @@ -139,17 +128,13 @@ subroutine set_model_pointers(this) ! to look through the flow packages and establish a link to GWF flows gwtmodel%fmi%gwfbndlist => gwfmodel%bndlist ! - ! -- return + ! -- Return return end subroutine set_model_pointers + !> @brief Define GwfGwt Exchange object + !< subroutine exg_df(this) -! ****************************************************************************** -! exg_df -- define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_checkin ! -- dummy @@ -158,8 +143,6 @@ subroutine exg_df(this) class(BaseModelType), pointer :: mb => null() type(GwfModelType), pointer :: gwfmodel => null() type(GwtModelType), pointer :: gwtmodel => null() -! ------------------------------------------------------------------------------ - ! ! ! -- set gwfmodel mb => GetBaseModelFromList(basemodellist, this%m1_idx) @@ -198,17 +181,13 @@ subroutine exg_df(this) gwfmodel%npf%icalcspdis = 1 end if ! - ! -- return + ! -- Return return end subroutine exg_df + !> @brief Allocate and read + !< subroutine exg_ar(this) -! ****************************************************************************** -! exg_ar -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_checkin ! -- dummy @@ -224,7 +203,6 @@ subroutine exg_ar(this) & GWF Model has ', i0, ' user nodes and ', i0, ' reduced nodes.& & GWT Model has ', i0, ' user nodes and ', i0, ' reduced nodes.& & Ensure discretization packages, including IDOMAIN, are identical.')" -! ------------------------------------------------------------------------------ ! ! -- set gwfmodel mb => GetBaseModelFromList(basemodellist, this%m1_idx) @@ -301,20 +279,22 @@ subroutine exg_ar(this) ! -- connect Connections call this%gwfconn2gwtconn(gwfmodel, gwtmodel) ! - ! -- return + ! -- Return return end subroutine exg_ar !> @brief Link GWT connections to GWF connections or exchanges !< subroutine gwfconn2gwtconn(this, gwfModel, gwtModel) + ! -- modules use SimModule, only: store_error use SimVariablesModule, only: iout use MemoryManagerModule, only: mem_checkin + ! -- dummy class(GwfGwtExchangeType) :: this !< this exchange type(GwfModelType), pointer :: gwfModel !< the flow model type(GwtModelType), pointer :: gwtModel !< the transport model - ! local + ! -- local class(SpatialModelConnectionType), pointer :: conn => null() class(*), pointer :: objPtr => null() class(GwtGwtConnectionType), pointer :: gwtConn => null() @@ -323,27 +303,27 @@ subroutine gwfconn2gwtconn(this, gwfModel, gwtModel) integer(I4B) :: ic1, ic2, iex integer(I4B) :: gwfConnIdx, gwfExIdx logical(LGP) :: areEqual - + ! ! loop over all connections gwtloop: do ic1 = 1, baseconnectionlist%Count() - + ! conn => get_smc_from_list(baseconnectionlist, ic1) if (.not. associated(conn%owner, gwtModel)) cycle gwtloop - + ! ! start with a GWT conn. objPtr => conn gwtConn => CastAsGwtGwtConnection(objPtr) gwfConnIdx = -1 gwfExIdx = -1 - + ! ! find matching GWF conn. in same list gwfloop: do ic2 = 1, baseconnectionlist%Count() conn => get_smc_from_list(baseconnectionlist, ic2) - + ! if (associated(conn%owner, gwfModel)) then objPtr => conn gwfConn => CastAsGwfGwfConnection(objPtr) - + ! ! for now, connecting the same nodes nrs will be ! sufficient evidence of equality areEqual = all(gwfConn%prim_exchange%nodem1 == & @@ -363,24 +343,28 @@ subroutine gwfconn2gwtconn(this, gwfModel, gwtModel) end if end if end do gwfloop - + ! ! fallback option: coupling to old gwfgwf exchange, ! (this will go obsolete at some point) if (gwfConnIdx == -1) then gwfloopexg: do iex = 1, baseexchangelist%Count() gwfEx => GetGwfExchangeFromList(baseexchangelist, iex) - + ! ! -- There is no guarantee that iex is a gwfExg, in which case ! it will return as null. cycle if so. if (.not. associated(gwfEx)) cycle gwfloopexg - + ! if (associated(gwfEx%model1, gwfModel) .or. & associated(gwfEx%model2, gwfModel)) then - ! again, connecting the same nodes nrs will be + + ! check exchanges have same node counts + areEqual = size(gwfEx%nodem1) == size(gwtConn%prim_exchange%nodem1) + ! then, connecting the same nodes nrs will be ! sufficient evidence of equality - areEqual = all(gwfEx%nodem1 == gwtConn%prim_exchange%nodem1) - areEqual = areEqual .and. & - all(gwfEx%nodem2 == gwtConn%prim_exchange%nodem2) + if (areEqual) & + areEqual = all(gwfEx%nodem1 == gwtConn%prim_exchange%nodem1) + if (areEqual) & + areEqual = all(gwfEx%nodem2 == gwtConn%prim_exchange%nodem2) if (areEqual) then ! link exchange to connection write (iout, '(/6a)') 'Linking exchange ', & @@ -388,32 +372,32 @@ subroutine gwfconn2gwtconn(this, gwfModel, gwtModel) ' to ', trim(gwfEx%name), ' for GWT model ', & trim(gwtModel%name) gwfExIdx = iex - if (gwtConn%exchangeIsOwned) then + if (gwtConn%owns_exchange) then gwtConn%gwtExchange%gwfsimvals => gwfEx%simvals call mem_checkin(gwtConn%gwtExchange%gwfsimvals, & 'GWFSIMVALS', gwtConn%gwtExchange%memoryPath, & 'SIMVALS', gwfEx%memoryPath) end if - + ! !cdl link up mvt to mvr if (gwfEx%inmvr > 0) then - if (gwtConn%exchangeIsOwned) then + if (gwtConn%owns_exchange) then !cdl todo: check and make sure gwtEx has mvt active call gwtConn%gwtExchange%mvt%set_pointer_mvrbudobj( & gwfEx%mvr%budobj) end if end if - + ! if (associated(gwfEx%model2, gwfModel)) gwtConn%exgflowSign = -1 gwtConn%gwtInterfaceModel%fmi%flows_from_file = .false. - + ! exit gwfloopexg end if end if - + ! end do gwfloopexg end if - + ! if (gwfConnIdx == -1 .and. gwfExIdx == -1) then ! none found, report write (errmsg, '(/6a)') 'Missing GWF-GWF exchange when connecting GWT'// & @@ -422,103 +406,93 @@ subroutine gwfconn2gwtconn(this, gwfModel, gwtModel) trim(gwfModel%name) call store_error(errmsg, terminate=.true.) end if - + ! end do gwtloop - + ! + ! -- Return + return end subroutine gwfconn2gwtconn !> @brief Links a GWT connection to its GWF counterpart !< subroutine link_connections(this, gwtConn, gwfConn) + ! -- modules use MemoryManagerModule, only: mem_checkin + ! -- dummy class(GwfGwtExchangeType) :: this !< this exchange class(GwtGwtConnectionType), pointer :: gwtConn !< GWT connection class(GwfGwfConnectionType), pointer :: gwfConn !< GWF connection - + ! !gwtConn%exgflowja => gwfConn%exgflowja - if (gwtConn%exchangeIsOwned) then + if (gwtConn%owns_exchange) then gwtConn%gwtExchange%gwfsimvals => gwfConn%gwfExchange%simvals call mem_checkin(gwtConn%gwtExchange%gwfsimvals, & 'GWFSIMVALS', gwtConn%gwtExchange%memoryPath, & 'SIMVALS', gwfConn%gwfExchange%memoryPath) end if - + ! !cdl link up mvt to mvr if (gwfConn%gwfExchange%inmvr > 0) then - if (gwtConn%exchangeIsOwned) then + if (gwtConn%owns_exchange) then !cdl todo: check and make sure gwtEx has mvt active call gwtConn%gwtExchange%mvt%set_pointer_mvrbudobj( & gwfConn%gwfExchange%mvr%budobj) end if end if - + ! if (associated(gwfConn%gwfExchange%model2, gwfConn%owner)) then gwtConn%exgflowSign = -1 end if - + ! ! fmi flows are not read from file gwtConn%gwtInterfaceModel%fmi%flows_from_file = .false. - + ! ! set concentration pointer for buoyancy - call gwfConn%gwfInterfaceModel%buy%set_concentration_pointer( & - gwtConn%gwtModel%name, & - gwtConn%conc, & - gwtConn%icbound) - + ! call gwfConn%gwfInterfaceModel%buy%set_concentration_pointer( & + ! gwtConn%gwtModel%name, & + ! gwtConn%conc, & + ! gwtConn%icbound) + ! + ! -- Return + return end subroutine link_connections + !> @brief Deallocate memory + !< subroutine exg_da(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwfGwtExchangeType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! call mem_deallocate(this%m1_idx) call mem_deallocate(this%m2_idx) ! - ! -- return + ! -- Return return end subroutine exg_da + !> @brief Allocate package scalars + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfGwtExchangeType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! call mem_allocate(this%m1_idx, 'M1ID', this%memoryPath) call mem_allocate(this%m2_idx, 'M2ID', this%memoryPath) this%m1_idx = 0 this%m2_idx = 0 ! - ! -- return + ! -- Return return end subroutine allocate_scalars + !> @brief Call routines in FMI that will set pointers to the necessary flow + !! data + !< subroutine gwfbnd2gwtfmi(this) -! ****************************************************************************** -! gwfbnd2gwtfmi -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfGwtExchangeType) :: this ! -- local @@ -527,7 +501,6 @@ subroutine gwfbnd2gwtfmi(this) type(GwfModelType), pointer :: gwfmodel => null() type(GwtModelType), pointer :: gwtmodel => null() class(BndType), pointer :: packobj => null() -! ------------------------------------------------------------------------------ ! ! -- set gwfmodel mb => GetBaseModelFromList(basemodellist, this%m1_idx) @@ -551,7 +524,7 @@ subroutine gwfbnd2gwtfmi(this) packobj => GetBndFromList(gwfmodel%bndlist, ip) call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( & 'SIMVALS', & - packobj%memoryPath) + packobj%memoryPath, packobj%input_mempath) iterm = iterm + 1 ! ! -- If a mover is active for this package, then establish a separate @@ -561,12 +534,12 @@ subroutine gwfbnd2gwtfmi(this) if (imover /= 0) then call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( & 'SIMTOMVR', & - packobj%memoryPath) + packobj%memoryPath, packobj%input_mempath) iterm = iterm + 1 end if end do ! - ! -- return + ! -- Return return end subroutine gwfbnd2gwtfmi diff --git a/src/Exchange/GwtGwtExchange.f90 b/src/Exchange/GwtGwtExchange.f90 index faf7d1345ba..c4833aeef7d 100644 --- a/src/Exchange/GwtGwtExchange.f90 +++ b/src/Exchange/GwtGwtExchange.f90 @@ -11,7 +11,8 @@ module GwtGwtExchangeModule use KindModule, only: DP, I4B, LGP use SimVariablesModule, only: errmsg, model_loc_idx - use SimModule, only: store_error + use SimModule, only: store_error, store_error_filename, & + count_errors, ustop use BaseModelModule, only: BaseModelType, GetBaseModelFromList use BaseExchangeModule, only: BaseExchangeType, AddBaseExchangeToList use ConstantsModule, only: LENBOUNDNAME, NAMEDBOUNDFLAG, LINELENGTH, & @@ -22,13 +23,10 @@ module GwtGwtExchangeModule use VirtualModelModule, only: get_virtual_model use DisConnExchangeModule, only: DisConnExchangeType use GwtModule, only: GwtModelType - use GwtMvtModule, only: GwtMvtType + use TspMvtModule, only: TspMvtType + use VirtualModelModule, only: VirtualModelType use ObserveModule, only: ObserveType use ObsModule, only: ObsType - use SimModule, only: count_errors, store_error, & - store_error_unit, ustop - use SimVariablesModule, only: errmsg - use BlockParserModule, only: BlockParserType use TableModule, only: TableType, table_cr use MatrixBaseModule @@ -44,7 +42,6 @@ module GwtGwtExchangeModule !! !! This derived type contains information and methods for !! connecting two GWT models. - !! !< type, extends(DisConnExchangeType) :: GwtExchangeType ! @@ -54,19 +51,17 @@ module GwtGwtExchangeModule real(DP), dimension(:), pointer, contiguous :: gwfsimvals => null() !< simulated gwf flow rate for each exchange ! ! -- pointers to gwt models - type(GwtModelType), pointer :: gwtmodel1 => null() !< pointer to GWT Model 1 - type(GwtModelType), pointer :: gwtmodel2 => null() !< pointer to GWT Model 2 + class(GwtModelType), pointer :: gwtmodel1 => null() !< pointer to GWT Model 1 + class(GwtModelType), pointer :: gwtmodel2 => null() !< pointer to GWT Model 2 ! ! -- GWT specific option block: integer(I4B), pointer :: inewton => null() !< unneeded newton flag allows for mvt to be used here - integer(I4B), pointer :: iprflow => null() !< print flag for cell by cell flows - integer(I4B), pointer :: ipakcb => null() !< save flag for cell by cell flows integer(I4B), pointer :: iAdvScheme !< the advection scheme at the interface: !! 0 = upstream, 1 = central, 2 = TVD ! ! -- Mover transport package integer(I4B), pointer :: inmvt => null() !< unit number for mover transport (0 if off) - type(GwtMvtType), pointer :: mvt => null() !< water mover object + type(TspMvtType), pointer :: mvt => null() !< water mover object ! ! -- Observation package integer(I4B), pointer :: inobs => null() !< unit number for GWT-GWT observations @@ -95,10 +90,10 @@ module GwtGwtExchangeModule procedure :: use_interface_model procedure :: allocate_scalars procedure :: allocate_arrays - procedure :: read_options - procedure :: parse_option + procedure :: source_options procedure :: read_mvt procedure :: gwt_gwt_bdsav + procedure, private :: gwt_gwt_bdsav_model procedure, private :: gwt_gwt_df_obs procedure, private :: gwt_gwt_rp_obs procedure, public :: gwt_gwt_save_simvals @@ -110,11 +105,9 @@ module GwtGwtExchangeModule !> @ brief Create GWT GWT exchange !! !! Create a new GWT to GWT exchange object. - !! !< - subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) + subroutine gwtexchange_create(filename, name, id, m1_id, m2_id, input_mempath) ! -- modules - use ConstantsModule, only: LINELENGTH use BaseModelModule, only: BaseModelType use ListsModule, only: baseexchangelist use ObsModule, only: obs_cr @@ -125,6 +118,7 @@ subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) character(len=*) :: name !< the exchange name integer(I4B), intent(in) :: m1_id !< id for model 1 integer(I4B), intent(in) :: m2_id !< id for model 2 + character(len=*), intent(in) :: input_mempath ! -- local type(GwtExchangeType), pointer :: exchange class(BaseModelType), pointer :: mb @@ -140,6 +134,7 @@ subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) exchange%id = id exchange%name = name exchange%memoryPath = create_mem_path(exchange%name) + exchange%input_mempath = input_mempath ! ! -- allocate scalars and set defaults call exchange%allocate_scalars() @@ -151,21 +146,25 @@ subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) ! -- set gwtmodel1 m1_index = model_loc_idx(m1_id) mb => GetBaseModelFromList(basemodellist, m1_index) - select type (mb) - type is (GwtModelType) - exchange%model1 => mb - exchange%gwtmodel1 => mb - end select + if (m1_index > 0) then + select type (mb) + type is (GwtModelType) + exchange%model1 => mb + exchange%gwtmodel1 => mb + end select + end if exchange%v_model1 => get_virtual_model(m1_id) ! ! -- set gwtmodel2 m2_index = model_loc_idx(m2_id) - mb => GetBaseModelFromList(basemodellist, m2_index) - select type (mb) - type is (GwtModelType) - exchange%model2 => mb - exchange%gwtmodel2 => mb - end select + if (m2_index > 0) then + mb => GetBaseModelFromList(basemodellist, m2_index) + select type (mb) + type is (GwtModelType) + exchange%model2 => mb + exchange%gwtmodel2 => mb + end select + end if exchange%v_model2 => get_virtual_model(m2_id) ! ! -- Verify that gwt model1 is of the correct type @@ -176,7 +175,7 @@ subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) call store_error(errmsg, terminate=.true.) end if ! - ! -- Verify that gwf model2 is of the correct type + ! -- Verify that gwt model2 is of the correct type if (.not. associated(exchange%gwtmodel2) .and. m2_index > 0) then write (errmsg, '(3a)') 'Problem with GWT-GWT exchange ', & trim(exchange%name), & @@ -187,14 +186,13 @@ subroutine gwtexchange_create(filename, name, id, m1_id, m2_id) ! -- Create the obs package call obs_cr(exchange%obs, exchange%inobs) ! - ! -- return + ! -- Return return end subroutine gwtexchange_create !> @ brief Define GWT GWT exchange !! !! Define GWT to GWT exchange object. - !! !< subroutine gwt_gwt_df(this) ! -- modules @@ -204,35 +202,31 @@ subroutine gwt_gwt_df(this) ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType ! -- local - integer(I4B) :: inunit ! - ! -- open the file - inunit = getunit() + ! -- log the exchange write (iout, '(/a,a)') ' Creating exchange: ', this%name - call openfile(inunit, iout, this%filename, 'GWT-GWT') - ! - call this%parser%Initialize(inunit, iout) ! ! -- Ensure models are in same solution - if (this%gwtmodel1%idsoln /= this%gwtmodel2%idsoln) then + if (this%v_model1%idsoln%get() /= this%v_model2%idsoln%get()) then call store_error('Two models are connected in a GWT '// & 'exchange but they are in different solutions. '// & 'GWT models must be in same solution: '// & - trim(this%gwtmodel1%name)//' '//trim(this%gwtmodel2%name)) - call this%parser%StoreErrorUnit() + trim(this%v_model1%name)//' '// & + trim(this%v_model2%name)) + call store_error_filename(this%filename) end if ! - ! -- read options - call this%read_options(iout) + ! -- source options + call this%source_options(iout) ! - ! -- read dimensions - call this%read_dimensions(iout) + ! -- source dimensions + call this%source_dimensions(iout) ! ! -- allocate arrays call this%allocate_arrays() ! - ! -- read exchange data - call this%read_data(iout) + ! -- source exchange data + call this%source_data(iout) ! ! -- Read mover information if (this%inmvt > 0) then @@ -240,26 +234,25 @@ subroutine gwt_gwt_df(this) call this%mvt%mvt_df(this%gwtmodel1%dis) end if ! - ! -- close the file - close (inunit) - ! ! -- Store obs call this%gwt_gwt_df_obs() - call this%obs%obs_df(iout, this%name, 'GWT-GWT', this%gwtmodel1%dis) + if (associated(this%gwtmodel1)) then + call this%obs%obs_df(iout, this%name, 'GWT-GWT', this%gwtmodel1%dis) + end if ! ! -- validate call this%validate_exchange() ! - ! -- return + ! -- Return return end subroutine gwt_gwt_df !> @brief validate exchange data after reading !< subroutine validate_exchange(this) + ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType - ! local - + ! ! Ensure gwfmodel names were entered if (this%gwfmodelname1 == '') then write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), & @@ -273,9 +266,9 @@ subroutine validate_exchange(this) &OPTIONS block.' call store_error(errmsg) end if - + ! ! Periodic boundary condition in exchange don't allow XT3D (=interface model) - if (associated(this%model1, this%model2)) then + if (this%v_model1 == this%v_model2) then if (this%ixt3d > 0) then write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), & ' is a periodic boundary condition which cannot'// & @@ -283,43 +276,44 @@ subroutine validate_exchange(this) call store_error(errmsg) end if end if - + ! ! Check to see if dispersion is on in either model1 or model2. ! If so, then ANGLDEGX must be provided as an auxiliary variable for this ! GWT-GWT exchange (this%ianglex > 0). - if (this%gwtmodel1%indsp /= 0 .or. this%gwtmodel2%indsp /= 0) then - if (this%ianglex == 0) then - write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), & - ' requires that ANGLDEGX be specified as an'// & - ' auxiliary variable because dispersion was '// & - 'specified in one or both transport models.' - call store_error(errmsg) + if (associated(this%gwtmodel1) .and. associated(this%gwtmodel2)) then + if (this%gwtmodel1%indsp /= 0 .or. this%gwtmodel2%indsp /= 0) then + if (this%ianglex == 0) then + write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), & + ' requires that ANGLDEGX be specified as an'// & + ' auxiliary variable because dispersion was '// & + 'specified in one or both transport models.' + call store_error(errmsg) + end if end if end if - + ! if (this%ixt3d > 0 .and. this%ianglex == 0) then write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), & ' requires that ANGLDEGX be specified as an'// & ' auxiliary variable because XT3D is enabled' call store_error(errmsg) end if - + ! if (count_errors() > 0) then call ustop() end if - + ! + ! -- Return + return end subroutine validate_exchange !> @ brief Allocate and read !! !! Allocated and read and calculate saturated conductance - !! !< subroutine gwt_gwt_ar(this) - ! -- modules ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType - ! -- local ! ! -- If mover is active, then call ar routine if (this%inmvt > 0) call this%mvt%mvt_ar() @@ -334,7 +328,6 @@ end subroutine gwt_gwt_ar !> @ brief Read and prepare !! !! Read new data for mover and obs - !! !< subroutine gwt_gwt_rp(this) ! -- modules @@ -358,13 +351,10 @@ end subroutine gwt_gwt_rp !> @ brief Advance !! !! Advance mover and obs - !! !< subroutine gwt_gwt_ad(this) - ! -- modules ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType - ! -- local ! ! -- Advance mover !if(this%inmvt > 0) call this%mvt%mvt_ad() @@ -379,17 +369,14 @@ end subroutine gwt_gwt_ad !> @ brief Fill coefficients !! !! Calculate conductance and fill coefficient matrix - !! !< subroutine gwt_gwt_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) - ! -- modules ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType integer(I4B), intent(in) :: kiter class(MatrixBaseType), pointer :: matrix_sln real(DP), dimension(:), intent(inout) :: rhs_sln integer(I4B), optional, intent(in) :: inwtflag - ! -- local ! ! -- Call mvt fc routine if (this%inmvt > 0) call this%mvt%mvt_fc(this%gwtmodel1%x, this%gwtmodel2%x) @@ -401,7 +388,6 @@ end subroutine gwt_gwt_fc !> @ brief Budget !! !! Accumulate budget terms - !! !< subroutine gwt_gwt_bd(this, icnvg, isuppress_output, isolnid) ! -- modules @@ -416,7 +402,6 @@ subroutine gwt_gwt_bd(this, icnvg, isuppress_output, isolnid) character(len=LENBUDTXT), dimension(1) :: budtxt real(DP), dimension(2, 1) :: budterm real(DP) :: ratin, ratout - ! -- formats ! ! -- initialize budtxt(1) = ' FLOW-JA-FACE' @@ -425,70 +410,114 @@ subroutine gwt_gwt_bd(this, icnvg, isuppress_output, isolnid) call rate_accumulator(this%simvals, ratin, ratout) ! ! -- Add the budget terms to model 1 - budterm(1, 1) = ratin - budterm(2, 1) = ratout - call this%gwtmodel1%model_bdentry(budterm, budtxt, this%name) + if (associated(this%gwtmodel1)) then + budterm(1, 1) = ratin + budterm(2, 1) = ratout + call this%gwtmodel1%model_bdentry(budterm, budtxt, this%name) + end if ! ! -- Add the budget terms to model 2 - budterm(1, 1) = ratout - budterm(2, 1) = ratin - call this%gwtmodel2%model_bdentry(budterm, budtxt, this%name) + if (associated(this%gwtmodel2)) then + budterm(1, 1) = ratout + budterm(2, 1) = ratin + call this%gwtmodel2%model_bdentry(budterm, budtxt, this%name) + end if ! ! -- Call mvt bd routine if (this%inmvt > 0) call this%mvt%mvt_bd(this%gwtmodel1%x, this%gwtmodel2%x) ! - ! -- return + ! -- Return return end subroutine gwt_gwt_bd !> @ brief Budget save !! !! Output individual flows to listing file and binary budget files - !! !< subroutine gwt_gwt_bdsav(this) + ! -- dummy + class(GwtExchangeType) :: this !< GwtExchangeType + ! -- local + integer(I4B) :: icbcfl, ibudfl + ! + ! -- budget for model1 + if (associated(this%gwtmodel1)) then + call this%gwt_gwt_bdsav_model(this%gwtmodel1) + end if + ! + ! -- budget for model2 + if (associated(this%gwtmodel2)) then + call this%gwt_gwt_bdsav_model(this%gwtmodel2) + end if + ! + ! -- Set icbcfl, ibudfl to zero so that flows will be printed and + ! saved, if the options were set in the MVT package + icbcfl = 1 + ibudfl = 1 + ! + ! -- Call mvt bd routine + !cdl todo: if(this%inmvt > 0) call this%mvt%mvt_bdsav(icbcfl, ibudfl, isuppress_output) + ! + ! -- Calculate and write simulated values for observations + if (this%inobs /= 0) then + call this%gwt_gwt_save_simvals() + end if + ! + ! -- Return + return + end subroutine gwt_gwt_bdsav + + !> @ brief Budget save + !! + !! Output individual flows to listing file and binary budget files + !< + subroutine gwt_gwt_bdsav_model(this, model) ! -- modules use ConstantsModule, only: DZERO, LENBUDTXT, LENPACKAGENAME use TdisModule, only: kstp, kper ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType + class(GwtModelType), pointer :: model ! -- local character(len=LENBOUNDNAME) :: bname - character(len=LENPACKAGENAME + 4) :: packname1 - character(len=LENPACKAGENAME + 4) :: packname2 + character(len=LENPACKAGENAME + 4) :: packname character(len=LENBUDTXT), dimension(1) :: budtxt + type(TableType), pointer :: output_tab + class(VirtualModelType), pointer :: nbr_model character(len=20) :: nodestr integer(I4B) :: ntabrows integer(I4B) :: nodeu integer(I4B) :: i, n1, n2, n1u, n2u - integer(I4B) :: ibinun1, ibinun2 - integer(I4B) :: icbcfl, ibudfl + integer(I4B) :: ibinun real(DP) :: ratin, ratout, rrate + logical(LGP) :: is_for_model1 integer(I4B) :: isuppress_output - ! -- formats ! ! -- initialize local variables isuppress_output = 0 budtxt(1) = ' FLOW-JA-FACE' - packname1 = 'EXG '//this%name - packname1 = adjustr(packname1) - packname2 = 'EXG '//this%name - packname2 = adjustr(packname2) + packname = 'EXG '//this%name + packname = adjustr(packname) + if (associated(model, this%gwtmodel1)) then + output_tab => this%outputtab1 + nbr_model => this%v_model2 + is_for_model1 = .true. + else + output_tab => this%outputtab2 + nbr_model => this%v_model1 + is_for_model1 = .false. + end if ! ! -- update output tables if (this%iprflow /= 0) then ! ! -- update titles - if (this%gwtmodel1%oc%oc_save('BUDGET')) then - call this%outputtab1%set_title(packname1) - end if - if (this%gwtmodel2%oc%oc_save('BUDGET')) then - call this%outputtab2%set_title(packname2) + if (model%oc%oc_save('BUDGET')) then + call output_tab%set_title(packname) end if ! ! -- set table kstp and kper - call this%outputtab1%set_kstpkper(kstp, kper) - call this%outputtab2%set_kstpkper(kstp, kper) + call output_tab%set_kstpkper(kstp, kper) ! ! -- update maxbound of tables ntabrows = 0 @@ -497,14 +526,13 @@ subroutine gwt_gwt_bdsav(this) n2 = this%nodem2(i) ! ! -- If both cells are active then calculate flow rate - if (this%gwtmodel1%ibound(n1) /= 0 .and. & - this%gwtmodel2%ibound(n2) /= 0) then + if (this%v_model1%ibound%get(n1) /= 0 .and. & + this%v_model2%ibound%get(n2) /= 0) then ntabrows = ntabrows + 1 end if end do if (ntabrows > 0) then - call this%outputtab1%set_maxbound(ntabrows) - call this%outputtab2%set_maxbound(ntabrows) + call output_tab%set_maxbound(ntabrows) end if end if ! @@ -512,28 +540,28 @@ subroutine gwt_gwt_bdsav(this) ! ! -- Set binary unit numbers for saving flows if (this%ipakcb /= 0) then - ibinun1 = this%gwtmodel1%oc%oc_save_unit('BUDGET') + ibinun = model%oc%oc_save_unit('BUDGET') else - ibinun1 = 0 + ibinun = 0 end if ! ! -- If save budget flag is zero for this stress period, then ! shut off saving - if (.not. this%gwtmodel1%oc%oc_save('BUDGET')) ibinun1 = 0 + if (.not. model%oc%oc_save('BUDGET')) ibinun = 0 if (isuppress_output /= 0) then - ibinun1 = 0 + ibinun = 0 end if ! ! -- If cell-by-cell flows will be saved as a list, write header. - if (ibinun1 /= 0) then - call this%gwtmodel1%dis%record_srcdst_list_header(budtxt(1), & - this%gwtmodel1%name, & - this%name, & - this%gwtmodel2%name, & - this%name, & - this%naux, this%auxname, & - ibinun1, this%nexg, & - this%gwtmodel1%iout) + if (ibinun /= 0) then + call model%dis%record_srcdst_list_header(budtxt(1), & + model%name, & + this%name, & + nbr_model%name, & + this%name, & + this%naux, this%auxname, & + ibinun, this%nexg, & + model%iout) end if ! ! Initialize accumulators @@ -556,19 +584,26 @@ subroutine gwt_gwt_bdsav(this) n2 = this%nodem2(i) ! ! -- If both cells are active then calculate flow rate - if (this%gwtmodel1%ibound(n1) /= 0 .and. & - this%gwtmodel2%ibound(n2) /= 0) then + if (this%v_model1%ibound%get(n1) /= 0 .and. & + this%v_model2%ibound%get(n2) /= 0) then rrate = this%simvals(i) ! ! -- Print the individual rates to model list files if requested if (this%iprflow /= 0) then - if (this%gwtmodel1%oc%oc_save('BUDGET')) then + if (model%oc%oc_save('BUDGET')) then ! ! -- set nodestr and write outputtab table - nodeu = this%gwtmodel1%dis%get_nodeuser(n1) - call this%gwtmodel1%dis%nodeu_to_string(nodeu, nodestr) - call this%outputtab1%print_list_entry(i, trim(adjustl(nodestr)), & - rrate, bname) + if (is_for_model1) then + nodeu = model%dis%get_nodeuser(n1) + call model%dis%nodeu_to_string(nodeu, nodestr) + call output_tab%print_list_entry(i, trim(adjustl(nodestr)), & + rrate, bname) + else + nodeu = model%dis%get_nodeuser(n2) + call model%dis%nodeu_to_string(nodeu, nodestr) + call output_tab%print_list_entry(i, trim(adjustl(nodestr)), & + -rrate, bname) + end if end if end if if (rrate < DZERO) then @@ -579,121 +614,34 @@ subroutine gwt_gwt_bdsav(this) end if ! ! -- If saving cell-by-cell flows in list, write flow - n1u = this%gwtmodel1%dis%get_nodeuser(n1) - n2u = this%gwtmodel2%dis%get_nodeuser(n2) - if (ibinun1 /= 0) & - call this%gwtmodel1%dis%record_mf6_list_entry( & - ibinun1, n1u, n2u, rrate, this%naux, this%auxvar(:, i), & - .false., .false.) - ! - end do - ! - ! -- Print and write budget terms for model 2 - ! - ! -- Set binary unit numbers for saving flows - if (this%ipakcb /= 0) then - ibinun2 = this%gwtmodel2%oc%oc_save_unit('BUDGET') - else - ibinun2 = 0 - end if - ! - ! -- If save budget flag is zero for this stress period, then - ! shut off saving - if (.not. this%gwtmodel2%oc%oc_save('BUDGET')) ibinun2 = 0 - if (isuppress_output /= 0) then - ibinun2 = 0 - end if - ! - ! -- If cell-by-cell flows will be saved as a list, write header. - if (ibinun2 /= 0) then - call this%gwtmodel2%dis%record_srcdst_list_header(budtxt(1), & - this%gwtmodel2%name, & - this%name, & - this%gwtmodel1%name, & - this%name, & - this%naux, this%auxname, & - ibinun2, this%nexg, & - this%gwtmodel2%iout) - end if - ! - ! Initialize accumulators - ratin = DZERO - ratout = DZERO - ! - ! -- Loop through all exchanges - do i = 1, this%nexg - ! - ! -- Assign boundary name - if (this%inamedbound > 0) then - bname = this%boundname(i) - else - bname = '' - end if - ! - ! -- Calculate the flow rate between n1 and n2 - rrate = DZERO - n1 = this%nodem1(i) - n2 = this%nodem2(i) - ! - ! -- If both cells are active then calculate flow rate - if (this%gwtmodel1%ibound(n1) /= 0 .and. & - this%gwtmodel2%ibound(n2) /= 0) then - rrate = this%simvals(i) - ! - ! -- Print the individual rates to model list files if requested - if (this%iprflow /= 0) then - if (this%gwtmodel2%oc%oc_save('BUDGET')) then - ! - ! -- set nodestr and write outputtab table - nodeu = this%gwtmodel2%dis%get_nodeuser(n2) - call this%gwtmodel2%dis%nodeu_to_string(nodeu, nodestr) - call this%outputtab2%print_list_entry(i, trim(adjustl(nodestr)), & - -rrate, bname) - end if - end if - if (rrate < DZERO) then - ratout = ratout - rrate + n1u = this%v_model1%dis_get_nodeuser(n1) + n2u = this%v_model2%dis_get_nodeuser(n2) + if (ibinun /= 0) then + if (is_for_model1) then + call model%dis%record_mf6_list_entry( & + ibinun, n1u, n2u, rrate, this%naux, this%auxvar(:, i), & + .false., .false.) else - ratin = ratin + rrate + call model%dis%record_mf6_list_entry( & + ibinun, n2u, n1u, -rrate, this%naux, this%auxvar(:, i), & + .false., .false.) end if end if ! - ! -- If saving cell-by-cell flows in list, write flow - n1u = this%gwtmodel1%dis%get_nodeuser(n1) - n2u = this%gwtmodel2%dis%get_nodeuser(n2) - if (ibinun2 /= 0) & - call this%gwtmodel2%dis%record_mf6_list_entry( & - ibinun2, n2u, n1u, -rrate, this%naux, this%auxvar(:, i), & - .false., .false.) - ! end do ! - ! -- Set icbcfl, ibudfl to zero so that flows will be printed and - ! saved, if the options were set in the MVT package - icbcfl = 1 - ibudfl = 1 - ! - ! -- Call mvt bd routine - !cdl todo: if(this%inmvt > 0) call this%mvt%mvt_bdsav(icbcfl, ibudfl, isuppress_output) - ! - ! -- Calculate and write simulated values for observations - if (this%inobs /= 0) then - call this%gwt_gwt_save_simvals() - end if - ! - ! -- return + ! -- Return return - end subroutine gwt_gwt_bdsav + end subroutine gwt_gwt_bdsav_model !> @ brief Output !! !! Write output - !! !< subroutine gwt_gwt_ot(this) ! -- modules use SimVariablesModule, only: iout - use ConstantsModule, only: DZERO, LINELENGTH + use ConstantsModule, only: DZERO ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType ! -- local @@ -722,12 +670,12 @@ subroutine gwt_gwt_ot(this) n1 = this%nodem1(iexg) n2 = this%nodem2(iexg) flow = this%simvals(iexg) - call this%gwtmodel1%dis%noder_to_string(n1, node1str) - call this%gwtmodel2%dis%noder_to_string(n2, node2str) + call this%v_model1%dis_noder_to_string(n1, node1str) + call this%v_model2%dis_noder_to_string(n2, node2str) write (iout, fmtdata) trim(adjustl(node1str)), & trim(adjustl(node2str)), & - this%cond(iexg), this%gwtmodel1%x(n1), & - this%gwtmodel2%x(n2), flow + this%cond(iexg), this%v_model1%x%get(n1), & + this%v_model2%x%get(n2), flow end do end if ! @@ -739,214 +687,117 @@ subroutine gwt_gwt_ot(this) ! -- OBS output call this%obs%obs_ot() ! - ! -- return + ! -- Return return end subroutine gwt_gwt_ot - !> @ brief Read options - !! - !! Read the options block + !> @ brief Source options !! + !! Source the options block !< - subroutine read_options(this, iout) + subroutine source_options(this, iout) ! -- modules - use ConstantsModule, only: LINELENGTH, LENAUXNAME, DEM6 - use MemoryManagerModule, only: mem_allocate - use SimModule, only: store_error, store_error_unit + use ConstantsModule, only: LENVARNAME + use InputOutputModule, only: getunit, openfile + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use ExgGwtgwtInputModule, only: ExgGwtgwtParamFoundType + use SourceCommonModule, only: filein_fname ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType integer(I4B), intent(in) :: iout ! -- local - character(len=LINELENGTH) :: keyword - logical :: isfound - logical :: endOfBlock - integer(I4B) :: ierr - ! - ! -- get options block - call this%parser%GetBlock('OPTIONS', isfound, ierr, & - supportOpenClose=.true., blockRequired=.false.) - ! - ! -- parse options block if detected - if (isfound) then - write (iout, '(1x,a)') 'PROCESSING GWT-GWT EXCHANGE OPTIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) then - exit - end if - call this%parser%GetStringCaps(keyword) - - ! first parse option in base - if (this%DisConnExchangeType%parse_option(keyword, iout)) then - cycle - end if - - ! it's probably ours - if (this%parse_option(keyword, iout)) then - cycle - end if - - ! unknown option - errmsg = "Unknown GWT-GWT exchange option '"//trim(keyword)//"'." - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end do - - write (iout, '(1x,a)') 'END OF GWT-GWT EXCHANGE OPTIONS' - end if - ! - ! -- return - return - end subroutine read_options - - !> @brief parse option from exchange file - !< - function parse_option(this, keyword, iout) result(parsed) - use InputOutputModule, only: getunit, openfile - class(GwtExchangeType) :: this !< GwtExchangeType - character(len=LINELENGTH), intent(in) :: keyword !< the option name - integer(I4B), intent(in) :: iout !< for logging - logical(LGP) :: parsed !< true when parsed - ! local - character(len=LINELENGTH) :: fname - integer(I4B) :: inobs, ilen - character(len=LINELENGTH) :: subkey - - parsed = .true. - - select case (keyword) - case ('GWFMODELNAME1') - call this%parser%GetStringCaps(subkey) - ilen = len_trim(subkey) - if (ilen > LENMODELNAME) then - write (errmsg, '(a,a)') & - 'Invalid model name: ', trim(subkey) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end if - if (this%gwfmodelname1 /= '') then - call store_error('GWFMODELNAME1 has already been set to ' & - //trim(this%gwfmodelname1)// & - '. Cannot set more than once.') - call this%parser%StoreErrorUnit() - end if - this%gwfmodelname1 = subkey(1:LENMODELNAME) + type(ExgGwtgwtParamFoundType) :: found + character(len=LENVARNAME), dimension(3) :: adv_scheme = & + &[character(len=LENVARNAME) :: 'UPSTREAM', 'CENTRAL', 'TVD'] + character(len=LINELENGTH) :: mvt_fname + ! + ! -- update defaults with values sourced from input context + call mem_set_value(this%gwfmodelname1, 'GWFMODELNAME1', this%input_mempath, & + found%gwfmodelname1) + call mem_set_value(this%gwfmodelname2, 'GWFMODELNAME2', this%input_mempath, & + found%gwfmodelname2) + call mem_set_value(this%iAdvScheme, 'ADV_SCHEME', this%input_mempath, & + adv_scheme, found%adv_scheme) + call mem_set_value(this%ixt3d, 'DSP_XT3D_OFF', this%input_mempath, & + found%dsp_xt3d_off) + call mem_set_value(this%ixt3d, 'DSP_XT3D_RHS', this%input_mempath, & + found%dsp_xt3d_rhs) + ! + write (iout, '(1x,a)') 'PROCESSING GWT-GWT EXCHANGE OPTIONS' + ! + ! -- source base class options + call this%DisConnExchangeType%source_options(iout) + ! + if (found%gwfmodelname1) then write (iout, '(4x,a,a)') & 'GWFMODELNAME1 IS SET TO: ', trim(this%gwfmodelname1) - case ('GWFMODELNAME2') - call this%parser%GetStringCaps(subkey) - ilen = len_trim(subkey) - if (ilen > LENMODELNAME) then - write (errmsg, '(a,a)') & - 'Invalid model name: ', trim(subkey) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end if - if (this%gwfmodelname2 /= '') then - call store_error('GWFMODELNAME2 has already been set to ' & - //trim(this%gwfmodelname2)// & - '. Cannot set more than once.') - call this%parser%StoreErrorUnit() - end if - this%gwfmodelname2 = subkey(1:LENMODELNAME) + end if + ! + if (found%gwfmodelname2) then write (iout, '(4x,a,a)') & 'GWFMODELNAME2 IS SET TO: ', trim(this%gwfmodelname2) - case ('PRINT_FLOWS') - this%iprflow = 1 - write (iout, '(4x,a)') & - 'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.' - case ('SAVE_FLOWS') - this%ipakcb = -1 - write (iout, '(4x,a)') & - 'EXCHANGE FLOWS WILL BE SAVED TO BINARY BUDGET FILES.' - case ('MVT6') - call this%parser%GetStringCaps(subkey) - if (subkey /= 'FILEIN') then - call store_error('MVT6 keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - if (fname == '') then - call store_error('No MVT6 file specified.') - call this%parser%StoreErrorUnit() - end if - this%inmvt = getunit() - call openfile(this%inmvt, iout, fname, 'MVT') - write (iout, '(4x,a)') & - 'WATER MOVER TRANSPORT INFORMATION WILL BE READ FROM ', trim(fname) - case ('OBS6') - call this%parser%GetStringCaps(subkey) - if (subkey /= 'FILEIN') then - call store_error('OBS8 keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - this%obs%active = .true. - call this%parser%GetString(this%obs%inputFilename) - inobs = GetUnit() - call openfile(inobs, iout, this%obs%inputFilename, 'OBS') - this%obs%inUnitObs = inobs - case ('ADV_SCHEME') - call this%parser%GetStringCaps(subkey) - select case (subkey) - case ('UPSTREAM') - this%iAdvScheme = 0 - case ('CENTRAL') - this%iAdvScheme = 1 - case ('TVD') - this%iAdvScheme = 2 - case default - errmsg = "Unknown weighting method for advection: '"//trim(subkey)//"'." - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select + end if + ! + if (found%adv_scheme) then + ! -- count from 0 + this%iAdvScheme = this%iAdvScheme - 1 write (iout, '(4x,a,a)') & - 'CELL AVERAGING METHOD HAS BEEN SET TO: ', trim(subkey) - case ('DSP_XT3D_OFF') + 'ADVECTION SCHEME METHOD HAS BEEN SET TO: ', & + trim(adv_scheme(this%iAdvScheme + 1)) + end if + ! + if (found%dsp_xt3d_off .and. found%dsp_xt3d_rhs) then + errmsg = 'DSP_XT3D_OFF and DSP_XT3D_RHS cannot both be set as options.' + call store_error(errmsg) + call store_error_filename(this%filename) + else if (found%dsp_xt3d_off) then this%ixt3d = 0 write (iout, '(4x,a)') 'XT3D FORMULATION HAS BEEN SHUT OFF.' - case ('DSP_XT3D_RHS') + else if (found%dsp_xt3d_rhs) then this%ixt3d = 2 write (iout, '(4x,a)') 'XT3D RIGHT-HAND SIDE FORMULATION IS SELECTED.' - case ('ADVSCHEME') - errmsg = 'ADVSCHEME is no longer a valid keyword. Use ADV_SCHEME & - &instead.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() - case ('XT3D_OFF') - errmsg = 'XT3D_OFF is no longer a valid keyword. Use DSP_XT3D_OFF & - &instead.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() - case ('XT3D_RHS') - errmsg = 'XT3D_RHS is no longer a valid keyword. Use DSP_XT3D_RHS & - &instead.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() - case default - parsed = .false. - end select - - end function parse_option + end if + ! + ! -- enforce 0 or 1 MVR6_FILENAME entries in option block + if (filein_fname(mvt_fname, 'MVT6_FILENAME', this%input_mempath, & + this%filename)) then + this%inmvt = getunit() + call openfile(this%inmvt, iout, mvt_fname, 'MVT') + write (iout, '(4x,a)') & + 'WATER MOVER TRANSPORT INFORMATION WILL BE READ FROM ', trim(mvt_fname) + end if + ! + ! -- enforce 0 or 1 OBS6_FILENAME entries in option block + if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', & + this%input_mempath, this%filename)) then + this%obs%active = .true. + this%obs%inUnitObs = GetUnit() + call openfile(this%obs%inUnitObs, iout, this%obs%inputFilename, 'OBS') + end if + ! + write (iout, '(1x,a)') 'END OF GWT-GWT EXCHANGE OPTIONS' + ! + ! -- return + return + end subroutine source_options !> @ brief Read mover !! !! Read and process movers - !! !< subroutine read_mvt(this, iout) ! -- modules - use GwtMvtModule, only: mvt_cr + use TspMvtModule, only: mvt_cr ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType integer(I4B), intent(in) :: iout - ! -- local ! ! -- Create and initialize the mover object Here, fmi is set to the one ! for gwtmodel1 so that a call to save flows has an associated dis ! object. call mvt_cr(this%mvt, this%name, this%inmvt, iout, this%gwtmodel1%fmi, & + this%gwtmodel1%eqnsclfac, & gwfmodelname1=this%gwfmodelname1, & gwfmodelname2=this%gwfmodelname2, & fmi2=this%gwtmodel2%fmi) @@ -958,7 +809,6 @@ end subroutine read_mvt !> @ brief Allocate scalars !! !! Allocate scalar variables - !! !< subroutine allocate_scalars(this) ! -- modules @@ -966,40 +816,32 @@ subroutine allocate_scalars(this) use ConstantsModule, only: DZERO ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType - ! -- local ! call this%DisConnExchangeType%allocate_scalars() ! call mem_allocate(this%inewton, 'INEWTON', this%memoryPath) - call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath) - call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath) call mem_allocate(this%inobs, 'INOBS', this%memoryPath) call mem_allocate(this%iAdvScheme, 'IADVSCHEME', this%memoryPath) this%inewton = 0 - this%iprpak = 0 - this%iprflow = 0 - this%ipakcb = 0 this%inobs = 0 this%iAdvScheme = 0 ! call mem_allocate(this%inmvt, 'INMVT', this%memoryPath) this%inmvt = 0 ! - ! -- return + ! -- Return return end subroutine allocate_scalars !> @ brief Deallocate !! !! Deallocate memory associated with this object - !! !< subroutine gwt_gwt_da(this) ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType - ! -- local ! ! -- objects if (this%inmvt > 0) then @@ -1029,8 +871,6 @@ subroutine gwt_gwt_da(this) ! -- scalars deallocate (this%filename) call mem_deallocate(this%inewton) - call mem_deallocate(this%iprflow) - call mem_deallocate(this%ipakcb) call mem_deallocate(this%inobs) call mem_deallocate(this%iAdvScheme) call mem_deallocate(this%inmvt) @@ -1038,14 +878,13 @@ subroutine gwt_gwt_da(this) ! -- deallocate base call this%DisConnExchangeType%disconnex_da() ! - ! -- return + ! -- Return return end subroutine gwt_gwt_da !> @ brief Allocate arrays !! !! Allocate arrays - !! !< subroutine allocate_arrays(this) ! -- modules @@ -1077,43 +916,46 @@ subroutine allocate_arrays(this) ! ! -- initialize the output table objects ! outouttab1 - call table_cr(this%outputtab1, this%name, ' ') - call this%outputtab1%table_df(this%nexg, ntabcol, this%gwtmodel1%iout, & - transient=.TRUE.) - text = 'NUMBER' - call this%outputtab1%initialize_column(text, 10, alignment=TABCENTER) - text = 'CELLID' - call this%outputtab1%initialize_column(text, 20, alignment=TABLEFT) - text = 'RATE' - call this%outputtab1%initialize_column(text, 15, alignment=TABCENTER) - if (this%inamedbound > 0) then - text = 'NAME' + if (this%v_model1%is_local) then + call table_cr(this%outputtab1, this%name, ' ') + call this%outputtab1%table_df(this%nexg, ntabcol, this%gwtmodel1%iout, & + transient=.TRUE.) + text = 'NUMBER' + call this%outputtab1%initialize_column(text, 10, alignment=TABCENTER) + text = 'CELLID' call this%outputtab1%initialize_column(text, 20, alignment=TABLEFT) + text = 'RATE' + call this%outputtab1%initialize_column(text, 15, alignment=TABCENTER) + if (this%inamedbound > 0) then + text = 'NAME' + call this%outputtab1%initialize_column(text, 20, alignment=TABLEFT) + end if end if ! outouttab2 - call table_cr(this%outputtab2, this%name, ' ') - call this%outputtab2%table_df(this%nexg, ntabcol, this%gwtmodel2%iout, & - transient=.TRUE.) - text = 'NUMBER' - call this%outputtab2%initialize_column(text, 10, alignment=TABCENTER) - text = 'CELLID' - call this%outputtab2%initialize_column(text, 20, alignment=TABLEFT) - text = 'RATE' - call this%outputtab2%initialize_column(text, 15, alignment=TABCENTER) - if (this%inamedbound > 0) then - text = 'NAME' + if (this%v_model2%is_local) then + call table_cr(this%outputtab2, this%name, ' ') + call this%outputtab2%table_df(this%nexg, ntabcol, this%gwtmodel2%iout, & + transient=.TRUE.) + text = 'NUMBER' + call this%outputtab2%initialize_column(text, 10, alignment=TABCENTER) + text = 'CELLID' call this%outputtab2%initialize_column(text, 20, alignment=TABLEFT) + text = 'RATE' + call this%outputtab2%initialize_column(text, 15, alignment=TABCENTER) + if (this%inamedbound > 0) then + text = 'NAME' + call this%outputtab2%initialize_column(text, 20, alignment=TABLEFT) + end if end if end if ! - ! -- return + ! -- Return return end subroutine allocate_arrays !> @ brief Define observations !! !! Define the observations associated with this object - !! !< subroutine gwt_gwt_df_obs(this) ! -- dummy @@ -1126,14 +968,13 @@ subroutine gwt_gwt_df_obs(this) call this%obs%StoreObsType('flow-ja-face', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => gwt_gwt_process_obsID ! - ! -- return + ! -- Return return end subroutine gwt_gwt_df_obs !> @ brief Read and prepare observations !! !! Handle observation exchanges exchange-boundary names. - !! !< subroutine gwt_gwt_rp_obs(this) ! -- modules @@ -1198,7 +1039,7 @@ subroutine gwt_gwt_rp_obs(this) ! ! -- write summary of error messages if (count_errors() > 0) then - call store_error_unit(this%inobs) + call store_error_filename(this%obs%inputFilename) end if ! ! -- Return @@ -1208,24 +1049,27 @@ end subroutine gwt_gwt_rp_obs !> @ brief Final processing !! !! Conduct any final processing - !! !< subroutine gwt_gwt_fp(this) ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType ! + ! -- Return return end subroutine gwt_gwt_fp - !> @brief Return true when this exchange provides matrix - !! coefficients for solving @param model + !> @brief Return true when this exchange provides matrix coefficients for + !! solving @param model !< function gwt_gwt_connects_model(this, model) result(is_connected) + ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType class(BaseModelType), pointer, intent(in) :: model !< the model to which the exchange might hold a connection + ! -- return logical(LGP) :: is_connected !< true, when connected - + ! is_connected = .false. + ! ! only connected when model is GwtModelType of course select type (model) class is (GwtModelType) @@ -1235,7 +1079,9 @@ function gwt_gwt_connects_model(this, model) result(is_connected) is_connected = .true. end if end select - + ! + ! -- Return + return end function gwt_gwt_connects_model !> @brief Should interface model be used for this exchange @@ -1247,23 +1093,25 @@ end function gwt_gwt_connects_model !! set the return accordingly. !< function use_interface_model(this) result(use_im) + ! -- dummy class(GwtExchangeType) :: this !< GwtExchangeType + ! -- return logical(LGP) :: use_im !< true when interface model should be used - + ! ! For now set use_im to .true. since the interface model approach ! must currently be used for any GWT-GWT exchange. use_im = .true. - + ! + ! -- Return + return end function !> @ brief Save simulated flow observations !! !! Save the simulated flows for each exchange - !! !< subroutine gwt_gwt_save_simvals(this) ! -- dummy - use SimModule, only: store_error, store_error_unit use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO use ObserveModule, only: ObserveType @@ -1294,20 +1142,20 @@ subroutine gwt_gwt_save_simvals(this) errmsg = 'Unrecognized observation type: '// & trim(obsrv%ObsTypeId) call store_error(errmsg) - call store_error_unit(this%inobs) + call store_error_filename(this%obs%inputFilename) end select call this%obs%SaveOneSimval(obsrv, v) end do end do end if ! + ! -- Return return end subroutine gwt_gwt_save_simvals !> @ brief Obs ID processer !! !! Process observations for this exchange - !! !< subroutine gwt_gwt_process_obsID(obsrv, dis, inunitobs, iout) ! -- modules @@ -1343,17 +1191,19 @@ subroutine gwt_gwt_process_obsID(obsrv, dis, inunitobs, iout) obsrv%intPak1 = NAMEDBOUNDFLAG end if ! + ! -- Return return end subroutine gwt_gwt_process_obsID !> @ brief Cast polymorphic object as exchange !! !! Cast polymorphic object as exchange - !! !< function CastAsGwtExchange(obj) result(res) implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return class(GwtExchangeType), pointer :: res ! res => null() @@ -1363,19 +1213,21 @@ function CastAsGwtExchange(obj) result(res) class is (GwtExchangeType) res => obj end select + ! + ! -- Return return end function CastAsGwtExchange !> @ brief Get exchange from list !! !! Return an exchange from the list for specified index - !! !< function GetGwtExchangeFromList(list, idx) result(res) implicit none ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx + ! -- return class(GwtExchangeType), pointer :: res ! -- local class(*), pointer :: obj @@ -1383,6 +1235,7 @@ function GetGwtExchangeFromList(list, idx) result(res) obj => list%GetItem(idx) res => CastAsGwtExchange(obj) ! + ! -- Return return end function GetGwtExchangeFromList diff --git a/src/Exchange/NumericalExchange.f90 b/src/Exchange/NumericalExchange.f90 index 0d40eac262d..f2765dadec7 100644 --- a/src/Exchange/NumericalExchange.f90 +++ b/src/Exchange/NumericalExchange.f90 @@ -15,7 +15,9 @@ module NumericalExchangeModule type, extends(BaseExchangeType) :: NumericalExchangeType character(len=7) :: typename !< name of the type (e.g., 'GWF-GWF') + contains + procedure :: exg_df procedure :: exg_ac procedure :: exg_mc @@ -34,155 +36,104 @@ module NumericalExchangeModule contains + !> @brief Define the exchange + !< subroutine exg_df(this) -! ****************************************************************************** -! exg_df -- define the exchange -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BaseModelModule, only: BaseModelType use InputOutputModule, only: getunit, openfile ! -- dummy class(NumericalExchangeType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_df + !> @brief If an implicit exchange then add connections to sparse + !< subroutine exg_ac(this, sparse) -! ****************************************************************************** -! exg_ac -- If an implicit exchange then add connections to sparse -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix ! -- dummy class(NumericalExchangeType) :: this type(sparsematrix), intent(inout) :: sparse - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_ac + !> @brief Map the connections in the global matrix + !< subroutine exg_mc(this, matrix_sln) -! ****************************************************************************** -! exg_mc -- Map the connections in the global matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use SparseModule, only: sparsematrix ! -- dummy class(NumericalExchangeType) :: this class(MatrixBaseType), pointer :: matrix_sln - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return end subroutine exg_mc + !> @brief Allocate and read + !< subroutine exg_ar(this) -! ****************************************************************************** -! exg_ar -- Allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! class(NumericalExchangeType) :: this -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_ar + !> @brief Advance + !< subroutine exg_ad(this) -! ****************************************************************************** -! exg_ad -- Advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(NumericalExchangeType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_ad + !> @brief Calculate conductance, and for explicit exchanges, set the + !! conductance in the boundary package + !< subroutine exg_cf(this, kiter) -! ****************************************************************************** -! exg_cf -- Calculate conductance, and for explicit exchanges, set the -! conductance in the boundary package. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(NumericalExchangeType) :: this integer(I4B), intent(in) :: kiter - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_cf + !> @brief Fill the matrix + !< subroutine exg_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) -! ****************************************************************************** -! exg_fc -- Fill the matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(NumericalExchangeType) :: this integer(I4B), intent(in) :: kiter class(MatrixBaseType), pointer :: matrix_sln real(DP), dimension(:), intent(inout) :: rhs_sln integer(I4B), optional, intent(in) :: inwtflag - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_fc + !> @brief Additional convergence check + !< subroutine exg_cc(this, icnvg) -! ****************************************************************************** -! exg_cc -- Additional convergence check -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(NumericalExchangeType) :: this integer(I4B), intent(inout) :: icnvg - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_cc + !> @brief Calculate flow + !< subroutine exg_cq(this, icnvg, isuppress_output, isolnid) -! ****************************************************************************** -! exg_cq -- Calculate flow -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -190,20 +141,14 @@ subroutine exg_cq(this, icnvg, isuppress_output, isolnid) integer(I4B), intent(inout) :: icnvg integer(I4B), intent(in) :: isuppress_output integer(I4B), intent(in) :: isolnid - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_cq + !> @brief Exchange budget + !< subroutine exg_bd(this, icnvg, isuppress_output, isolnid) -! ****************************************************************************** -! exg_bd -- Exchange budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -211,56 +156,50 @@ subroutine exg_bd(this, icnvg, isuppress_output, isolnid) integer(I4B), intent(inout) :: icnvg integer(I4B), intent(in) :: isuppress_output integer(I4B), intent(in) :: isolnid - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_bd + !> @brief Output + !< subroutine exg_ot(this) -! ****************************************************************************** -! exg_ot -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(NumericalExchangeType) :: this -! ------------------------------------------------------------------------------ ! - ! -- return + ! -- Return return end subroutine exg_ot + !> @brief Deallocate memory + !< subroutine exg_da(this) -! ****************************************************************************** -! exg_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(NumericalExchangeType) :: this - ! -- local -! ------------------ - + ! + ! -- Return return end subroutine exg_da function get_iasym(this) result(iasym) + ! -- dummy class(NumericalExchangeType) :: this + ! -- return integer(I4B) :: iasym - + ! iasym = 0 - + ! + ! -- Return + return end function get_iasym function CastAsNumericalExchangeClass(obj) result(res) implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return class(NumericalExchangeType), pointer :: res ! res => null() @@ -270,9 +209,13 @@ function CastAsNumericalExchangeClass(obj) result(res) class is (NumericalExchangeType) res => obj end select + ! + ! -- Return return end function CastAsNumericalExchangeClass + !> @brief Add numerical exchange to a list + !< subroutine AddNumericalExchangeToList(list, exchange) implicit none ! -- dummy @@ -284,9 +227,12 @@ subroutine AddNumericalExchangeToList(list, exchange) obj => exchange call list%Add(obj) ! + ! -- Return return end subroutine AddNumericalExchangeToList + !> @brief Retrieve a specific numerical exchange from a list + !< function GetNumericalExchangeFromList(list, idx) result(res) implicit none ! -- dummy @@ -299,6 +245,7 @@ function GetNumericalExchangeFromList(list, idx) result(res) obj => list%GetItem(idx) res => CastAsNumericalExchangeClass(obj) ! + ! -- Return return end function GetNumericalExchangeFromList diff --git a/src/Exchange/gwfgwfidm.f90 b/src/Exchange/gwfgwfidm.f90 new file mode 100644 index 00000000000..888f6422cb1 --- /dev/null +++ b/src/Exchange/gwfgwfidm.f90 @@ -0,0 +1,658 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module ExgGwfgwfInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public exg_gwfgwf_param_definitions + public exg_gwfgwf_aggregate_definitions + public exg_gwfgwf_block_definitions + public ExgGwfgwfParamFoundType + public exg_gwfgwf_multi_package + + type ExgGwfgwfParamFoundType + logical :: auxiliary = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: cell_averaging = .false. + logical :: cvoptions = .false. + logical :: variablecv = .false. + logical :: dewatered = .false. + logical :: newton = .false. + logical :: xt3d = .false. + logical :: gnc_filerecord = .false. + logical :: filein = .false. + logical :: gnc6 = .false. + logical :: gnc6_filename = .false. + logical :: mvr_filerecord = .false. + logical :: mvr6 = .false. + logical :: mvr6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: dev_ifmod_on = .false. + logical :: nexg = .false. + logical :: cellidm1 = .false. + logical :: cellidm2 = .false. + logical :: ihc = .false. + logical :: cl1 = .false. + logical :: cl2 = .false. + logical :: hwva = .false. + logical :: aux = .false. + logical :: boundname = .false. + end type ExgGwfgwfParamFoundType + + logical :: exg_gwfgwf_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_auxiliary = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_boundnames = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_iprpak = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_iprflow = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_ipakcb = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cell_averaging = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'CELL_AVERAGING', & ! tag name + 'CELL_AVERAGING', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cvoptions = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'CVOPTIONS', & ! tag name + 'CVOPTIONS', & ! fortran variable + 'RECORD VARIABLECV DEWATERED', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_variablecv = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'VARIABLECV', & ! tag name + 'VARIABLECV', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_dewatered = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'DEWATERED', & ! tag name + 'DEWATERED', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_newton = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'NEWTON', & ! tag name + 'NEWTON', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_xt3d = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'XT3D', & ! tag name + 'XT3D', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_gnc_filerecord = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'GNC_FILERECORD', & ! tag name + 'GNC_FILERECORD', & ! fortran variable + 'RECORD GNC6 FILEIN GNC6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_filein = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_gnc6 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'GNC6', & ! tag name + 'GNC6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_gnc6_filename = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'GNC6_FILENAME', & ! tag name + 'GNC6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_mvr_filerecord = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'MVR_FILERECORD', & ! tag name + 'MVR_FILERECORD', & ! fortran variable + 'RECORD MVR6 FILEIN MVR6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_mvr6 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'MVR6', & ! tag name + 'MVR6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_mvr6_filename = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'MVR6_FILENAME', & ! tag name + 'MVR6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_obs_filerecord = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_obs6 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_obs6_filename = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_dev_ifmod_on = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'OPTIONS', & ! block + 'DEV_INTERFACEMODEL_ON', & ! tag name + 'DEV_IFMOD_ON', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_nexg = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'DIMENSIONS', & ! block + 'NEXG', & ! tag name + 'NEXG', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cellidm1 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CELLIDM1', & ! tag name + 'CELLIDM1', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cellidm2 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CELLIDM2', & ! tag name + 'CELLIDM2', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_ihc = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'IHC', & ! tag name + 'IHC', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cl1 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CL1', & ! tag name + 'CL1', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_cl2 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CL2', & ! tag name + 'CL2', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_hwva = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'HWVA', & ! tag name + 'HWVA', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_aux = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'AUX', & ! tag name + 'AUX', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_boundname = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exg_gwfgwf_param_definitions(*) = & + [ & + exggwfgwf_auxiliary, & + exggwfgwf_boundnames, & + exggwfgwf_iprpak, & + exggwfgwf_iprflow, & + exggwfgwf_ipakcb, & + exggwfgwf_cell_averaging, & + exggwfgwf_cvoptions, & + exggwfgwf_variablecv, & + exggwfgwf_dewatered, & + exggwfgwf_newton, & + exggwfgwf_xt3d, & + exggwfgwf_gnc_filerecord, & + exggwfgwf_filein, & + exggwfgwf_gnc6, & + exggwfgwf_gnc6_filename, & + exggwfgwf_mvr_filerecord, & + exggwfgwf_mvr6, & + exggwfgwf_mvr6_filename, & + exggwfgwf_obs_filerecord, & + exggwfgwf_obs6, & + exggwfgwf_obs6_filename, & + exggwfgwf_dev_ifmod_on, & + exggwfgwf_nexg, & + exggwfgwf_cellidm1, & + exggwfgwf_cellidm2, & + exggwfgwf_ihc, & + exggwfgwf_cl1, & + exggwfgwf_cl2, & + exggwfgwf_hwva, & + exggwfgwf_aux, & + exggwfgwf_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + exggwfgwf_exchangedata = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWFGWF', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'EXCHANGEDATA', & ! tag name + 'EXCHANGEDATA', & ! fortran variable + 'RECARRAY CELLIDM1 CELLIDM2 IHC CL1 CL2 HWVA AUX BOUNDNAME', & ! type + 'NEXG', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exg_gwfgwf_aggregate_definitions(*) = & + [ & + exggwfgwf_exchangedata & + ] + + type(InputBlockDefinitionType), parameter :: & + exg_gwfgwf_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'EXCHANGEDATA', & ! blockname + .true., & ! required + .true., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module ExgGwfgwfInputModule diff --git a/src/Exchange/gwfgwtidm.f90 b/src/Exchange/gwfgwtidm.f90 new file mode 100644 index 00000000000..30374514be3 --- /dev/null +++ b/src/Exchange/gwfgwtidm.f90 @@ -0,0 +1,70 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module ExgGwfgwtInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public exg_gwfgwt_param_definitions + public exg_gwfgwt_aggregate_definitions + public exg_gwfgwt_block_definitions + public ExgGwfgwtParamFoundType + public exg_gwfgwt_multi_package + + type ExgGwfgwtParamFoundType + end type ExgGwfgwtParamFoundType + + logical :: exg_gwfgwt_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + exg_gwfgwt_param_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputParamDefinitionType), parameter :: & + exg_gwfgwt_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + exg_gwfgwt_block_definitions(*) = & + [ & + InputBlockDefinitionType & + ( & + '', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_varaible + ) & + ] + +end module ExgGwfgwtInputModule diff --git a/src/Exchange/gwtgwtidm.f90 b/src/Exchange/gwtgwtidm.f90 new file mode 100644 index 00000000000..dba0074ce73 --- /dev/null +++ b/src/Exchange/gwtgwtidm.f90 @@ -0,0 +1,582 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module ExgGwtgwtInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public exg_gwtgwt_param_definitions + public exg_gwtgwt_aggregate_definitions + public exg_gwtgwt_block_definitions + public ExgGwtgwtParamFoundType + public exg_gwtgwt_multi_package + + type ExgGwtgwtParamFoundType + logical :: gwfmodelname1 = .false. + logical :: gwfmodelname2 = .false. + logical :: auxiliary = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: adv_scheme = .false. + logical :: dsp_xt3d_off = .false. + logical :: dsp_xt3d_rhs = .false. + logical :: filein = .false. + logical :: mvt_filerecord = .false. + logical :: mvt6 = .false. + logical :: mvt6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: dev_ifmod_on = .false. + logical :: nexg = .false. + logical :: cellidm1 = .false. + logical :: cellidm2 = .false. + logical :: ihc = .false. + logical :: cl1 = .false. + logical :: cl2 = .false. + logical :: hwva = .false. + logical :: aux = .false. + logical :: boundname = .false. + end type ExgGwtgwtParamFoundType + + logical :: exg_gwtgwt_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_gwfmodelname1 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'GWFMODELNAME1', & ! tag name + 'GWFMODELNAME1', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_gwfmodelname2 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'GWFMODELNAME2', & ! tag name + 'GWFMODELNAME2', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_auxiliary = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_boundnames = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_iprpak = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_iprflow = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_ipakcb = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_adv_scheme = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'ADV_SCHEME', & ! tag name + 'ADV_SCHEME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_dsp_xt3d_off = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'DSP_XT3D_OFF', & ! tag name + 'DSP_XT3D_OFF', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_dsp_xt3d_rhs = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'DSP_XT3D_RHS', & ! tag name + 'DSP_XT3D_RHS', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_filein = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_mvt_filerecord = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'MVT_FILERECORD', & ! tag name + 'MVT_FILERECORD', & ! fortran variable + 'RECORD MVT6 FILEIN MVT6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_mvt6 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'MVT6', & ! tag name + 'MVT6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_mvt6_filename = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'MVT6_FILENAME', & ! tag name + 'MVT6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_obs_filerecord = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_obs6 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_obs6_filename = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_dev_ifmod_on = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'OPTIONS', & ! block + 'DEV_INTERFACEMODEL_ON', & ! tag name + 'DEV_IFMOD_ON', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_nexg = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'DIMENSIONS', & ! block + 'NEXG', & ! tag name + 'NEXG', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_cellidm1 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CELLIDM1', & ! tag name + 'CELLIDM1', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_cellidm2 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CELLIDM2', & ! tag name + 'CELLIDM2', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_ihc = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'IHC', & ! tag name + 'IHC', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_cl1 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CL1', & ! tag name + 'CL1', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_cl2 = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'CL2', & ! tag name + 'CL2', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_hwva = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'HWVA', & ! tag name + 'HWVA', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_aux = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'AUX', & ! tag name + 'AUX', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_boundname = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exg_gwtgwt_param_definitions(*) = & + [ & + exggwtgwt_gwfmodelname1, & + exggwtgwt_gwfmodelname2, & + exggwtgwt_auxiliary, & + exggwtgwt_boundnames, & + exggwtgwt_iprpak, & + exggwtgwt_iprflow, & + exggwtgwt_ipakcb, & + exggwtgwt_adv_scheme, & + exggwtgwt_dsp_xt3d_off, & + exggwtgwt_dsp_xt3d_rhs, & + exggwtgwt_filein, & + exggwtgwt_mvt_filerecord, & + exggwtgwt_mvt6, & + exggwtgwt_mvt6_filename, & + exggwtgwt_obs_filerecord, & + exggwtgwt_obs6, & + exggwtgwt_obs6_filename, & + exggwtgwt_dev_ifmod_on, & + exggwtgwt_nexg, & + exggwtgwt_cellidm1, & + exggwtgwt_cellidm2, & + exggwtgwt_ihc, & + exggwtgwt_cl1, & + exggwtgwt_cl2, & + exggwtgwt_hwva, & + exggwtgwt_aux, & + exggwtgwt_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + exggwtgwt_exchangedata = InputParamDefinitionType & + ( & + 'EXG', & ! component + 'GWTGWT', & ! subcomponent + 'EXCHANGEDATA', & ! block + 'EXCHANGEDATA', & ! tag name + 'EXCHANGEDATA', & ! fortran variable + 'RECARRAY CELLIDM1 CELLIDM2 IHC CL1 CL2 HWVA AUX BOUNDNAME', & ! type + 'NEXG', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + exg_gwtgwt_aggregate_definitions(*) = & + [ & + exggwtgwt_exchangedata & + ] + + type(InputBlockDefinitionType), parameter :: & + exg_gwtgwt_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'EXCHANGEDATA', & ! blockname + .true., & ! required + .true., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module ExgGwtgwtInputModule diff --git a/src/Model/BaseModel.f90 b/src/Model/BaseModel.f90 index 29a71992fd2..d33b2541b8f 100644 --- a/src/Model/BaseModel.f90 +++ b/src/Model/BaseModel.f90 @@ -1,5 +1,3 @@ -!Highest level model class. All models inherit from this parent class. - module BaseModelModule use KindModule, only: DP, I4B @@ -11,9 +9,9 @@ module BaseModelModule public :: BaseModelType, CastAsBaseModelClass, AddBaseModelToList, & GetBaseModelFromList + !> @brief Highest level model type. All models extend this parent type. type :: BaseModelType character(len=LENMEMPATH) :: memoryPath !< the location in the memory manager where the variables are stored - character(len=LENMODELNAME), pointer :: name => null() !< name of the model character(len=3), pointer :: macronym => null() !< 3 letter model acronym (GWF, GWT, ...) integer(I4B), pointer :: idsoln => null() !< id of the solution model is in @@ -37,90 +35,45 @@ module BaseModelModule contains + !> @brief Define the model + !< subroutine model_df(this) -! ****************************************************************************** -! modeldf -- Define the model -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_df + !> @brief Allocate and read + !< subroutine model_ar(this) -! ****************************************************************************** -! modelar -- Allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_ar + !> @brief Read and prepare + !< subroutine model_rp(this) -! ****************************************************************************** -! model_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_rp + !> @brief Calculate time step length + !< subroutine model_calculate_delt(this) -! ****************************************************************************** -! model_calculate_delt -- Calculate time step length -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_calculate_delt + !> @brief Output results + !< subroutine model_ot(this) -! ****************************************************************************** -! model_ot -- output results -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_ot + !> @brief Write line to model iout + !< subroutine model_message(this, line, fmt) -! ****************************************************************************** -! model_message -- write line to model iout -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(BaseModelType) :: this character(len=*), intent(in) :: line character(len=*), intent(in), optional :: fmt ! -- local character(len=LINELENGTH) :: cfmt -! ------------------------------------------------------------------------------ ! ! -- process optional variables if (present(fmt)) then @@ -131,38 +84,22 @@ subroutine model_message(this, line, fmt) ! ! -- write line write (this%iout, trim(cfmt)) trim(line) - ! - ! -- return - return end subroutine model_message + !> @brief Final processing + !< subroutine model_fp(this) -! ****************************************************************************** -! model_fp -- Final processing -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(BaseModelType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- return - return end subroutine model_fp + !> @brief Allocate scalar variables + !< subroutine allocate_scalars(this, modelname) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(BaseModelType) :: this character(len=*), intent(in) :: modelname -! ------------------------------------------------------------------------------ ! call mem_allocate(this%name, LENMODELNAME, 'NAME', this%memoryPath) call mem_allocate(this%macronym, 3, 'MACRONYM', this%memoryPath) @@ -183,23 +120,15 @@ subroutine allocate_scalars(this, modelname) this%iprflow = 0 this%ipakcb = 0 this%inewton = 0 !default is standard formulation - ! - ! -- return - return end subroutine allocate_scalars + !> @brief Deallocate + !< subroutine model_da(this) -! ****************************************************************************** -! deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(BaseModelType) :: this -! ------------------------------------------------------------------------------ ! ! -- Strings call mem_deallocate(this%name, 'NAME', this%memoryPath) @@ -213,13 +142,9 @@ subroutine model_da(this) call mem_deallocate(this%iprflow) call mem_deallocate(this%ipakcb) call mem_deallocate(this%idsoln) - ! - ! -- return - return end subroutine model_da function CastAsBaseModelClass(obj) result(res) - implicit none class(*), pointer, intent(inout) :: obj class(BaseModelType), pointer :: res ! @@ -230,11 +155,9 @@ function CastAsBaseModelClass(obj) result(res) class is (BaseModelType) res => obj end select - return end function CastAsBaseModelClass subroutine AddBaseModelToList(list, model) - implicit none ! -- dummy type(ListType), intent(inout) :: list class(BaseModelType), pointer, intent(inout) :: model @@ -243,12 +166,9 @@ subroutine AddBaseModelToList(list, model) ! obj => model call list%Add(obj) - ! - return end subroutine AddBaseModelToList function GetBaseModelFromList(list, idx) result(res) - implicit none ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx @@ -258,8 +178,6 @@ function GetBaseModelFromList(list, idx) result(res) ! obj => list%GetItem(idx) res => CastAsBaseModelClass(obj) - ! - return end function GetBaseModelFromList end module BaseModelModule diff --git a/src/Model/Connection/ConnectionBuilder.f90 b/src/Model/Connection/ConnectionBuilder.f90 index 4cf244cc59b..c7b6d28b8d6 100644 --- a/src/Model/Connection/ConnectionBuilder.f90 +++ b/src/Model/Connection/ConnectionBuilder.f90 @@ -2,7 +2,7 @@ module ConnectionBuilderModule use KindModule, only: I4B, LGP use SimModule, only: store_error, count_errors, ustop use SimVariablesModule, only: iout - use ListModule, only: ListType, arePointersEqual, isEqualIface, ListNodeType + use ListModule, only: ListType, isEqualIface, ListNodeType use BaseSolutionModule, only: BaseSolutionType use NumericalSolutionModule, only: NumericalSolutionType use BaseExchangeModule, only: BaseExchangeType, GetBaseExchangeFromList @@ -18,6 +18,7 @@ module ConnectionBuilderModule private type, public :: ConnectionBuilderType + logical(LGP) :: dev_always_ifmod = .false. !< development option: force interface model on all exchanges contains procedure, pass(this) :: processSolution procedure, private, pass(this) :: processExchanges @@ -78,7 +79,6 @@ end subroutine processSolution !< subroutine processExchanges(this, exchanges, newConnections) use ListsModule, only: baseconnectionlist, baseexchangelist - use VersionModule, only: IDEVELOPMODE class(ConnectionBuilderType) :: this !< the connection builder object type(ListType), pointer, intent(in) :: exchanges !< the list of exchanges to process type(ListType), intent(inout) :: newConnections !< the newly created connections @@ -88,32 +88,18 @@ subroutine processExchanges(this, exchanges, newConnections) integer(I4B) :: iex, ibasex class(SpatialModelConnectionType), pointer :: modelConnection logical(LGP) :: isPeriodic - integer(I4B) :: status - logical(LGP) :: dev_always_ifmod - character(len=16) :: envvar - - ! Force use of the interface model - dev_always_ifmod = .false. - if (IDEVELOPMODE == 1) then - call get_environment_variable('DEV_ALWAYS_USE_IFMOD', & - value=envvar, status=status) - if (status == 0 .and. envvar == '1') then - dev_always_ifmod = .true. - write (*, '(a,/)') "### Experimental: forcing interface model ###" - end if - end if do iex = 1, exchanges%Count() conEx => GetDisConnExchangeFromList(exchanges, iex) if (.not. associated(conEx)) then ! if it is not DisConnExchangeType, we can skip it - continue + cycle end if ! for now, if we have XT3D on the interface, we use a connection, ! (this will be more generic in the future) if (conEx%use_interface_model() .or. conEx%dev_ifmod_on & - .or. dev_always_ifmod) then + .or. this%dev_always_ifmod) then ! we should not get period connections here isPeriodic = (conEx%v_model1 == conEx%v_model2) diff --git a/src/Model/Connection/GridConnection.f90 b/src/Model/Connection/GridConnection.f90 index 4530aee1df5..03a61f5ae3d 100644 --- a/src/Model/Connection/GridConnection.f90 +++ b/src/Model/Connection/GridConnection.f90 @@ -9,7 +9,7 @@ module GridConnectionModule use CharacterStringModule use MemoryManagerModule, only: mem_allocate, mem_deallocate use MemoryHelperModule, only: create_mem_path - use ListModule, only: ListType, isEqualIface, arePointersEqual + use ListModule, only: ListType, isEqualIface use NumericalModelModule use GwfDisuModule use DisConnExchangeModule @@ -218,11 +218,9 @@ subroutine addToRegionalModels(this, v_model) class(VirtualModelType), pointer :: v_model !< the model to add to the region ! local class(*), pointer :: vm_obj - procedure(isEqualIface), pointer :: areEqualMethod vm_obj => v_model - areEqualMethod => arePointersEqual - if (.not. this%regionalModels%ContainsObject(vm_obj, areEqualMethod)) then + if (.not. this%regionalModels%ContainsObject(vm_obj)) then call this%regionalModels%Add(vm_obj) end if @@ -1058,9 +1056,7 @@ subroutine buildInterfaceMap(this) ! first get the participating models call model_ids%init() do i = 1, this%nrOfCells - if (.not. model_ids%contains(this%idxToGlobal(i)%v_model%id)) then - call model_ids%push_back(this%idxToGlobal(i)%v_model%id) - end if + call model_ids%push_back_unique(this%idxToGlobal(i)%v_model%id) end do ! initialize the map diff --git a/src/Model/Connection/GridSorting.f90 b/src/Model/Connection/GridSorting.f90 index 3360b62809d..5d15fa2382c 100644 --- a/src/Model/Connection/GridSorting.f90 +++ b/src/Model/Connection/GridSorting.f90 @@ -2,7 +2,7 @@ module GridSorting use KindModule, only: I4B, DP, LGP use ConstantsModule, only: DHALF use CellWithNbrsModule, only: GlobalCellType - use GenericUtilitiesModule, only: is_same + use MathUtilModule, only: is_close use BaseDisModule, only: dis_transform_xy implicit none private @@ -75,11 +75,11 @@ function lessThan(n, m) result(isLess) dis_bot_m(gcm%index)) ! compare - if (.not. is_same(zn, zm, 10 * epsilon(zn))) then + if (.not. is_close(zn, zm, 10 * epsilon(zn))) then isLess = zn > zm - else if (.not. is_same(yn, ym, 10 * epsilon(yn))) then + else if (.not. is_close(yn, ym, 10 * epsilon(yn))) then isLess = yn > ym - else if (.not. is_same(xn, xm, 10 * epsilon(xn))) then + else if (.not. is_close(xn, xm, 10 * epsilon(xn))) then isLess = xn < xm else isLess = .false. diff --git a/src/Model/Connection/GwfGwfConnection.f90 b/src/Model/Connection/GwfGwfConnection.f90 index 52e089e6aee..625c41d8525 100644 --- a/src/Model/Connection/GwfGwfConnection.f90 +++ b/src/Model/Connection/GwfGwfConnection.f90 @@ -37,10 +37,9 @@ module GwfGwfConnectionModule !< type, public, extends(SpatialModelConnectionType) :: GwfGwfConnectionType - type(GwfModelType), pointer :: gwfModel => null() !< the model for which this connection exists - type(GwfExchangeType), pointer :: gwfExchange => null() !< the primary exchange, cast to its concrete type - logical(LGP) :: owns_exchange !< when true, this connection has ownership over the exchange (memory) - type(GwfInterfaceModelType), pointer :: gwfInterfaceModel => null() !< the interface model + class(GwfModelType), pointer :: gwfModel => null() !< the model for which this connection exists + class(GwfExchangeType), pointer :: gwfExchange => null() !< the primary exchange, cast to its concrete type + class(GwfInterfaceModelType), pointer :: gwfInterfaceModel => null() !< the interface model integer(I4B), pointer :: iXt3dOnExchange => null() !< run XT3D on the interface, !! 0 = don't, 1 = matrix, 2 = rhs integer(I4B) :: iout = 0 !< the list file for the interface model @@ -70,6 +69,7 @@ module GwfGwfConnectionModule procedure, private :: setGridExtent procedure, private :: validateGwfExchange procedure, private :: setFlowToExchange + procedure, private :: setFlowToModel procedure, private :: setNpfEdgeProps end type GwfGwfConnectionType @@ -226,6 +226,9 @@ subroutine cfg_dist_vars(this) call this%cfg_dv('TOP', 'DIS', SYNC_NDS, (/STG_BFR_CON_AR/)) call this%cfg_dv('BOT', 'DIS', SYNC_NDS, (/STG_BFR_CON_AR/)) call this%cfg_dv('AREA', 'DIS', SYNC_NDS, (/STG_BFR_CON_AR/)) + if (this%gwfInterfaceModel%inbuy > 0) then + call this%cfg_dv('DENSE', 'BUY', SYNC_NDS, (/STG_BFR_EXG_CF/)) + end if end subroutine cfg_dist_vars @@ -305,7 +308,7 @@ subroutine gwfgwfcon_ad(this) class(GwfGwfConnectionType) :: this !< this connection ! this triggers the BUY density calculation - if (this%gwfInterfaceModel%inbuy > 0) call this%gwfInterfaceModel%buy%buy_ad() + !if (this%gwfInterfaceModel%inbuy > 0) call this%gwfInterfaceModel%buy%buy_ad() if (this%owns_exchange) then call this%gwfExchange%exg_ad() @@ -313,23 +316,18 @@ subroutine gwfgwfcon_ad(this) end subroutine gwfgwfcon_ad - !> @brief Calculate (or adjust) matrix coefficients, - !! in this case those which are determined or affected - !< by the connection of a GWF model with its neigbors subroutine gwfgwfcon_cf(this, kiter) class(GwfGwfConnectionType) :: this !< this connection integer(I4B), intent(in) :: kiter !< the iteration counter - ! local - integer(I4B) :: i - ! reset interface system - call this%matrix%zero_entries() - do i = 1, this%neq - this%rhs(i) = 0.0_DP - end do + call this%SpatialModelConnectionType%spatialcon_cf(kiter) - ! calculate (wetting/drying, saturation) - call this%gwfInterfaceModel%model_cf(kiter) + ! CF the movers through the exchange + if (this%owns_exchange) then + if (this%gwfExchange%inmvr > 0) then + call this%gwfExchange%mvr%xmvr_cf() + end if + end if end subroutine gwfgwfcon_cf @@ -342,36 +340,9 @@ subroutine gwfgwfcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag ! local - integer(I4B) :: n, nglo - integer(I4B) :: ipos, icol_start, icol_end - class(MatrixBaseType), pointer :: matrix_base - ! fill (and add to...) coefficients for interface - matrix_base => this%matrix - call this%gwfInterfaceModel%model_fc(kiter, matrix_base, inwtflag) - - ! map back to solution matrix - do n = 1, this%neq - ! we cannot check with the mask here, because cross-terms are not - ! necessarily from primary connections. But, we only need the coefficients - ! for our own model (i.e. fluxes into cells belonging to this%owner): - if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then - ! only add connections for own model to global matrix - cycle - end if - - nglo = this%ig_builder%idxToGlobal(n)%index + & - this%ig_builder%idxToGlobal(n)%v_model%moffset%get() - & - matrix_sln%get_row_offset() - rhs_sln(nglo) = rhs_sln(nglo) + this%rhs(n) - - icol_start = this%matrix%get_first_col_pos(n) - icol_end = this%matrix%get_last_col_pos(n) - do ipos = icol_start, icol_end - call matrix_sln%add_value_pos(this%ipos_to_sln(ipos), & - this%matrix%get_value_pos(ipos)) - end do - end do + call this%SpatialModelConnectionType%spatialcon_fc( & + kiter, matrix_sln, rhs_sln, inwtflag) ! FC the movers through the exchange; we cannot call ! exg_fc() directly because it calculates matrix terms @@ -394,9 +365,8 @@ subroutine validateConnection(this) ! local ! base validation (geometry/spatial) - ! TODO_MJR: uncomment this... - !call this%SpatialModelConnectionType%validateConnection() - !call this%validateGwfExchange() + call this%SpatialModelConnectionType%validateConnection() + call this%validateGwfExchange() ! abort on errors if (count_errors() > 0) then @@ -426,6 +396,11 @@ subroutine validateGwfExchange(this) logical(LGP) :: compatible gwfEx => this%gwfExchange + + ! we cannot validate this (yet) in parallel mode + if (.not. gwfEx%v_model1%is_local) return + if (.not. gwfEx%v_model2%is_local) return + modelPtr => this%gwfExchange%model1 gwfModel1 => CastAsGwfModel(modelPtr) modelPtr => this%gwfExchange%model2 @@ -527,6 +502,8 @@ subroutine gwfgwfcon_cq(this, icnvg, isuppress_output, isolnid) call this%setFlowToExchange() + call this%setFlowToModel() + !cdl Could we allow GwfExchange to do this instead, using ! simvals? ! if needed, we add the edge properties to the model's NPF @@ -569,13 +546,54 @@ subroutine setFlowToExchange(this) end subroutine setFlowToExchange + !> @brief Set the flows (flowja from the interface model) to + !< to the model, update the budget + subroutine setFlowToModel(this) + class(GwfGwfConnectionType) :: this !< this connection + ! local + integer(I4B) :: n, m, ipos, iposLoc + integer(I4B) :: nLoc, mLoc + type(ConnectionsType), pointer :: imCon !< interface model connections + type(GlobalCellType), dimension(:), pointer :: toGlobal !< map interface index to global cell + + ! for readability + imCon => this%gwfInterfaceModel%dis%con + toGlobal => this%ig_builder%idxToGlobal + + do n = 1, this%neq + if (.not. toGlobal(n)%v_model == this%owner) then + ! only add flows to own model + cycle + end if + + nLoc = toGlobal(n)%index + + do ipos = imCon%ia(n) + 1, imCon%ia(n + 1) - 1 + if (imCon%mask(ipos) < 1) cycle ! skip this connection, it's masked so not determined by us + + m = imCon%ja(ipos) + mLoc = toGlobal(m)%index + if (toGlobal(m)%v_model == this%owner) then + + ! internal, need to set flowja for n-m + iposLoc = getCSRIndex(nLoc, mLoc, this%gwfModel%ia, this%gwfModel%ja) + + ! update flowja with correct value + this%gwfModel%flowja(iposLoc) = this%gwfInterfaceModel%flowja(ipos) + + end if + end do + end do + + end subroutine setFlowToModel + !> @brief Set flowja as edge properties in the model, !< so it can be used for e.g. specific discharge calculation subroutine setNpfEdgeProps(this) class(GwfGwfConnectionType) :: this !< this connection ! local integer(I4B) :: n, m, ipos, isym - integer(I4B) :: nLoc, mLoc, iposLoc + integer(I4B) :: nLoc, mLoc integer(I4B) :: ihc real(DP) :: rrate real(DP) :: area @@ -648,12 +666,6 @@ subroutine setNpfEdgeProps(this) dist = conLen * cl / (imCon%cl1(isym) + imCon%cl2(isym)) call this%gwfModel%npf%set_edge_properties(nLoc, ihc, rrate, area, & nx, ny, dist) - else - ! internal, need to set flowja for n-m - iposLoc = getCSRIndex(nLoc, mLoc, this%gwfModel%ia, this%gwfModel%ja) - - ! update flowja with correct value - this%gwfModel%flowja(iposLoc) = this%gwfInterfaceModel%flowja(ipos) end if end do end do diff --git a/src/Model/Connection/GwtGwtConnection.f90 b/src/Model/Connection/GwtGwtConnection.f90 index 8c7df985c50..0f8ea2eb798 100644 --- a/src/Model/Connection/GwtGwtConnection.f90 +++ b/src/Model/Connection/GwtGwtConnection.f90 @@ -28,11 +28,9 @@ module GwtGwtConnectionModule !< type, public, extends(SpatialModelConnectionType) :: GwtGwtConnectionType - type(GwtModelType), pointer :: gwtModel => null() !< the model for which this connection exists - type(GwtExchangeType), pointer :: gwtExchange => null() !< the primary exchange, cast to GWT-GWT - logical(LGP) :: exchangeIsOwned !< there are two connections (in serial) for an exchange, - !! one of them needs to manage/own the exchange (e.g. clean up) - type(GwtInterfaceModelType), pointer :: gwtInterfaceModel => null() !< the interface model + class(GwtModelType), pointer :: gwtModel => null() !< the model for which this connection exists + class(GwtExchangeType), pointer :: gwtExchange => null() !< the primary exchange, cast to GWT-GWT + class(GwtInterfaceModelType), pointer :: gwtInterfaceModel => null() !< the interface model integer(I4B), pointer :: iIfaceAdvScheme => null() !< the advection scheme at the interface: !! 0 = upstream, 1 = central, 2 = TVD integer(I4B), pointer :: iIfaceXt3d => null() !< XT3D in the interface DSP package: 0 = no, 1 = lhs, 2 = rhs @@ -57,10 +55,8 @@ module GwtGwtConnectionModule procedure :: exg_ar => gwtgwtcon_ar procedure :: exg_df => gwtgwtcon_df - procedure :: exg_ac => gwtgwtcon_ac procedure :: exg_rp => gwtgwtcon_rp procedure :: exg_ad => gwtgwtcon_ad - procedure :: exg_cf => gwtgwtcon_cf procedure :: exg_fc => gwtgwtcon_fc procedure :: exg_da => gwtgwtcon_da procedure :: exg_cq => gwtgwtcon_cq @@ -100,9 +96,13 @@ subroutine gwtGwtConnection_ctor(this, model, gwtEx) objPtr => gwtEx this%gwtExchange => CastAsGwtExchange(objPtr) - this%exchangeIsOwned = associated(model, gwtEx%model1) + if (gwtEx%v_model1%is_local .and. gwtEx%v_model2%is_local) then + this%owns_exchange = associated(model, gwtEx%model1) + else + this%owns_exchange = .true. + end if - if (this%exchangeIsOwned) then + if (gwtEx%v_model1 == model) then write (name, '(a,i0)') 'GWTCON1_', gwtEx%id else write (name, '(a,i0)') 'GWTCON2_', gwtEx%id @@ -125,7 +125,7 @@ subroutine gwtGwtConnection_ctor(this, model, gwtEx) call this%allocate_scalars() this%typename = 'GWT-GWT' this%iIfaceAdvScheme = 0 - this%iIfaceXt3d = 1 + this%iIfaceXt3d = 0 this%exgflowSign = 1 allocate (this%gwtInterfaceModel) @@ -155,9 +155,14 @@ subroutine gwtgwtcon_df(this) ! has been read at this point) this%iIfaceAdvScheme = this%gwtExchange%iAdvScheme - ! determine xt3d setting on interface + ! determine xt3d setting on interface- (TODO_MJR: default is on?) this%iIfaceXt3d = this%gwtExchange%ixt3d + ! turn off when off in the owning model + if (this%gwtModel%indsp > 0) then + this%iIfaceXt3d = this%gwtModel%dsp%ixt3d + end if + ! determine the required size of the interface model grid call this%setGridExtent() @@ -166,7 +171,7 @@ subroutine gwtgwtcon_df(this) ! we have to 'catch up' and create the interface model ! here, then the remainder of this routine will be define - if (this%exchangeIsOwned) then + if (this%prim_exchange%v_model1 == this%owner) then write (imName, '(a,i0)') 'GWTIM1_', this%gwtExchange%id else write (imName, '(a,i0)') 'GWTIM2_', this%gwtExchange%id @@ -287,7 +292,7 @@ subroutine gwtgwtcon_ar(this) call this%gwtInterfaceModel%model_ar() ! AR the movers and obs through the exchange - if (this%exchangeIsOwned) then + if (this%owns_exchange) then !cdl implement this when MVT is ready !cdl if (this%gwtExchange%inmvt > 0) then !cdl call this%gwtExchange%mvt%mvt_ar() @@ -309,6 +314,10 @@ subroutine validateConnection(this) ! base validation, the spatial/geometry part call this%SpatialModelConnectionType%validateConnection() + ! we cannot validate this (yet) in parallel mode + if (.not. this%gwtExchange%v_model1%is_local) return + if (.not. this%gwtExchange%v_model2%is_local) return + ! GWT related matters if ((this%gwtExchange%gwtmodel1%inadv > 0 .and. & this%gwtExchange%gwtmodel2%inadv == 0) .or. & @@ -338,35 +347,11 @@ subroutine validateConnection(this) end subroutine validateConnection - !> @brief add connections to the global system for - !< this connection - subroutine gwtgwtcon_ac(this, sparse) - class(GwtGwtConnectionType) :: this !< this connection - type(sparsematrix), intent(inout) :: sparse !< sparse matrix to store the connections - ! local - integer(I4B) :: ic, iglo, jglo - type(GlobalCellType) :: boundaryCell, connectedCell - - ! connections to other models - do ic = 1, this%ig_builder%nrOfBoundaryCells - boundaryCell = this%ig_builder%boundaryCells(ic)%cell - connectedCell = this%ig_builder%connectedCells(ic)%cell - iglo = boundaryCell%index + boundaryCell%v_model%moffset%get() - jglo = connectedCell%index + connectedCell%v_model%moffset%get() - call sparse%addconnection(iglo, jglo, 1) - call sparse%addconnection(jglo, iglo, 1) - end do - - ! and internal connections - call this%spatialcon_ac(sparse) - - end subroutine gwtgwtcon_ac - subroutine gwtgwtcon_rp(this) class(GwtGwtConnectionType) :: this !< the connection ! Call exchange rp routines - if (this%exchangeIsOwned) then + if (this%owns_exchange) then call this%gwtExchange%exg_rp() end if @@ -380,28 +365,12 @@ subroutine gwtgwtcon_ad(this) ! recalculate dispersion ellipse if (this%gwtInterfaceModel%indsp > 0) call this%gwtInterfaceModel%dsp%dsp_ad() - if (this%exchangeIsOwned) then + if (this%owns_exchange) then call this%gwtExchange%exg_ad() end if end subroutine gwtgwtcon_ad - subroutine gwtgwtcon_cf(this, kiter) - class(GwtGwtConnectionType) :: this !< the connection - integer(I4B), intent(in) :: kiter !< the iteration counter - ! local - integer(I4B) :: i - - ! reset interface system - call this%matrix%zero_entries() - do i = 1, this%neq - this%rhs(i) = 0.0_DP - end do - - call this%gwtInterfaceModel%model_cf(kiter) - - end subroutine gwtgwtcon_cf - subroutine gwtgwtcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) class(GwtGwtConnectionType) :: this !< the connection integer(I4B), intent(in) :: kiter !< the iteration counter @@ -409,37 +378,16 @@ subroutine gwtgwtcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag ! local - integer(I4B) :: n, nglo - integer(I4B) :: icol_start, icol_end, ipos - class(MatrixBaseType), pointer :: matrix_base - - matrix_base => this%matrix - call this%gwtInterfaceModel%model_fc(kiter, matrix_base, inwtflag) - - ! map back to solution matrix - do n = 1, this%neq - ! We only need the coefficients for our own model - ! (i.e. rows in the matrix that belong to this%owner): - if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then - cycle - end if - nglo = this%ig_builder%idxToGlobal(n)%index + & - this%ig_builder%idxToGlobal(n)%v_model%moffset%get() - rhs_sln(nglo) = rhs_sln(nglo) + this%rhs(n) + call this%SpatialModelConnectionType%spatialcon_fc( & + kiter, matrix_sln, rhs_sln, inwtflag) - icol_start = this%matrix%get_first_col_pos(n) - icol_end = this%matrix%get_last_col_pos(n) - do ipos = icol_start, icol_end - call matrix_sln%add_value_pos(this%ipos_to_sln(ipos), & - this%matrix%get_value_pos(ipos)) - end do - end do - - ! FC the movers through the exchange; we can call - ! exg_fc() directly because it only handles mover terms (unlike in GwfExchange%exg_fc) - if (this%exchangeIsOwned) then - call this%gwtExchange%exg_fc(kiter, matrix_sln, rhs_sln, inwtflag) + ! FC the movers through the exchange + if (this%owns_exchange) then + if (this%gwtExchange%inmvt > 0) then + call this%gwtExchange%mvt%mvt_fc(this%gwtExchange%gwtmodel1%x, & + this%gwtExchange%gwtmodel2%x) + end if end if end subroutine gwtgwtcon_fc @@ -465,7 +413,7 @@ subroutine setFlowToExchange(this) class(GwtExchangeType), pointer :: gwtEx type(IndexMapSgnType), pointer :: map - if (this%exchangeIsOwned) then + if (this%owns_exchange) then gwtEx => this%gwtExchange map => this%interface_map%exchange_maps(this%interface_map%prim_exg_idx) @@ -488,7 +436,7 @@ subroutine gwtgwtcon_bd(this, icnvg, isuppress_output, isolnid) ! call exchange budget routine, also calls bd ! for movers. - if (this%exchangeIsOwned) then + if (this%owns_exchange) then call this%gwtExchange%exg_bd(icnvg, isuppress_output, isolnid) end if @@ -500,7 +448,7 @@ subroutine gwtgwtcon_ot(this) ! Call exg_ot() here as it handles all output processing ! based on gwtExchange%simvals(:), which was correctly ! filled from gwtgwtcon - if (this%exchangeIsOwned) then + if (this%owns_exchange) then call this%gwtExchange%exg_ot() end if @@ -532,7 +480,7 @@ subroutine gwtgwtcon_da(this) end if ! we need to deallocate the exchange we own: - if (this%exchangeIsOwned) then + if (this%owns_exchange) then call this%gwtExchange%exg_da() end if diff --git a/src/Model/Connection/GwtInterfaceModel.f90 b/src/Model/Connection/GwtInterfaceModel.f90 index 43c1d25865c..4adfda4c36d 100644 --- a/src/Model/Connection/GwtInterfaceModel.f90 +++ b/src/Model/Connection/GwtInterfaceModel.f90 @@ -1,17 +1,18 @@ module GwtInterfaceModelModule use KindModule, only: I4B, DP + use ConstantsModule, only: DONE use MemoryManagerModule, only: mem_allocate, mem_deallocate, mem_reallocate use MemoryHelperModule, only: create_mem_path use NumericalModelModule, only: NumericalModelType use GwtModule, only: GwtModelType, CastAsGwtModel use GwfDisuModule, only: disu_cr, CastAsDisuType - use GwtFmiModule, only: fmi_cr, GwtFmiType - use GwtAdvModule, only: adv_cr, GwtAdvType - use GwtAdvOptionsModule, only: GwtAdvOptionsType + use TspFmiModule, only: fmi_cr, TspFmiType + use TspAdvModule, only: adv_cr, TspAdvType + use TspAdvOptionsModule, only: TspAdvOptionsType use GwtDspModule, only: dsp_cr, GwtDspType use GwtDspOptionsModule, only: GwtDspOptionsType use GwtMstModule, only: mst_cr - use GwtObsModule, only: gwt_obs_cr + use TspObsModule, only: tsp_obs_cr use GridConnectionModule implicit none @@ -25,6 +26,7 @@ module GwtInterfaceModelModule integer(i4B), pointer :: iAdvScheme => null() !< the advection scheme: 0 = up, 1 = central, 2 = tvd integer(i4B), pointer :: ixt3d => null() !< xt3d setting: 0 = off, 1 = lhs, 2 = rhs + real(DP), pointer :: ieqnsclfac => null() !< governing eqn scaling factor: 1: GWT, >1: GWE class(GridConnectionType), pointer :: gridConnection => null() !< The grid connection class will provide the interface grid class(GwtModelType), private, pointer :: owner => null() !< the real GWT model for which the exchange coefficients @@ -59,6 +61,7 @@ subroutine gwtifmod_cr(this, name, iout, gridConn) ! defaults this%iAdvScheme = 0 this%ixt3d = 0 + this%ieqnsclfac = DONE this%iout = iout this%gridConnection => gridConn @@ -79,10 +82,12 @@ subroutine gwtifmod_cr(this, name, iout, gridConn) ! create dis and packages call disu_cr(this%dis, this%name, '', -1, this%iout) - call fmi_cr(this%fmi, this%name, 0, this%iout) - call adv_cr(this%adv, this%name, adv_unit, this%iout, this%fmi) + call fmi_cr(this%fmi, this%name, 0, this%iout, this%ieqnsclfac, & + this%depvartype) + call adv_cr(this%adv, this%name, adv_unit, this%iout, this%fmi, & + this%ieqnsclfac) call dsp_cr(this%dsp, this%name, '', -dsp_unit, this%iout, this%fmi) - call gwt_obs_cr(this%obs, inobs) + call tsp_obs_cr(this%obs, inobs) end subroutine gwtifmod_cr @@ -94,6 +99,7 @@ subroutine allocate_scalars(this, modelname) call mem_allocate(this%iAdvScheme, 'ADVSCHEME', this%memoryPath) call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath) + call mem_allocate(this%ieqnsclfac, 'IEQNSCLFAC', this%memoryPath) end subroutine allocate_scalars @@ -117,7 +123,7 @@ subroutine gwtifmod_df(this) class(GwtInterfaceModelType) :: this !< the GWT interface model ! local class(*), pointer :: disPtr - type(GwtAdvOptionsType) :: adv_options + type(TspAdvOptionsType) :: adv_options type(GwtDspOptionsType) :: dsp_options this%moffset = 0 @@ -127,7 +133,7 @@ subroutine gwtifmod_df(this) ! define DISU disPtr => this%dis call this%gridConnection%getDiscretization(CastAsDisuType(disPtr)) - call this%fmi%fmi_df(this%dis, 0) + call this%fmi%fmi_df(this%dis) if (this%inadv > 0) then call this%adv%adv_df(adv_options) @@ -192,6 +198,7 @@ subroutine gwtifmod_da(this) ! this call mem_deallocate(this%iAdvScheme) call mem_deallocate(this%ixt3d) + call mem_deallocate(this%ieqnsclfac) ! gwt packages call this%dis%dis_da() @@ -219,6 +226,7 @@ subroutine gwtifmod_da(this) call mem_deallocate(this%inmvt) call mem_deallocate(this%inoc) call mem_deallocate(this%inobs) + call mem_deallocate(this%eqnsclfac) ! base call this%NumericalModelType%model_da() diff --git a/src/Model/Connection/SpatialModelConnection.f90 b/src/Model/Connection/SpatialModelConnection.f90 index a383d608414..6ebc92fef6c 100644 --- a/src/Model/Connection/SpatialModelConnection.f90 +++ b/src/Model/Connection/SpatialModelConnection.f90 @@ -41,6 +41,8 @@ module SpatialModelConnectionModule integer(I4B), pointer :: nr_connections => null() !< total nr. of connected cells (primary) class(DisConnExchangeType), pointer :: prim_exchange => null() !< the exchange for which the interface model is created + logical(LGP) :: owns_exchange !< there are two connections (in serial) for an exchange, + !! one of them needs to manage/own the exchange (e.g. clean up) type(STLVecInt), pointer :: halo_models !< models that are potentially in the halo of this interface type(STLVecInt), pointer :: halo_exchanges !< exchanges that are potentially part of the halo of this interface (includes primary) integer(I4B), pointer :: int_stencil_depth => null() !< size of the computational stencil for the interior @@ -72,12 +74,16 @@ module SpatialModelConnectionModule procedure :: exg_ar => spatialcon_ar procedure :: exg_ac => spatialcon_ac procedure :: exg_mc => spatialcon_mc + procedure :: exg_cf => spatialcon_cf + procedure :: exg_fc => spatialcon_fc procedure :: exg_da => spatialcon_da ! protected procedure, pass(this) :: spatialcon_df procedure, pass(this) :: spatialcon_ar procedure, pass(this) :: spatialcon_ac + procedure, pass(this) :: spatialcon_cf + procedure, pass(this) :: spatialcon_fc procedure, pass(this) :: spatialcon_da procedure, pass(this) :: spatialcon_setmodelptrs procedure, pass(this) :: spatialcon_connect @@ -344,11 +350,10 @@ subroutine maskOwnerConnections(this) if (this%owner%dis%con%mask(csr_idx) > 0) then call this%owner%dis%con%set_mask(csr_idx, 0) else - ! edge case, someone will be calculating this connection - ! so we ignore it here - write (*, *) 'Warning: overlap detected, no mask on connection ', & - nloc, ':', mloc, ' in model ', trim(this%owner%name), & - ' for Exchange ', trim(this%prim_exchange%name) + ! edge case, this connection is already being calculated + ! so we ignore it here. This can happen in the overlap + ! between two different exchanges when a larger stencil + ! (XT3D) is applied. call conn%set_mask(ipos, 0) end if end if @@ -429,6 +434,65 @@ subroutine spatialcon_mc(this, matrix_sln) end subroutine spatialcon_mc + !> @brief Calculate (or adjust) matrix coefficients, + !! in this case those which are determined or affected + !< by the connection of a GWF model with its neigbors + subroutine spatialcon_cf(this, kiter) + class(SpatialModelConnectionType) :: this !< this connection + integer(I4B), intent(in) :: kiter !< the iteration counter + ! local + integer(I4B) :: i + + ! reset interface system + call this%matrix%zero_entries() + do i = 1, this%neq + this%rhs(i) = 0.0_DP + end do + + ! calculate the interface model + call this%interface_model%model_cf(kiter) + + end subroutine spatialcon_cf + + !> @brief Formulate coefficients from interface model + !< + subroutine spatialcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag) + class(SpatialModelConnectionType) :: this !< this connection + integer(I4B), intent(in) :: kiter !< the iteration counter + class(MatrixBaseType), pointer :: matrix_sln !< the system matrix + real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side + integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag + ! local + integer(I4B) :: n, nglo + integer(I4B) :: icol_start, icol_end, ipos + class(MatrixBaseType), pointer :: matrix_base + + matrix_base => this%matrix + call this%interface_model%model_fc(kiter, matrix_base, inwtflag) + + ! map back to solution matrix + do n = 1, this%neq + ! We only need the coefficients for our own model + ! (i.e. rows in the matrix that belong to this%owner): + if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then + cycle + end if + + nglo = this%ig_builder%idxToGlobal(n)%index + & + this%ig_builder%idxToGlobal(n)%v_model%moffset%get() - & + matrix_sln%get_row_offset() + rhs_sln(nglo) = rhs_sln(nglo) + this%rhs(n) + + icol_start = this%matrix%get_first_col_pos(n) + icol_end = this%matrix%get_last_col_pos(n) + do ipos = icol_start, icol_end + call matrix_sln%add_value_pos(this%ipos_to_sln(ipos), & + this%matrix%get_value_pos(ipos)) + end do + end do + + end subroutine spatialcon_fc + !> @brief Deallocation !< subroutine spatialcon_da(this) @@ -549,16 +613,16 @@ subroutine validateConnection(this) conEx => this%prim_exchange if (conEx%ixt3d > 0) then ! if XT3D, we need these angles: - if (conEx%model1%dis%con%ianglex == 0) then + if (conEx%v_model1%con_ianglex%get() == 0) then write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', & trim(conEx%name), ' but the discretization in model ', & - trim(conEx%model1%name), ' has no ANGLDEGX specified' + trim(conEx%v_model1%name), ' has no ANGLDEGX specified' call store_error(errmsg) end if - if (conEx%model2%dis%con%ianglex == 0) then + if (conEx%v_model2%con_ianglex%get() == 0) then write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', & trim(conEx%name), ' but the discretization in model ', & - trim(conEx%model2%name), ' has no ANGLDEGX specified' + trim(conEx%v_model2%name), ' has no ANGLDEGX specified' call store_error(errmsg) end if end if diff --git a/src/Model/ExplicitModel.f90 b/src/Model/ExplicitModel.f90 index ae5630b83da..6c23d5a0969 100644 --- a/src/Model/ExplicitModel.f90 +++ b/src/Model/ExplicitModel.f90 @@ -1,18 +1,12 @@ -!> @brief Explicit Model Module -!! -!! This module contains the Explicit Model, which is a parent -!! class for models that solve themselves. Explicit models are -!! added to an Explicit Solution, which is simply a container -!! that scrolls through a list of explicit models and calls -!! methods in a prescribed sequence. -!! -!< +!> @brief Models that solve themselves module ExplicitModelModule - use KindModule, only: I4B + use KindModule, only: I4B, DP + use ConstantsModule, only: LINELENGTH use ListModule, only: ListType use BaseModelModule, only: BaseModelType use BaseDisModule, only: DisBaseType + use MemoryManagerModule, only: mem_allocate, mem_deallocate implicit none private @@ -21,22 +15,27 @@ module ExplicitModelModule AddExplicitModelToList, & GetExplicitModelFromList - !> @brief Derived type for the Explicit Model Type - !! - !! This derived type describes a parent class for explicit - !! models. + !> @brief Base type for models that solve themselves. !! + !! An explicit solution simply scrolls through a list of explicit + !! models and calls solution procedures in a prescribed sequence. !< type, extends(BaseModelType) :: ExplicitModelType - type(ListType), pointer :: bndlist => null() !< array of boundary packages for this model + character(len=LINELENGTH), pointer :: filename => null() !< input file name + integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< ibound array + type(ListType), pointer :: bndlist => null() !< array of boundary packages class(DisBaseType), pointer :: dis => null() !< discretization object contains + ! -- Overridden methods procedure :: model_ad procedure :: model_solve procedure :: model_cq procedure :: model_bd procedure :: model_da + ! -- Utility methods procedure :: allocate_scalars + procedure :: allocate_arrays + procedure :: set_idsoln end type ExplicitModelType contains @@ -45,18 +44,12 @@ module ExplicitModelModule !< subroutine model_ad(this) class(ExplicitModelType) :: this - ! - ! -- return - return end subroutine model_ad !> @ brief Solve the model !< subroutine model_solve(this) class(ExplicitModelType) :: this - ! - ! -- return - return end subroutine model_solve !> @ brief Calculate model flows @@ -65,9 +58,6 @@ subroutine model_cq(this, icnvg, isuppress_output) class(ExplicitModelType) :: this integer(I4B), intent(in) :: icnvg integer(I4B), intent(in) :: isuppress_output - ! - ! -- return - return end subroutine model_cq !> @ brief Calculate model budget @@ -76,68 +66,68 @@ subroutine model_bd(this, icnvg, isuppress_output) class(ExplicitModelType) :: this integer(I4B), intent(in) :: icnvg integer(I4B), intent(in) :: isuppress_output - ! - ! -- return - return end subroutine model_bd !> @ brief Deallocate the model !< subroutine model_da(this) - ! -- modules - use MemoryManagerModule, only: mem_deallocate class(ExplicitModelType) :: this - ! -- Scalars - ! - ! -- Arrays - ! - ! -- derived types + ! -- deallocate scalars + deallocate (this%filename) + + ! -- deallocate arrays + call mem_deallocate(this%ibound) + + ! -- nullify pointers + if (associated(this%ibound)) & + call mem_deallocate(this%ibound, 'IBOUND', this%memoryPath) + + ! -- member derived types call this%bndlist%Clear() deallocate (this%bndlist) - ! - ! -- nullify pointers - ! - ! -- BaseModelType + + ! -- deallocate base tpye call this%BaseModelType%model_da() - ! - ! -- Return - return end subroutine model_da - !> @ brief Allocate model scalar variables + !> @ brief Allocate scalar variables !< subroutine allocate_scalars(this, modelname) - use MemoryManagerModule, only: mem_allocate class(ExplicitModelType) :: this character(len=*), intent(in) :: modelname - ! - ! -- allocate basetype members + call this%BaseModelType%allocate_scalars(modelname) - ! - ! -- allocate members from this type allocate (this%bndlist) - ! - ! -- initialize - ! - ! -- return - return + allocate (this%filename) + this%filename = '' end subroutine allocate_scalars + !> @brief Allocate array variables + !< + subroutine allocate_arrays(this) + class(ExplicitModelType) :: this + integer(I4B) :: i + + call mem_allocate(this%ibound, this%dis%nodes, 'IBOUND', this%memoryPath) + do i = 1, this%dis%nodes + this%ibound(i) = 1 ! active by default + end do + end subroutine allocate_arrays + !> @ brief Cast a generic object into an explicit model !< function CastAsExplicitModelClass(obj) result(res) class(*), pointer, intent(inout) :: obj class(ExplicitModelType), pointer :: res - ! + res => null() if (.not. associated(obj)) return - ! + select type (obj) class is (ExplicitModelType) res => obj end select - return end function CastAsExplicitModelClass !> @ brief Add explicit model to a generic list @@ -148,11 +138,9 @@ subroutine AddExplicitModelToList(list, model) class(ExplicitModelType), pointer, intent(inout) :: model ! -- local class(*), pointer :: obj - ! + obj => model call list%Add(obj) - ! - return end subroutine AddExplicitModelToList !> @ brief Get generic object from list and return as explicit model @@ -164,11 +152,17 @@ function GetExplicitModelFromList(list, idx) result(res) class(ExplicitModelType), pointer :: res ! -- local class(*), pointer :: obj - ! + obj => list%GetItem(idx) res => CastAsExplicitModelClass(obj) - ! - return end function GetExplicitModelFromList + !> @brief Set the solution ID + !< + subroutine set_idsoln(this, id) + class(ExplicitModelType) :: this + integer(I4B), intent(in) :: id + this%idsoln = id + end subroutine set_idsoln + end module ExplicitModelModule diff --git a/src/Model/Geometry/BaseGeometry.f90 b/src/Model/Geometry/BaseGeometry.f90 index 0216abb793f..291f8530a5b 100644 --- a/src/Model/Geometry/BaseGeometry.f90 +++ b/src/Model/Geometry/BaseGeometry.f90 @@ -12,7 +12,9 @@ module BaseGeometryModule character(len=20) :: geo_type = 'UNDEFINED' integer(I4B) :: id = 0 character(len=GEONAMELEN) :: name = '' + contains + procedure :: area_sat procedure :: perimeter_sat procedure :: area_wet @@ -28,8 +30,10 @@ function area_sat(this) real(DP) :: area_sat ! -- dummy class(BaseGeometryType) :: this + ! area_sat = 0.d0 - ! -- return + ! + ! -- Return return end function area_sat @@ -38,8 +42,10 @@ function perimeter_sat(this) real(DP) :: perimeter_sat ! -- dummy class(BaseGeometryType) :: this + ! perimeter_sat = 0.d0 - ! -- return + ! + ! -- Return return end function perimeter_sat @@ -49,8 +55,10 @@ function area_wet(this, depth) ! -- dummy class(BaseGeometryType) :: this real(DP), intent(in) :: depth + ! area_wet = 0.d0 - ! -- return + ! + ! -- Return return end function area_wet @@ -60,8 +68,10 @@ function perimeter_wet(this, depth) ! -- dummy class(BaseGeometryType) :: this real(DP), intent(in) :: depth + ! perimeter_wet = 0.d0 - ! -- return + ! + ! -- Return return end function perimeter_wet @@ -69,17 +79,14 @@ subroutine set_attribute(this, line) ! -- dummy class(BaseGeometryType) :: this character(len=*), intent(inout) :: line - ! -- return + ! + ! -- Return return end subroutine set_attribute + !> @brief Print the attributes for this object + !< subroutine print_attributes(this, iout) -! ****************************************************************************** -! print_attributes -- print the attributes for this object -! ***************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(BaseGeometryType) :: this ! -- local @@ -87,13 +94,12 @@ subroutine print_attributes(this, iout) ! -- formats character(len=*), parameter :: fmtid = "(4x,a,i0)" character(len=*), parameter :: fmtnm = "(4x,a,a)" -! ------------------------------------------------------------------------------ ! write (iout, fmtid) 'ID = ', this%id write (iout, fmtnm) 'NAME = ', trim(adjustl(this%name)) write (iout, fmtnm) 'GEOMETRY TYPE = ', trim(adjustl(this%geo_type)) ! - ! -- return + ! -- Return return end subroutine print_attributes diff --git a/src/Model/Geometry/CircularGeometry.f90 b/src/Model/Geometry/CircularGeometry.f90 index 18e71a6491d..19f86362a87 100644 --- a/src/Model/Geometry/CircularGeometry.f90 +++ b/src/Model/Geometry/CircularGeometry.f90 @@ -10,7 +10,9 @@ module CircularGeometryModule type, extends(BaseGeometryType) :: CircularGeometryType real(DP) :: radius = DZERO + contains + procedure :: area_sat procedure :: perimeter_sat procedure :: area_wet @@ -21,20 +23,15 @@ module CircularGeometryModule contains + !> @brief Return area as if geometry is fully saturated + !< function area_sat(this) -! ****************************************************************************** -! area_sat -- return area as if geometry is fully saturated -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return real(DP) :: area_sat ! -- dummy class(CircularGeometryType) :: this -! ------------------------------------------------------------------------------ ! ! -- Calculate area area_sat = DPI * this%radius**DTWO @@ -43,35 +40,26 @@ function area_sat(this) return end function area_sat + !> @brief Return perimeter as if geometry is fully saturated + !< function perimeter_sat(this) -! ****************************************************************************** -! perimeter_sat -- return perimeter as if geometry is fully saturated -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return real(DP) :: perimeter_sat ! -- dummy class(CircularGeometryType) :: this -! ------------------------------------------------------------------------------ ! ! -- Calculate area perimeter_sat = DTWO * DPI * this%radius ! - ! -- return + ! -- Return return end function perimeter_sat + !> @brief Return wetted area + !< function area_wet(this, depth) -! ****************************************************************************** -! area_wet -- return wetted area -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI, DZERO ! -- return @@ -79,7 +67,6 @@ function area_wet(this, depth) ! -- dummy class(CircularGeometryType) :: this real(DP), intent(in) :: depth -! ------------------------------------------------------------------------------ ! ! -- Calculate area if (depth <= DZERO) then @@ -102,13 +89,9 @@ function area_wet(this, depth) return end function area_wet + !> @brief Return wetted perimeter + !< function perimeter_wet(this, depth) -! ****************************************************************************** -! perimeter_wet -- return wetted perimeter -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return @@ -116,7 +99,6 @@ function perimeter_wet(this, depth) ! -- dummy class(CircularGeometryType) :: this real(DP), intent(in) :: depth -! ------------------------------------------------------------------------------ ! ! -- Calculate area if (depth <= DZERO) then @@ -131,17 +113,13 @@ function perimeter_wet(this, depth) perimeter_wet = DTWO * DPI * this%radius end if ! - ! -- return + ! -- Return return end function perimeter_wet + !> @brief Set a parameter for this circular object + !< subroutine set_attribute(this, line) -! ****************************************************************************** -! set_attribute -- set a parameter for this circular object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use InputOutputModule, only: urword use ConstantsModule, only: LINELENGTH @@ -153,7 +131,6 @@ subroutine set_attribute(this, line) ! -- local integer(I4B) :: lloc, istart, istop, ival real(DP) :: rval -! ------------------------------------------------------------------------------ ! ! -- should change this and set id if uninitialized or store it lloc = 1 @@ -175,17 +152,13 @@ subroutine set_attribute(this, line) call store_error(errmsg, terminate=.TRUE.) end select ! - ! -- return + ! -- Return return end subroutine set_attribute + !> @brief Print the attributes for this object + !< subroutine print_attributes(this, iout) -! ****************************************************************************** -! print_attributes -- print the attributes for this object -! ***************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(CircularGeometryType) :: this ! -- local @@ -193,7 +166,6 @@ subroutine print_attributes(this, iout) ! -- formats character(len=*), parameter :: fmtnm = "(4x,a,a)" character(len=*), parameter :: fmttd = "(4x,a,1(1PG15.6))" -! ------------------------------------------------------------------------------ ! ! -- call parent to print parent attributes call this%BaseGeometryType%print_attributes(iout) @@ -203,7 +175,7 @@ subroutine print_attributes(this, iout) write (iout, fmttd) 'SATURATED AREA = ', this%area_sat() write (iout, fmttd) 'SATURATED WETTED PERIMETER = ', this%perimeter_sat() ! - ! -- return + ! -- Return return end subroutine print_attributes diff --git a/src/Model/Geometry/RectangularGeometry.f90 b/src/Model/Geometry/RectangularGeometry.f90 index 1df035584de..29279898b30 100644 --- a/src/Model/Geometry/RectangularGeometry.f90 +++ b/src/Model/Geometry/RectangularGeometry.f90 @@ -9,7 +9,9 @@ module RectangularGeometryModule type, extends(BaseGeometryType) :: RectangularGeometryType real(DP) :: height = DZERO real(DP) :: width = DZERO + contains + procedure :: area_sat procedure :: perimeter_sat procedure :: area_wet @@ -20,20 +22,15 @@ module RectangularGeometryModule contains + !> @brief Return saturated area + !< function area_sat(this) -! ****************************************************************************** -! area_sat -- return saturated area -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return real(DP) :: area_sat ! -- dummy class(RectangularGeometryType) :: this -! ------------------------------------------------------------------------------ ! ! -- Calculate area area_sat = this%height * this%width @@ -42,35 +39,26 @@ function area_sat(this) return end function area_sat + !> @brief Return saturated perimeter + !< function perimeter_sat(this) -! ****************************************************************************** -! perimeter_sat -- return saturated perimeter -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return real(DP) :: perimeter_sat ! -- dummy class(RectangularGeometryType) :: this -! ------------------------------------------------------------------------------ ! ! -- Calculate area perimeter_sat = DTWO * (this%height + this%width) ! - ! -- return + ! -- Return return end function perimeter_sat + !> @brief Return wetted area + !< function area_wet(this, depth) -! ****************************************************************************** -! area_wet -- return wetted area -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI, DZERO ! -- return @@ -78,7 +66,6 @@ function area_wet(this, depth) ! -- dummy class(RectangularGeometryType) :: this real(DP), intent(in) :: depth -! ------------------------------------------------------------------------------ ! ! -- Calculate area if (depth <= DZERO) then @@ -93,13 +80,9 @@ function area_wet(this, depth) return end function area_wet + !> @brief Return wetted perimeter + !< function perimeter_wet(this, depth) -! ****************************************************************************** -! perimeter_wet -- return wetted perimeter -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DTWO, DPI ! -- return @@ -107,7 +90,6 @@ function perimeter_wet(this, depth) ! -- dummy class(RectangularGeometryType) :: this real(DP), intent(in) :: depth -! ------------------------------------------------------------------------------ ! ! -- Calculate area if (depth <= DZERO) then @@ -118,17 +100,13 @@ function perimeter_wet(this, depth) perimeter_wet = DTWO * (this%height + this%width) end if ! - ! -- return + ! -- Return return end function perimeter_wet + !> @brief Set a parameter for this rectangular object + !< subroutine set_attribute(this, line) -! ****************************************************************************** -! set_attribute -- set a parameter for this rectangular object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use InputOutputModule, only: urword use ConstantsModule, only: LINELENGTH @@ -140,13 +118,12 @@ subroutine set_attribute(this, line) ! -- local integer(I4B) :: lloc, istart, istop, ival real(DP) :: rval -! ------------------------------------------------------------------------------ ! ! -- should change this and set id if uninitialized or store it lloc = 1 call urword(line, lloc, istart, istop, 2, ival, rval, 0, 0) this%id = ival - + ! ! -- Parse the attribute call urword(line, lloc, istart, istop, 1, ival, rval, 0, 0) select case (line(istart:istop)) @@ -165,17 +142,13 @@ subroutine set_attribute(this, line) call store_error(errmsg, terminate=.TRUE.) end select ! - ! -- return + ! -- Return return end subroutine set_attribute + !> @brief Print the attributes for this object + !< subroutine print_attributes(this, iout) -! ****************************************************************************** -! print_attributes -- print the attributes for this object -! ***************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(RectangularGeometryType) :: this ! -- local @@ -183,7 +156,6 @@ subroutine print_attributes(this, iout) ! -- formats character(len=*), parameter :: fmtnm = "(4x,a,a)" character(len=*), parameter :: fmttd = "(4x,a,1(1PG15.6))" -! ------------------------------------------------------------------------------ ! ! -- call parent to print parent attributes call this%BaseGeometryType%print_attributes(iout) @@ -194,7 +166,7 @@ subroutine print_attributes(this, iout) write (iout, fmttd) 'SATURATED AREA = ', this%area_sat() write (iout, fmttd) 'SATURATED WETTED PERIMETER = ', this%perimeter_sat() ! - ! -- return + ! -- Return return end subroutine print_attributes diff --git a/src/Model/GroundWaterFlow/gwf3.f90 b/src/Model/GroundWaterFlow/gwf3.f90 index 9a8057246be..00b44227c06 100644 --- a/src/Model/GroundWaterFlow/gwf3.f90 +++ b/src/Model/GroundWaterFlow/gwf3.f90 @@ -3,7 +3,7 @@ module GwfModule use KindModule, only: DP, I4B use InputOutputModule, only: ParseLine, upcase, lowcase use ConstantsModule, only: LENFTYPE, LENMEMPATH, LENPAKLOC, DZERO, & - DEM1, DTEN, DEP20 + DEM1, DTEN, DEP20, LENPACKAGETYPE use VersionModule, only: write_listfile_header use NumericalModelModule, only: NumericalModelType use BaseDisModule, only: DisBaseType @@ -32,6 +32,8 @@ module GwfModule public :: gwf_cr public :: GwfModelType public :: CastAsGwfModel + public :: GWF_NBASEPKG, GWF_NMULTIPKG + public :: GWF_BASEPKG, GWF_MULTIPKG type, extends(NumericalModelType) :: GwfModelType @@ -99,6 +101,34 @@ module GwfModule ! end type GwfModelType + !> @brief GWF base package array descriptors + !! + !! GWF6 model base package types. Only listed packages are candidates + !! for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: GWF_NBASEPKG = 50 + character(len=LENPACKAGETYPE), dimension(GWF_NBASEPKG) :: GWF_BASEPKG + data GWF_BASEPKG/'DIS6 ', 'DISV6', 'DISU6', ' ', ' ', & ! 5 + &'NPF6 ', 'BUY6 ', 'VSC6 ', 'GNC6 ', ' ', & ! 10 + &'HFB6 ', 'STO6 ', 'IC6 ', ' ', ' ', & ! 15 + &'MVR6 ', 'OC6 ', 'OBS6 ', ' ', ' ', & ! 20 + &30*' '/ ! 50 + + !> @brief GWF multi package array descriptors + !! + !! GWF6 model multi-instance package types. Only listed packages are + !! candidates for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: GWF_NMULTIPKG = 50 + character(len=LENPACKAGETYPE), dimension(GWF_NMULTIPKG) :: GWF_MULTIPKG + data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', ' ', & ! 5 + &'RCH6 ', 'EVT6 ', 'CHD6 ', 'CSUB6', ' ', & ! 10 + &'MAW6 ', 'SFR6 ', 'LAK6 ', 'UZF6 ', 'API6 ', & ! 15 + &35*' '/ ! 50 + + ! -- size of supported model package arrays + integer(I4B), parameter :: NIUNIT_GWF = GWF_NBASEPKG + GWF_NMULTIPKG + contains !> @brief Create a new groundwater flow model object @@ -191,7 +221,6 @@ end subroutine gwf_cr !< subroutine gwf_df(this) ! -- modules - use ModelPackageInputsModule, only: NIUNIT_GWF ! -- dummy class(GwfModelType) :: this ! -- local @@ -792,7 +821,7 @@ subroutine gwf_cq(this, icnvg, isuppress_output) ! head solution. do ip = 1, this%bndlist%Count() packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_cf(reset_mover=.false.) + call packobj%bnd_cf() if (this%inbuy > 0) call this%buy%buy_cf_bnd(packobj, this%x) call packobj%bnd_cq(this%x, this%flowja) end do @@ -1254,8 +1283,8 @@ end subroutine allocate_scalars !! (2) add a pointer to the package !! !< - subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & - iout) + subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & + inunit, iout) ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error @@ -1278,6 +1307,7 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & integer(I4B), intent(in) :: ipakid integer(I4B), intent(in) :: ipaknum character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout ! -- local @@ -1289,19 +1319,26 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & ! -- This part creates the package object select case (filtyp) case ('CHD6') - call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('WEL6') - call wel_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call wel_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('DRN6') - call drn_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call drn_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('RIV6') - call riv_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call riv_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('GHB6') - call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('RCH6') - call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('EVT6') - call evt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call evt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('MAW6') call maw_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) case ('SFR6') @@ -1432,8 +1469,8 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, & bndptype = pkgtype end if ! - call this%package_create(pkgtype, ipakid, ipaknum, pkgname, inunit, & - this%iout) + call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, & + inunit, this%iout) ipakid = ipakid + 1 ipaknum = ipaknum + 1 end do @@ -1489,6 +1526,7 @@ subroutine create_packages(this) integer(I4B) :: n integer(I4B) :: indis = 0 ! DIS enabled flag character(len=LENMEMPATH) :: mempathnpf = '' + character(len=LENMEMPATH) :: mempathic = '' ! ! -- set input model memory path model_mempath = create_mem_path(component=this%name, context=idm_context) @@ -1534,15 +1572,17 @@ subroutine create_packages(this) case ('CSUB6') this%incsub = inunit case ('IC6') - this%inic = inunit + this%inic = 1 + mempathic = mempath case ('MVR6') this%inmvr = inunit case ('OC6') this%inoc = inunit case ('OBS6') this%inobs = inunit - case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', 'EVT6', & - 'API6', 'CHD6', 'MAW6', 'SFR6', 'LAK6', 'UZF6') + case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', & + 'EVT6', 'API6', 'CHD6', 'MAW6', 'SFR6', & + 'LAK6', 'UZF6') call expandarray(bndpkgs) bndpkgs(size(bndpkgs)) = n case default @@ -1560,7 +1600,7 @@ subroutine create_packages(this) call sto_cr(this%sto, this%name, this%insto, this%iout) call csub_cr(this%csub, this%name, this%insto, this%sto%packName, & this%incsub, this%iout) - call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis) + call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis) call mvr_cr(this%mvr, this%name, this%inmvr, this%iout, this%dis) call oc_cr(this%oc, this%name, this%inoc, this%iout) call gwf_obs_cr(this%obs, this%inobs) diff --git a/src/Model/GroundWaterFlow/gwf3buy8.f90 b/src/Model/GroundWaterFlow/gwf3buy8.f90 index 39fbdf5629c..70f87f67f61 100644 --- a/src/Model/GroundWaterFlow/gwf3buy8.f90 +++ b/src/Model/GroundWaterFlow/gwf3buy8.f90 @@ -76,13 +76,9 @@ module GwfBuyModule contains + !> @brief Generic function to calculate fluid density from concentration + !< function calcdens(denseref, drhodc, crhoref, conc) result(dense) -! ****************************************************************************** -! calcdens -- generic function to calculate fluid density from concentration -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy real(DP), intent(in) :: denseref real(DP), dimension(:), intent(in) :: drhodc @@ -93,7 +89,6 @@ function calcdens(denseref, drhodc, crhoref, conc) result(dense) ! -- local integer(I4B) :: nrhospec integer(I4B) :: i -! ------------------------------------------------------------------------------ ! nrhospec = size(drhodc) dense = denseref @@ -101,23 +96,18 @@ function calcdens(denseref, drhodc, crhoref, conc) result(dense) dense = dense + drhodc(i) * (conc(i) - crhoref(i)) end do ! - ! -- return + ! -- Return return end function calcdens + !> @brief Create a new BUY object + !< subroutine buy_cr(buyobj, name_model, inunit, iout) -! ****************************************************************************** -! buy_cr -- Create a new BUY object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(GwfBuyType), pointer :: buyobj character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (buyobj) @@ -142,13 +132,6 @@ end subroutine buy_cr !> @brief Read options and package data, or set from argument !< subroutine buy_df(this, dis, buy_input) -! ****************************************************************************** -! buy_df -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this !< this buoyancy package class(DisBaseType), pointer, intent(in) :: dis !< pointer to discretization @@ -158,7 +141,6 @@ subroutine buy_df(this, dis, buy_input) character(len=*), parameter :: fmtbuy = & "(1x,/1x,'BUY -- Buoyancy Package, Version 1, 5/16/2018', & &' input read from unit ', i0, //)" -! ------------------------------------------------------------------------------ ! ! --print a message identifying the buoyancy package. write (this%iout, fmtbuy) this%inunit @@ -195,21 +177,13 @@ subroutine buy_df(this, dis, buy_input) return end subroutine buy_df + !> @brief Allocate and Read + !< subroutine buy_ar(this, npf, ibound) -! ****************************************************************************** -! buy_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this type(GwfNpfType), pointer, intent(in) :: npf integer(I4B), dimension(:), pointer :: ibound - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- store pointers to arguments that were passed in this%npf => npf @@ -229,14 +203,11 @@ subroutine buy_ar(this, npf, ibound) return end subroutine buy_ar + !> @brief Buoyancy ar_bnd routine to activate density in packages + !! + !! This routine is called from gwf_ar() as it goes through each package + !< subroutine buy_ar_bnd(this, packobj, hnew) -! ****************************************************************************** -! buy_ar_bnd -- buoyancy ar_bnd routine to activate density in packages. -! This routine is called from gwf_ar() as it goes through each package. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType use LakModule, only: LakType @@ -246,8 +217,6 @@ subroutine buy_ar_bnd(this, packobj, hnew) class(GwfBuyType) :: this class(BndType), pointer :: packobj real(DP), intent(in), dimension(:) :: hnew - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Add density terms based on boundary package type select case (packobj%filtyp) @@ -258,7 +227,7 @@ subroutine buy_ar_bnd(this, packobj, hnew) type is (LakType) call packobj%lak_activate_density() end select - + ! case ('SFR') ! ! -- activate density for sfr package @@ -266,7 +235,7 @@ subroutine buy_ar_bnd(this, packobj, hnew) type is (SfrType) call packobj%sfr_activate_density() end select - + ! case ('MAW') ! ! -- activate density for maw package @@ -274,7 +243,7 @@ subroutine buy_ar_bnd(this, packobj, hnew) type is (MawType) call packobj%maw_activate_density() end select - + ! case default ! ! -- nothing @@ -284,13 +253,9 @@ subroutine buy_ar_bnd(this, packobj, hnew) return end subroutine buy_ar_bnd + !> @brief Check for new buy period data + !< subroutine buy_rp(this) -! ****************************************************************************** -! buy_rp -- Check for new buy period data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper ! -- dummy @@ -304,7 +269,6 @@ subroutine buy_rp(this) &for species ',i0,'. One or more model names may be specified & &incorrectly in the PACKAGEDATA block or a gwf-gwt exchange may need & &to be activated.')" -! ------------------------------------------------------------------------------ ! ! -- Check to make sure all concentration pointers have been set if (kstp * kper == 1) then @@ -319,21 +283,15 @@ subroutine buy_rp(this) end if end if ! - ! -- return + ! -- Return return end subroutine buy_rp + !> @brief Advance + !< subroutine buy_ad(this) -! ****************************************************************************** -! buy_ad -- Advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- update density using the last concentration call this%buy_calcdens() @@ -342,18 +300,12 @@ subroutine buy_ad(this) return end subroutine buy_ad + !> @brief Fill coefficients + !< subroutine buy_cf(this, kiter) -! ****************************************************************************** -! buy_cf -- Fill coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this integer(I4B) :: kiter - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Recalculate the elev array for this iteration if (this%ireadelev == 0) then @@ -366,13 +318,9 @@ subroutine buy_cf(this, kiter) return end subroutine buy_cf + !> @brief Fill coefficients + !< subroutine buy_cf_bnd(this, packobj, hnew) !, hcof, rhs, auxnam, auxvar) -! ****************************************************************************** -! buy_cf_bnd -- Fill coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType ! -- dummy @@ -383,7 +331,6 @@ subroutine buy_cf_bnd(this, packobj, hnew) !, hcof, rhs, auxnam, auxvar) integer(I4B) :: i, j integer(I4B) :: n, locdense, locelev integer(I4B), dimension(:), allocatable :: locconc -! ------------------------------------------------------------------------------ ! ! -- Return if freshwater head formulation; all boundary heads must be ! entered as freshwater equivalents @@ -468,19 +415,14 @@ subroutine buy_cf_bnd(this, packobj, hnew) !, hcof, rhs, auxnam, auxvar) return end subroutine buy_cf_bnd + !> @brief Return the density of the boundary package using one of several + !! different options in the following order of priority: + !! 1. Assign as aux variable in column with name 'DENSITY' + !! 2. Calculate using equation of state and nrhospecies aux columns + !! 3. If neither of those, then assign as denseref + !< function get_bnd_density(n, locdense, locconc, denseref, drhodc, crhoref, & ctemp, auxvar) result(densebnd) -! ****************************************************************************** -! get_bnd_density -- Return the density of the boundary package using one of -! several different options in the following order of priority: -! 1. Assign as aux variable in column with name 'DENSITY' -! 2. Calculate using equation of state and nrhospecies aux columns -! 3. If neither of those, then assign as denseref -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy integer(I4B), intent(in) :: n integer(I4B), intent(in) :: locdense @@ -494,7 +436,6 @@ function get_bnd_density(n, locdense, locconc, denseref, drhodc, crhoref, & real(DP) :: densebnd ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- assign boundary density based on one of three options if (locdense > 0) then @@ -514,21 +455,18 @@ function get_bnd_density(n, locdense, locconc, denseref, drhodc, crhoref, & densebnd = denseref end if ! - ! -- return + ! -- Return return end function get_bnd_density + !> @brief Fill ghb coefficients + !< subroutine buy_cf_ghb(packobj, hnew, dense, elev, denseref, locelev, & locdense, locconc, drhodc, crhoref, ctemp, & iform) -! ****************************************************************************** -! buy_cf_ghb -- Fill ghb coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType + use GhbModule, only: GhbType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -550,48 +488,45 @@ subroutine buy_cf_ghb(packobj, hnew, dense, elev, denseref, locelev, & real(DP) :: hghb real(DP) :: cond real(DP) :: hcofterm, rhsterm -! ------------------------------------------------------------------------------ ! ! -- Process density terms for each GHB - do n = 1, packobj%nbound - node = packobj%nodelist(n) - if (packobj%ibound(node) <= 0) cycle - ! - ! -- density - denseghb = get_bnd_density(n, locdense, locconc, denseref, & - drhodc, crhoref, ctemp, packobj%auxvar) - ! - ! -- elevation - elevghb = elev(node) - if (locelev > 0) elevghb = packobj%auxvar(locelev, n) - ! - ! -- boundary head and conductance - hghb = packobj%bound(1, n) - cond = packobj%bound(2, n) - ! - ! -- calculate HCOF and RHS terms - call calc_ghb_hcof_rhs_terms(denseref, denseghb, dense(node), & - elevghb, elev(node), hghb, hnew(node), & - cond, iform, rhsterm, hcofterm) - packobj%hcof(n) = packobj%hcof(n) + hcofterm - packobj%rhs(n) = packobj%rhs(n) - rhsterm - ! - end do + select type (packobj) + type is (GhbType) + do n = 1, packobj%nbound + node = packobj%nodelist(n) + if (packobj%ibound(node) <= 0) cycle + ! + ! -- density + denseghb = get_bnd_density(n, locdense, locconc, denseref, & + drhodc, crhoref, ctemp, packobj%auxvar) + ! + ! -- elevation + elevghb = elev(node) + if (locelev > 0) elevghb = packobj%auxvar(locelev, n) + ! + ! -- boundary head and conductance + hghb = packobj%bhead(n) + cond = packobj%cond(n) + ! + ! -- calculate HCOF and RHS terms + call calc_ghb_hcof_rhs_terms(denseref, denseghb, dense(node), & + elevghb, elev(node), hghb, hnew(node), & + cond, iform, rhsterm, hcofterm) + packobj%hcof(n) = packobj%hcof(n) + hcofterm + packobj%rhs(n) = packobj%rhs(n) - rhsterm + ! + end do + end select ! ! -- Return return end subroutine buy_cf_ghb + !> @brief Calculate density hcof and rhs terms for ghb conditions + !< subroutine calc_ghb_hcof_rhs_terms(denseref, denseghb, densenode, & elevghb, elevnode, hghb, hnode, & cond, iform, rhsterm, hcofterm) -! ****************************************************************************** -! calc_ghb_hcof_rhs_terms -- Calculate density hcof and rhs terms for ghb -! conditions -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy real(DP), intent(in) :: denseref real(DP), intent(in) :: denseghb @@ -607,7 +542,6 @@ subroutine calc_ghb_hcof_rhs_terms(denseref, denseghb, densenode, & ! -- local real(DP) :: t1, t2 real(DP) :: avgdense, avgelev -! ------------------------------------------------------------------------------ ! ! -- Calculate common terms avgdense = DHALF * denseghb + DHALF * densenode @@ -633,21 +567,18 @@ subroutine calc_ghb_hcof_rhs_terms(denseref, denseghb, densenode, & rhsterm = rhsterm + DHALF * cond * t2 * hnode end if ! - ! -- return + ! -- Return return end subroutine calc_ghb_hcof_rhs_terms + !> @brief Fill riv coefficients + !< subroutine buy_cf_riv(packobj, hnew, dense, elev, denseref, locelev, & locdense, locconc, drhodc, crhoref, ctemp, & iform) -! ****************************************************************************** -! buy_cf_riv -- Fill riv coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType + use RivModule, only: RivType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -671,56 +602,55 @@ subroutine buy_cf_riv(packobj, hnew, dense, elev, denseref, locelev, & real(DP) :: cond real(DP) :: hcofterm real(DP) :: rhsterm -! ------------------------------------------------------------------------------ ! ! -- Process density terms for each RIV - do n = 1, packobj%nbound - node = packobj%nodelist(n) - if (packobj%ibound(node) <= 0) cycle - ! - ! -- density - denseriv = get_bnd_density(n, locdense, locconc, denseref, & - drhodc, crhoref, ctemp, packobj%auxvar) - ! - ! -- elevation - elevriv = elev(node) - if (locelev > 0) elevriv = packobj%auxvar(locelev, n) - ! - ! -- boundary head and conductance - hriv = packobj%bound(1, n) - cond = packobj%bound(2, n) - rbot = packobj%bound(3, n) - ! - ! -- calculate and add terms depending on whether head is above rbot - if (hnew(node) > rbot) then + select type (packobj) + type is (RivType) + do n = 1, packobj%nbound + node = packobj%nodelist(n) + if (packobj%ibound(node) <= 0) cycle ! - ! --calculate HCOF and RHS terms, similar to GHB in this case - call calc_ghb_hcof_rhs_terms(denseref, denseriv, dense(node), & - elevriv, elev(node), hriv, hnew(node), & - cond, iform, rhsterm, hcofterm) - else - hcofterm = DZERO - rhsterm = cond * (denseriv / denseref - DONE) * (hriv - rbot) - end if - ! - ! -- Add terms to package hcof and rhs accumulators - packobj%hcof(n) = packobj%hcof(n) + hcofterm - packobj%rhs(n) = packobj%rhs(n) - rhsterm - end do + ! -- density + denseriv = get_bnd_density(n, locdense, locconc, denseref, & + drhodc, crhoref, ctemp, packobj%auxvar) + ! + ! -- elevation + elevriv = elev(node) + if (locelev > 0) elevriv = packobj%auxvar(locelev, n) + ! + ! -- boundary head and conductance + hriv = packobj%stage(n) + cond = packobj%cond(n) + rbot = packobj%rbot(n) + ! + ! -- calculate and add terms depending on whether head is above rbot + if (hnew(node) > rbot) then + ! + ! --calculate HCOF and RHS terms, similar to GHB in this case + call calc_ghb_hcof_rhs_terms(denseref, denseriv, dense(node), & + elevriv, elev(node), hriv, hnew(node), & + cond, iform, rhsterm, hcofterm) + else + hcofterm = DZERO + rhsterm = cond * (denseriv / denseref - DONE) * (hriv - rbot) + end if + ! + ! -- Add terms to package hcof and rhs accumulators + packobj%hcof(n) = packobj%hcof(n) + hcofterm + packobj%rhs(n) = packobj%rhs(n) - rhsterm + end do + end select ! ! -- Return return end subroutine buy_cf_riv + !> @brief Fill drn coefficients + !< subroutine buy_cf_drn(packobj, hnew, dense, denseref) -! ****************************************************************************** -! buy_cf_drn -- Fill drn coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType + use DrnModule, only: DrnType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -734,37 +664,35 @@ subroutine buy_cf_drn(packobj, hnew, dense, denseref) real(DP) :: cond real(DP) :: hcofterm real(DP) :: rhsterm -! ------------------------------------------------------------------------------ ! ! -- Process density terms for each DRN - do n = 1, packobj%nbound - node = packobj%nodelist(n) - if (packobj%ibound(node) <= 0) cycle - rho = dense(node) - hbnd = packobj%bound(1, n) - cond = packobj%bound(2, n) - if (hnew(node) > hbnd) then - hcofterm = -cond * (rho / denseref - DONE) - rhsterm = hcofterm * hbnd - packobj%hcof(n) = packobj%hcof(n) + hcofterm - packobj%rhs(n) = packobj%rhs(n) + rhsterm - end if - end do + select type (packobj) + type is (DrnType) + do n = 1, packobj%nbound + node = packobj%nodelist(n) + if (packobj%ibound(node) <= 0) cycle + rho = dense(node) + hbnd = packobj%elev(n) + cond = packobj%cond(n) + if (hnew(node) > hbnd) then + hcofterm = -cond * (rho / denseref - DONE) + rhsterm = hcofterm * hbnd + packobj%hcof(n) = packobj%hcof(n) + hcofterm + packobj%rhs(n) = packobj%rhs(n) + rhsterm + end if + end do + end select ! ! -- Return return end subroutine buy_cf_drn + !> @brief Pass density information into lak package; density terms are + !! calculated in the lake package as part of lak_calculate_density_exchange + !! method + !< subroutine buy_cf_lak(packobj, hnew, dense, elev, denseref, locdense, & locconc, drhodc, crhoref, ctemp, iform) -! ****************************************************************************** -! buy_cf_lak -- Pass density information into lak package; density terms are -! calculated in the lake package as part of lak_calculate_density_exchange -! method -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType use LakModule, only: LakType @@ -784,7 +712,6 @@ subroutine buy_cf_lak(packobj, hnew, dense, elev, denseref, locdense, & integer(I4B) :: n integer(I4B) :: node real(DP) :: denselak -! ------------------------------------------------------------------------------ ! ! -- Insert the lake and gwf relative densities into col 1 and 2 and the ! gwf elevation into col 3 of the lake package denseterms array @@ -816,16 +743,12 @@ subroutine buy_cf_lak(packobj, hnew, dense, elev, denseref, locdense, & return end subroutine buy_cf_lak + !> @brief Pass density information into sfr package; density terms are + !! calculated in the sfr package as part of sfr_calculate_density_exchange + !! method + !< subroutine buy_cf_sfr(packobj, hnew, dense, elev, denseref, locdense, & locconc, drhodc, crhoref, ctemp, iform) -! ****************************************************************************** -! buy_cf_sfr -- Pass density information into sfr package; density terms are -! calculated in the sfr package as part of sfr_calculate_density_exchange -! method -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType use SfrModule, only: SfrType @@ -845,7 +768,6 @@ subroutine buy_cf_sfr(packobj, hnew, dense, elev, denseref, locdense, & integer(I4B) :: n integer(I4B) :: node real(DP) :: densesfr -! ------------------------------------------------------------------------------ ! ! -- Insert the sfr and gwf relative densities into col 1 and 2 and the ! gwf elevation into col 3 of the sfr package denseterms array @@ -877,16 +799,12 @@ subroutine buy_cf_sfr(packobj, hnew, dense, elev, denseref, locdense, & return end subroutine buy_cf_sfr + !> @brief Pass density information into maw package; density terms are + !! calculated in the maw package as part of maw_calculate_density_exchange + !! method + !< subroutine buy_cf_maw(packobj, hnew, dense, elev, denseref, locdense, & locconc, drhodc, crhoref, ctemp, iform) -! ****************************************************************************** -! buy_cf_maw -- Pass density information into maw package; density terms are -! calculated in the maw package as part of maw_calculate_density_exchange -! method -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BndModule, only: BndType use MawModule, only: MawType @@ -906,7 +824,6 @@ subroutine buy_cf_maw(packobj, hnew, dense, elev, denseref, locdense, & integer(I4B) :: n integer(I4B) :: node real(DP) :: densemaw -! ------------------------------------------------------------------------------ ! ! -- Insert the maw and gwf relative densities into col 1 and 2 and the ! gwf elevation into col 3 of the maw package denseterms array @@ -938,13 +855,9 @@ subroutine buy_cf_maw(packobj, hnew, dense, elev, denseref, locdense, & return end subroutine buy_cf_maw + !> @brief Fill coefficients + !< subroutine buy_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! buy_fc -- Fill coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this integer(I4B) :: kiter @@ -955,7 +868,7 @@ subroutine buy_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) ! -- local integer(I4B) :: n, m, ipos, idiag real(DP) :: rhsterm, amatnn, amatnm -! ------------------------------------------------------------------------------ + ! ! -- initialize amatnn = DZERO amatnm = DZERO @@ -985,13 +898,9 @@ subroutine buy_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) return end subroutine buy_fc + !> @brief Save density array to binary file + !< subroutine buy_ot_dv(this, idvfl) -! ****************************************************************************** -! buy_ot_dv -- Save density array to binary file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this integer(I4B), intent(in) :: idvfl @@ -1002,7 +911,6 @@ subroutine buy_ot_dv(this, idvfl) integer(I4B) :: nvaluesp integer(I4B) :: nwidthp real(DP) :: dinact -! ------------------------------------------------------------------------------ ! ! -- Set unit number for density output if (this%ioutdense /= 0) then @@ -1025,19 +933,14 @@ subroutine buy_ot_dv(this, idvfl) nwidthp, editdesc, dinact) end if end if - ! ! -- Return return end subroutine buy_ot_dv + !> @brief Add buy term to flowja + !< subroutine buy_cq(this, hnew, flowja) -! ****************************************************************************** -! buy_cq -- Add buy term to flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none class(GwfBuyType) :: this real(DP), intent(in), dimension(:) :: hnew @@ -1045,7 +948,6 @@ subroutine buy_cq(this, hnew, flowja) integer(I4B) :: n, m, ipos real(DP) :: deltaQ real(DP) :: rhsterm, amatnn, amatnm -! ------------------------------------------------------------------------------ ! ! -- Calculate the flow across each cell face and store in flowja do n = 1, this%dis%nodes @@ -1071,17 +973,11 @@ subroutine buy_cq(this, hnew, flowja) return end subroutine buy_cq + !> @brief Deallocate + !< subroutine buy_da(this) -! ****************************************************************************** -! buy_da -- Deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate arrays if package was active if (this%inunit > 0) then @@ -1103,7 +999,7 @@ subroutine buy_da(this) call mem_deallocate(this%ireadconcbuy) call mem_deallocate(this%iconcset) call mem_deallocate(this%denseref) - + ! call mem_deallocate(this%nrhospecies) ! ! -- deallocate parent @@ -1113,14 +1009,9 @@ subroutine buy_da(this) return end subroutine buy_da + !> @brief Read the dimensions for this package + !< subroutine read_dimensions(this) -! ****************************************************************************** -! read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType), intent(inout) :: this ! -- local @@ -1128,7 +1019,6 @@ subroutine read_dimensions(this) integer(I4B) :: ierr logical :: isfound, endOfBlock ! -- format -! ------------------------------------------------------------------------------ ! ! -- get dimensions block call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -1164,18 +1054,13 @@ subroutine read_dimensions(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine read_dimensions + !> @brief Read PACKAGEDATA block + !< subroutine read_packagedata(this) -! ****************************************************************************** -! read_packagedata -- Read PACKAGEDATA block -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this ! -- local @@ -1193,7 +1078,6 @@ subroutine read_packagedata(this) "('Invalid value for IRHOSPEC (',i0,') detected in BUY Package. & &IRHOSPEC must be > 0 and <= NRHOSPECIES, and duplicate values & &are not allowed.')" -! ------------------------------------------------------------------------------ ! ! -- initialize allocate (itemp(this%nrhospecies)) @@ -1259,16 +1143,17 @@ subroutine read_packagedata(this) ! -- deallocate deallocate (itemp) ! - ! -- return + ! -- Return return end subroutine read_packagedata !> @brief Sets package data instead of reading from file !< subroutine set_packagedata(this, input_data) + ! -- dummy class(GwfBuyType) :: this !< this buyoancy pkg type(GwfBuyInputDataType), intent(in) :: input_data !< the input data to be set - ! local + ! -- local integer(I4B) :: ispec do ispec = 1, this%nrhospecies @@ -1277,16 +1162,14 @@ subroutine set_packagedata(this, input_data) this%cmodelname(ispec) = input_data%cmodelname(ispec) this%cauxspeciesname(ispec) = input_data%cauxspeciesname(ispec) end do - + ! + ! -- Return + return end subroutine set_packagedata + !> @brief Calculate buyancy term for this connection + !< subroutine calcbuy(this, n, m, icon, hn, hm, buy) -! ****************************************************************************** -! calcbuy -- Calculate buyancy term for this connection -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use GwfNpfModule, only: hcond, vcond ! -- dummy @@ -1303,7 +1186,6 @@ subroutine calcbuy(this, n, m, icon, hn, hm, buy) cond, tp, bt real(DP) :: hyn real(DP) :: hym -! ------------------------------------------------------------------------------ ! ! -- Average density densen = this%dense(n) @@ -1371,13 +1253,9 @@ subroutine calcbuy(this, n, m, icon, hn, hm, buy) return end subroutine calcbuy + !> @brief Calculate hydraulic head term for this connection + !< subroutine calchhterms(this, n, m, icon, hn, hm, rhsterm, amatnn, amatnm) -! ****************************************************************************** -! calchhterms -- Calculate hydraulic head term for this connection -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use GwfNpfModule, only: hcond, vcond ! -- dummy @@ -1399,7 +1277,6 @@ subroutine calchhterms(this, n, m, icon, hn, hm, rhsterm, amatnn, amatnm) real(DP) :: hphi real(DP) :: hyn real(DP) :: hym -! ------------------------------------------------------------------------------ ! ! -- Average density densen = this%dense(n) @@ -1473,20 +1350,15 @@ subroutine calchhterms(this, n, m, icon, hn, hm, rhsterm, amatnn, amatnm) return end subroutine calchhterms + !> @brief calculate fluid density from concentration + !< subroutine buy_calcdens(this) -! ****************************************************************************** -! buy_calcdens -- calculate fluid density from concentration -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this ! -- local integer(I4B) :: n integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- Calculate the density using the specified concentration array do n = 1, this%dis%nodes @@ -1505,19 +1377,14 @@ subroutine buy_calcdens(this) return end subroutine buy_calcdens + !> @brief Calculate cell elevations to use in density flow equations + !< subroutine buy_calcelev(this) -! ****************************************************************************** -! buy_calcelev -- Calculate cell elevations to use in density flow equations -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfBuyType) :: this ! -- local integer(I4B) :: n real(DP) :: tp, bt, frac -! ------------------------------------------------------------------------------ ! ! -- Calculate the elev array do n = 1, this%dis%nodes @@ -1531,19 +1398,14 @@ subroutine buy_calcelev(this) return end subroutine buy_calcelev + !> @brief Allocate scalars used by the package + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO ! -- dummy class(GwfBuyType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -1555,9 +1417,8 @@ subroutine allocate_scalars(this) call mem_allocate(this%ireadconcbuy, 'IREADCONCBUY', this%memoryPath) call mem_allocate(this%iconcset, 'ICONCSET', this%memoryPath) call mem_allocate(this%denseref, 'DENSEREF', this%memoryPath) - + ! call mem_allocate(this%nrhospecies, 'NRHOSPECIES', this%memoryPath) - ! ! -- Initialize this%ioutdense = 0 @@ -1565,9 +1426,8 @@ subroutine allocate_scalars(this) this%iconcset = 0 this%ireadconcbuy = 0 this%denseref = 1000.d0 - + ! this%nrhospecies = 0 - ! ! -- Initialize default to LHS implementation of hydraulic head formulation this%iform = 2 @@ -1577,20 +1437,14 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate arrays used by the package + !< subroutine allocate_arrays(this, nodes) -! ****************************************************************************** -! allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this integer(I4B), intent(in) :: nodes ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- Allocate call mem_allocate(this%dense, nodes, 'DENSE', this%memoryPath) @@ -1622,13 +1476,9 @@ subroutine allocate_arrays(this, nodes) return end subroutine allocate_arrays + !> @brief Read package options + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use OpenSpecModule, only: access, form use InputOutputModule, only: urword, getunit, urdaux, openfile @@ -1643,7 +1493,6 @@ subroutine read_options(this) character(len=*), parameter :: fmtfileout = & "(4x, 'BUY ', 1x, a, 1x, ' will be saved to file: ', & &a, /4x, 'opened on unit: ', I7)" -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, & @@ -1704,31 +1553,30 @@ end subroutine read_options !> @brief Sets options as opposed to reading them from a file !< subroutine set_options(this, input_data) + ! -- dummy class(GwfBuyType) :: this type(GwfBuyInputDataType), intent(in) :: input_data !< the input data to be set - + ! this%iform = input_data%iform this%denseref = input_data%denseref - + ! ! derived option: ! if not iform==2, there is no asymmetry if (this%iform == 0 .or. this%iform == 1) then this%iasym = 0 end if - + ! + ! -- Return + return end subroutine set_options + !> @brief Pass in a gwt model name, concentration array and ibound, and store + !! a pointer to these in the BUY package so that density can be calculated + !! from them + !! + !! This routine is called from the gwfgwt exchange in the exg_ar() method + !< subroutine set_concentration_pointer(this, modelname, conc, icbund) -! ****************************************************************************** -! set_concentration_pointer -- pass in a gwt model name, concentration array -! and ibound, and store a pointer to these in the BUY package so that -! density can be calculated from them. -! This routine is called from the gwfgwt exchange in the exg_ar() method. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfBuyType) :: this character(len=LENMODELNAME), intent(in) :: modelname @@ -1737,7 +1585,6 @@ subroutine set_concentration_pointer(this, modelname, conc, icbund) ! -- local integer(I4B) :: i logical :: found -! ------------------------------------------------------------------------------ ! this%iconcset = 1 found = .false. diff --git a/src/Model/GroundWaterFlow/gwf3chd8.f90 b/src/Model/GroundWaterFlow/gwf3chd8.f90 index 5b55207e1cc..3b7c7c26a16 100644 --- a/src/Model/GroundWaterFlow/gwf3chd8.f90 +++ b/src/Model/GroundWaterFlow/gwf3chd8.f90 @@ -3,9 +3,12 @@ module ChdModule use KindModule, only: DP, I4B use ConstantsModule, only: DZERO, DONE, NAMEDBOUNDFLAG, LENFTYPE, & LINELENGTH, LENPACKAGENAME + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename use MemoryHelperModule, only: create_mem_path use ObsModule, only: DefaultObsIdProcessor use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObserveModule, only: ObserveType use TimeSeriesLinkModule, only: TimeSeriesLinkType, & GetTimeSeriesLinkFromList @@ -19,7 +22,8 @@ module ChdModule character(len=LENFTYPE) :: ftype = 'CHD' character(len=LENPACKAGENAME) :: text = ' CHD' ! - type, extends(BndType) :: ChdType + type, extends(BndExtType) :: ChdType + real(DP), dimension(:), pointer, contiguous :: head => null() !< constant head array real(DP), dimension(:), pointer, contiguous :: ratechdin => null() !simulated flows into constant head (excluding other chds) real(DP), dimension(:), pointer, contiguous :: ratechdout => null() !simulated flows out of constant head (excluding to other chds) contains @@ -32,24 +36,23 @@ module ChdModule procedure :: bnd_da => chd_da procedure :: allocate_arrays => chd_allocate_arrays procedure :: define_listlabel + procedure :: bound_value => chd_bound_value + procedure :: head_mult ! -- methods for observations procedure, public :: bnd_obs_supported => chd_obs_supported procedure, public :: bnd_df_obs => chd_df_obs - ! -- method for time series - procedure, public :: bnd_rp_ts => chd_rp_ts + ! + procedure, private :: calc_chd_rate end type ChdType contains - subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! chd_create -- Create a New Constant Head Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new constant head package + !! + !! Routine points packobj to the newly created package + !< + subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -58,20 +61,20 @@ subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(ChdType), pointer :: chdobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (chdobj) packobj => chdobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars - call packobj%allocate_scalars() + call chdobj%allocate_scalars() ! ! -- initialize package call packobj%pack_initialize() @@ -81,33 +84,26 @@ subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 1 - packobj%iscloc = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine chd_create + !> @brief Allocate arrays specific to the constant head package + !< subroutine chd_allocate_arrays(this, nodelist, auxvar) -! ****************************************************************************** -! allocate_scalars -- allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use MemoryManagerModule, only: mem_allocate + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin ! -- dummy class(ChdType) :: this integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars - call this%BndType%allocate_arrays() + call this%BndExtType%allocate_arrays(nodelist, auxvar) ! ! -- allocate ratechdex call mem_allocate(this%ratechdin, this%maxbound, 'RATECHDIN', this%memoryPath) @@ -118,25 +114,29 @@ subroutine chd_allocate_arrays(this, nodelist, auxvar) this%ratechdout(i) = DZERO end do ! - ! -- return + ! -- set constant head array input context pointer + call mem_setptr(this%head, 'HEAD', this%input_mempath) + ! + ! -- checkin constant head array input context pointer + call mem_checkin(this%head, 'HEAD', this%memoryPath, & + 'HEAD', this%input_mempath) + ! + ! -- Return return end subroutine chd_allocate_arrays + !> @brief Constant concentration/temperature read and prepare (rp) routine + !< subroutine chd_rp(this) -! ****************************************************************************** -! chd_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use SimModule, only: store_error + ! + use TdisModule, only: kper ! -- dummy class(ChdType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: errmsg character(len=30) :: nodestr integer(I4B) :: i, node, ibd, ierr -! ------------------------------------------------------------------------------ + ! + if (this%iper /= kper) return ! ! -- Reset previous CHDs to active cell do i = 1, this%nbound @@ -145,7 +145,7 @@ subroutine chd_rp(this) end do ! ! -- Call the parent class read and prepare - call this%BndType%bnd_rp() + call this%BndExtType%bnd_rp() ! ! -- Set ibound to -(ibcnum + 1) for constant head cells ierr = 0 @@ -165,20 +165,23 @@ subroutine chd_rp(this) ! ! -- Stop if errors detected if (ierr > 0) then - call this%parser%StoreErrorUnit() + call store_error_filename(this%input_fname) end if ! - ! -- return + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! + ! -- Return return end subroutine chd_rp + !> @brief Constant head package advance routine + !! + !! Add package connections to matrix + !< subroutine chd_ad(this) -! ****************************************************************************** -! chd_ad -- Advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(ChdType) :: this @@ -186,15 +189,12 @@ subroutine chd_ad(this) integer(I4B) :: i, node real(DP) :: hb ! -- formats -! ------------------------------------------------------------------------------ - ! - ! -- Advance the time series - call this%TsManager%ad() ! ! -- Process each entry in the specified-head cell list do i = 1, this%nbound node = this%nodelist(i) - hb = this%bound(1, i) + hb = this%head_mult(i) + ! this%xnew(node) = hb this%xold(node) = this%xnew(node) end do @@ -204,24 +204,17 @@ subroutine chd_ad(this) ! "current" value. call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine chd_ad + !> @brief Check constant concentration/temperature boundary condition data + !< subroutine chd_ck(this) -! ****************************************************************************** -! chd_ck -- Check chd boundary condition data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, count_errors ! -- dummy class(ChdType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: errmsg character(len=30) :: nodestr integer(I4B) :: i integer(I4B) :: node @@ -230,36 +223,34 @@ subroutine chd_ck(this) character(len=*), parameter :: fmtchderr = & "('CHD BOUNDARY ',i0,' HEAD (',g0,') IS LESS THAN CELL & &BOTTOM (',g0,')',' FOR CELL ',a)" -! ------------------------------------------------------------------------------ ! ! -- check stress period data do i = 1, this%nbound node = this%nodelist(i) bt = this%dis%bot(node) ! -- accumulate errors - if (this%bound(1, i) < bt .and. this%icelltype(node) /= 0) then + if (this%head_mult(i) < bt .and. this%icelltype(node) /= 0) then call this%dis%noder_to_string(node, nodestr) - write (errmsg, fmt=fmtchderr) i, this%bound(1, i), bt, trim(nodestr) + write (errmsg, fmt=fmtchderr) i, this%head_mult(i), bt, trim(nodestr) call store_error(errmsg) end if end do ! - !write summary of chd package error messages + ! write summary of chd package error messages if (count_errors() > 0) then - call this%parser%StoreErrorUnit() + call store_error_filename(this%input_fname) end if ! - ! -- return + ! -- Return return end subroutine chd_ck + !> @brief Override bnd_fc and do nothing + !! + !! For constant head boundary type, the call to bnd_fc + !! needs to be overwritten to do nothing + !< subroutine chd_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! chd_fc -- Override bnd_fc and do nothing -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(ChdType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -267,25 +258,31 @@ subroutine chd_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local -! -------------------------------------------------------------------------- ! - ! -- return + ! -- Return return end subroutine chd_fc + !> @brief Calculate flow associated with constant head bondary + !! + !! This method overrides bnd_cq() + !< subroutine chd_cq(this, x, flowja, iadv) -! ****************************************************************************** -! chd_cq -- Calculate constant head flow. This method overrides bnd_cq(). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy class(ChdType), intent(inout) :: this real(DP), dimension(:), intent(in) :: x real(DP), dimension(:), contiguous, intent(inout) :: flowja integer(I4B), optional, intent(in) :: iadv + + ! NB: the rate calculation cannot be done until chd_bd below + + end subroutine chd_cq + + !> @brief Calculate the CHD cell rates, to be called + !< after all updates to the model flowja are done + subroutine calc_chd_rate(this) + ! -- modules + ! -- dummy + class(ChdType), intent(inout) :: this ! -- local integer(I4B) :: i integer(I4B) :: ipos @@ -295,7 +292,6 @@ subroutine chd_cq(this, x, flowja, iadv) real(DP) :: rate real(DP) :: ratein, rateout real(DP) :: q -! ------------------------------------------------------------------------------ ! ! -- If no boundaries, skip flow calculations. if (this%nbound > 0) then @@ -311,7 +307,7 @@ subroutine chd_cq(this, x, flowja, iadv) ! -- Calculate the flow rate into the cell. do ipos = this%dis%con%ia(node) + 1, & this%dis%con%ia(node + 1) - 1 - q = flowja(ipos) + q = this%flowja(ipos) rate = rate - q ! -- only accumulate chin and chout for active ! connected cells @@ -334,16 +330,18 @@ subroutine chd_cq(this, x, flowja, iadv) this%simvals(i) = rate this%ratechdin(i) = ratein this%ratechdout(i) = rateout - flowja(idiag) = flowja(idiag) + rate + this%flowja(idiag) = this%flowja(idiag) + rate ! end do ! end if ! - ! -- return + ! -- Return return - end subroutine chd_cq + end subroutine calc_chd_rate + !> @brief Add package ratin/ratout to model budget + !< subroutine chd_bd(this, model_budget) ! -- add package ratin/ratout to model budget use TdisModule, only: delt @@ -354,6 +352,13 @@ subroutine chd_bd(this, model_budget) real(DP) :: ratout real(DP) :: dum integer(I4B) :: isuppress_output + + ! For CHDs at an exchange, under some conditions + ! (XT3D), the model flowja into the cell is not + ! finalized until after exg_cq. So we calculate + ! the CHD rate here + call this%calc_chd_rate() + isuppress_output = 0 call rate_accumulator(this%ratechdin(1:this%nbound), ratin, dum) call rate_accumulator(this%ratechdout(1:this%nbound), ratout, dum) @@ -361,40 +366,31 @@ subroutine chd_bd(this, model_budget) isuppress_output, this%packName) end subroutine chd_bd + !> @brief Deallocate memory + !< subroutine chd_da(this) -! ****************************************************************************** -! chd_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(ChdType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! ! -- arrays call mem_deallocate(this%ratechdin) call mem_deallocate(this%ratechdout) + call mem_deallocate(this%head, 'HEAD', this%memoryPath) ! - ! -- return + ! -- Return return end subroutine chd_da + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(ChdType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -413,73 +409,94 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel ! -- Procedures related to observations + !> @brief Overrides bnd_obs_supported from bndType class + !! + !! Return true since CHD package supports observations + !< logical function chd_obs_supported(this) -! ****************************************************************************** -! chd_obs_supported -! -- Return true because CHD package supports observations. -! -- Overrides packagetype%_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! class(ChdType) :: this -! ------------------------------------------------------------------------------ + ! chd_obs_supported = .true. + ! + ! -- Return return end function chd_obs_supported + !> @brief Overrides bnd_df_obs from bndType class + !! + !! (1) Store observation type supported by CHD package and (2) override + !! BndType%bnd_df_obs + !< subroutine chd_df_obs(this) -! ****************************************************************************** -! chd_df_obs (implements bnd_df_obs) -! -- Store observation type supported by CHD package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none ! -- dummy class(ChdType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('chd', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor + ! + ! -- Return return end subroutine chd_df_obs - ! -- Procedure related to time series + !> @brief Apply auxiliary multiplier to specified head if appropriate + !< + function head_mult(this, row) result(head) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(ChdType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: head + ! + if (this%iauxmultcol > 0) then + head = this%head(row) * this%auxvar(this%iauxmultcol, row) + else + head = this%head(row) + end if + ! + ! -- Return + return + end function head_mult - subroutine chd_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In CHD package variable HEAD - ! can be controlled by time series. - ! -- dummy - class(ChdType), intent(inout) :: this - ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'HEAD' - end select - end if - end do + !> @ brief Return a bound value + !! + !! Return a bound value associated with an ncolbnd index + !! and row. + !< + function chd_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(ChdType), intent(inout) :: this !< BndType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%head_mult(row) + case default + errmsg = 'Programming error. CHD bound value requested column '& + &'outside range of ncolbnd (1).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select ! + ! -- Return return - end subroutine chd_rp_ts + end function chd_bound_value end module ChdModule diff --git a/src/Model/GroundWaterFlow/gwf3chd8idm.f90 b/src/Model/GroundWaterFlow/gwf3chd8idm.f90 new file mode 100644 index 00000000000..78f5c565e44 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3chd8idm.f90 @@ -0,0 +1,430 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfChdInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_chd_param_definitions + public gwf_chd_aggregate_definitions + public gwf_chd_block_definitions + public GwfChdParamFoundType + public gwf_chd_multi_package + + type GwfChdParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: inewton = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: head = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfChdParamFoundType + + logical :: gwf_chd_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfchd_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_inewton = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'OPTIONS', & ! block + 'DEV_NO_NEWTON', & ! tag name + 'INEWTON', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_head = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'PERIOD', & ! block + 'HEAD', & ! tag name + 'HEAD', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfchd_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_chd_param_definitions(*) = & + [ & + gwfchd_auxiliary, & + gwfchd_auxmultname, & + gwfchd_boundnames, & + gwfchd_iprpak, & + gwfchd_iprflow, & + gwfchd_ipakcb, & + gwfchd_ts_filerecord, & + gwfchd_ts6, & + gwfchd_filein, & + gwfchd_ts6_filename, & + gwfchd_obs_filerecord, & + gwfchd_obs6, & + gwfchd_obs6_filename, & + gwfchd_inewton, & + gwfchd_maxbound, & + gwfchd_cellid, & + gwfchd_head, & + gwfchd_auxvar, & + gwfchd_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfchd_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'CHD', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID HEAD AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_chd_aggregate_definitions(*) = & + [ & + gwfchd_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_chd_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfChdInputModule diff --git a/src/Model/GroundWaterFlow/gwf3csub8.f90 b/src/Model/GroundWaterFlow/gwf3csub8.f90 index 8b1c8621e26..db87b8ff411 100644 --- a/src/Model/GroundWaterFlow/gwf3csub8.f90 +++ b/src/Model/GroundWaterFlow/gwf3csub8.f90 @@ -18,7 +18,8 @@ module GwfCsubModule TABLEFT, TABCENTER, TABRIGHT, & TABSTRING, TABUCSTRING, TABINTEGER, TABREAL use MemoryHelperModule, only: create_mem_path - use GenericUtilitiesModule, only: is_same, sim_message + use MathUtilModule, only: is_close + use MessageModule, only: write_message use SmoothingModule, only: sQuadraticSaturation, & sQuadraticSaturationDerivative, & sQuadratic0sp, & @@ -29,7 +30,8 @@ module GwfCsubModule use BlockParserModule, only: BlockParserType use TimeSeriesLinkModule, only: TimeSeriesLinkType, & GetTimeSeriesLinkFromList - use InputOutputModule, only: get_node, extract_idnum_or_bndname + use GeomUtilModule, only: get_node + use InputOutputModule, only: extract_idnum_or_bndname use BaseDisModule, only: DisBaseType use SimModule, only: count_errors, store_error, store_error_unit, & store_warning @@ -247,7 +249,7 @@ module GwfCsubModule procedure, private :: csub_read_packagedata ! ! -- helper methods - procedure, private :: csub_calc_void + procedure, private :: csub_calc_void_ratio procedure, private :: csub_calc_theta procedure, private :: csub_calc_znode procedure, private :: csub_calc_adjes @@ -1923,7 +1925,7 @@ subroutine csub_fp(this) write (msg, '(1x,a,1x,i0,1x,a,1x,i0,1x,a)') & 'LARGEST', (i1 - i0 + 1), 'OF', this%ninterbeds, & 'INTERBED STRAIN VALUES SHOWN' - call sim_message(msg, this%iout, skipbefore=1) + call write_message(msg, this%iout, skipbefore=1) ! ! -- interbed strain data ! -- set title @@ -2113,7 +2115,7 @@ subroutine csub_fp(this) write (msg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & 'LARGEST ', (i1 - i0 + 1), 'OF', this%dis%nodes, & 'CELL COARSE-GRAINED VALUES SHOWN' - call sim_message(msg, this%iout, skipbefore=1) + call write_message(msg, this%iout, skipbefore=1) ! ! -- set title title = trim(adjustl(this%packName))// & @@ -2873,7 +2875,7 @@ subroutine csub_fc(this, kiter, hold, hnew, matrix_sln, idxglo, rhs) rhs(node) = rhs(node) + rhsterm ! ! -- calculate interbed water compressibility terms - if (this%brg /= DZERO .and. idelay == 0) then + if (.not. is_close(this%brg, DZERO) .and. idelay == 0) then call this%csub_nodelay_wcomp_fc(ib, node, tled, area, & hnew(node), hold(node), & hcof, rhsterm) @@ -3691,10 +3693,14 @@ subroutine csub_ot_dv(this, idvfl, idvprint) integer(I4B) :: nodem integer(I4B) :: nodeu integer(I4B) :: i + integer(I4B) :: ii + integer(I4B) :: idx_conn integer(I4B) :: k integer(I4B) :: ncpl integer(I4B) :: nlay + integer(I4B) :: ihc real(DP) :: dinact + real(DP) :: va_scale ! -- formats character(len=*), parameter :: fmtnconv = & "(/4x, 'DELAY INTERBED CELL HEADS IN ', i0, ' INTERBEDS IN', & @@ -3752,7 +3758,26 @@ subroutine csub_ot_dv(this, idvfl, idvprint) ! ! -- disu if (this%dis%ndim == 1) then - ! TO DO - + do node = this%dis%nodes, 1, -1 + do ii = this%dis%con%ia(node) + 1, this%dis%con%ia(node + 1) - 1 + ! + ! -- Set the m cell number + nodem = this%dis%con%ja(ii) + idx_conn = this%dis%con%jas(ii) + ! + ! -- vertical connection + ihc = this%dis%con%ihc(idx_conn) + if (ihc == 0) then + ! + ! -- node has an underlying cell + if (node < nodem) then + va_scale = this%dis%get_area_factor(node, idx_conn) + this%buffusr(node) = this%buffusr(node) + & + va_scale * this%buffusr(nodem) + end if + end if + end do + end do ! -- disv or dis else nlay = this%dis%nodesuser / ncpl @@ -3929,7 +3954,7 @@ subroutine csub_cg_calc_stress(this, nodes, hnew) integer(I4B) :: ii integer(I4B) :: nn integer(I4B) :: m - integer(I4B) :: iis + integer(I4B) :: idx_conn real(DP) :: gs real(DP) :: top real(DP) :: bot @@ -3938,11 +3963,8 @@ subroutine csub_cg_calc_stress(this, nodes, hnew) real(DP) :: hcell real(DP) :: hbar real(DP) :: gs_conn - real(DP) :: area_node - real(DP) :: area_conn real(DP) :: es real(DP) :: phead - real(DP) :: hwva real(DP) :: sadd ! ! -- calculate geostatic stress if necessary @@ -3986,9 +4008,6 @@ subroutine csub_cg_calc_stress(this, nodes, hnew) ! ! -- calculate geostatic stress above cell do node = 1, this%dis%nodes - ! - ! -- area of cell - area_node = this%dis%get_area(node) ! ! -- geostatic stress of cell gs = this%cg_gs(node) @@ -3999,10 +4018,10 @@ subroutine csub_cg_calc_stress(this, nodes, hnew) ! ! -- Set the m cell number m = this%dis%con%ja(ii) - iis = this%dis%con%jas(ii) + idx_conn = this%dis%con%jas(ii) ! ! -- vertical connection - if (this%dis%con%ihc(iis) == 0) then + if (this%dis%con%ihc(idx_conn) == 0) then ! ! -- node has an overlying cell if (m < node) then @@ -4012,15 +4031,11 @@ subroutine csub_cg_calc_stress(this, nodes, hnew) gs = gs + this%cg_gs(m) ! ! -- disu discretization - ! *** this needs to be checked *** else - area_conn = this%dis%get_area(m) - hwva = this%dis%con%hwva(iis) - va_scale = this%dis%con%hwva(iis) / this%dis%get_area(m) + va_scale = this%dis%get_area_factor(node, idx_conn) gs_conn = this%cg_gs(m) gs = gs + (gs_conn * va_scale) end if - end if end if end do @@ -4356,7 +4371,7 @@ subroutine csub_set_initial_state(this, nodes, hnew) real(DP) :: fact real(DP) :: top real(DP) :: bot - real(DP) :: void + real(DP) :: void_ratio real(DP) :: es real(DP) :: znode real(DP) :: hcell @@ -4450,7 +4465,7 @@ subroutine csub_set_initial_state(this, nodes, hnew) ! -- convert specific storage values since they are simulated to ! be a function of the average effective stress else - void = this%csub_calc_void(this%cg_theta(node)) + void_ratio = this%csub_calc_void_ratio(this%cg_theta(node)) es = this%cg_es(node) hcell = hnew(node) ! @@ -4460,7 +4475,7 @@ subroutine csub_set_initial_state(this, nodes, hnew) ! -- calculate znode and factor znode = this%csub_calc_znode(top, bot, hbar) fact = this%csub_calc_adjes(node, es, bot, znode) - fact = fact * (DONE + void) + fact = fact * (DONE + void_ratio) end if ! ! -- user-specified compression indices - multiply by dlog10es @@ -4496,7 +4511,7 @@ subroutine csub_set_initial_state(this, nodes, hnew) ! -- convert specific storage values since they are simulated to ! be a function of the average effective stress else - void = this%csub_calc_void(this%theta(ib)) + void_ratio = this%csub_calc_void_ratio(this%theta(ib)) es = this%cg_es(node) hcell = hnew(node) ! @@ -4506,7 +4521,7 @@ subroutine csub_set_initial_state(this, nodes, hnew) ! -- calculate zone and factor znode = this%csub_calc_znode(top, bot, hbar) fact = this%csub_calc_adjes(node, es, bot, znode) - fact = fact * (DONE + void) + fact = fact * (DONE + void_ratio) end if ! ! -- user-specified compression indices - multiply by dlog10es @@ -5426,18 +5441,18 @@ end subroutine csub_nodelay_wcomp_fn !! !! @return void void ratio !< - function csub_calc_void(this, theta) result(void) + function csub_calc_void_ratio(this, theta) result(void_ratio) ! -- dummy variables class(GwfCsubType), intent(inout) :: this real(DP), intent(in) :: theta !< porosity ! -- local variables - real(DP) :: void + real(DP) :: void_ratio ! -- calculate void ratio - void = theta / (DONE - theta) + void_ratio = theta / (DONE - theta) ! ! -- return return - end function csub_calc_void + end function csub_calc_void_ratio !> @brief Calculate the porosity !! @@ -5445,15 +5460,15 @@ end function csub_calc_void !! !! @return theta porosity !< - function csub_calc_theta(this, void) result(theta) + function csub_calc_theta(this, void_ratio) result(theta) ! -- dummy variables class(GwfCsubType), intent(inout) :: this - real(DP), intent(in) :: void + real(DP), intent(in) :: void_ratio ! -- local variables real(DP) :: theta ! ! -- calculate theta - theta = void / (DONE + void) + theta = void_ratio / (DONE + void_ratio) ! ! -- return return @@ -5678,10 +5693,10 @@ subroutine csub_calc_sfacts(this, node, bot, znode, theta, es, es0, fact) real(DP), intent(in) :: theta !< porosity real(DP), intent(in) :: es !< current effective stress real(DP), intent(in) :: es0 !< previous effective stress - real(DP), intent(inout) :: fact !< skeletal storage coefficient factor (1/((1+void)*bar(es))) + real(DP), intent(inout) :: fact !< skeletal storage coefficient factor (1/((1+void_ratio)*bar(es))) ! -- local variables real(DP) :: esv - real(DP) :: void + real(DP) :: void_ratio real(DP) :: denom ! ! -- initialize variables @@ -5693,9 +5708,9 @@ subroutine csub_calc_sfacts(this, node, bot, znode, theta, es, es0, fact) end if ! ! -- calculate storage factors for the effective stress case - void = this%csub_calc_void(theta) + void_ratio = this%csub_calc_void_ratio(theta) denom = this%csub_calc_adjes(node, esv, bot, znode) - denom = denom * (DONE + void) + denom = denom * (DONE + void_ratio) if (denom /= DZERO) then fact = DONE / denom end if @@ -5720,18 +5735,18 @@ subroutine csub_adj_matprop(this, comp, thick, theta) real(DP), intent(inout) :: theta !< porosity ! -- local variables real(DP) :: strain - real(DP) :: void + real(DP) :: void_ratio ! ! -- initialize variables strain = DZERO - void = this%csub_calc_void(theta) + void_ratio = this%csub_calc_void_ratio(theta) ! ! -- calculate strain if (thick > DZERO) strain = -comp / thick ! ! -- update void ratio, theta, and thickness - void = void + strain * (DONE + void) - theta = this%csub_calc_theta(void) + void_ratio = void_ratio + strain * (DONE + void_ratio) + theta = this%csub_calc_theta(void_ratio) thick = thick - comp ! ! -- return diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90 index f13f34ee9f9..5ddb0adb81b 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8.f90 @@ -1,15 +1,20 @@ module GwfDisModule use ArrayReadersModule, only: ReadArray - use KindModule, only: DP, I4B - use ConstantsModule, only: LINELENGTH, DHALF, DZERO, LENMEMPATH, LENVARNAME + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LINELENGTH, DHALF, DONE, DZERO, & + LENMEMPATH, LENVARNAME use BaseDisModule, only: DisBaseType - use InputOutputModule, only: get_node, URWORD, ulasav, ulaprufw, ubdsv1, & - ubdsv06 + use GeomUtilModule, only: get_node, get_ijk + use InputOutputModule, only: URWORD, ulasav, ulaprufw, & + ubdsv1, ubdsv06, urword, getunit, openfile use SimModule, only: count_errors, store_error, store_error_unit, & store_error_filename - use MemoryManagerModule, only: mem_allocate + use SimVariablesModule, only: errmsg, idm_context + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use MemoryManagerExtModule, only: mem_set_value, memorylist_remove use TdisModule, only: kstp, kper, pertim, totim, delt + use GwfDisInputModule, only: GwfDisParamFoundType implicit none private @@ -27,7 +32,9 @@ module GwfDisModule real(DP), dimension(:, :, :), pointer :: botm => null() ! top and bottom elevations for each cell (ncol, nrow, nlay) real(DP), dimension(:), pointer, contiguous :: cellx => null() ! cell center x coordinate for column j real(DP), dimension(:), pointer, contiguous :: celly => null() ! cell center y coordinate for row i + contains + procedure :: dis_df => dis3d_df procedure :: dis_da => dis3d_da procedure :: get_dis_type => get_dis_type @@ -44,6 +51,7 @@ module GwfDisModule procedure :: nodeu_from_cellid procedure :: supports_layers procedure :: get_ncpl + procedure :: get_polyverts procedure :: connection_vector procedure :: connection_normal ! -- private @@ -65,16 +73,9 @@ module GwfDisModule contains + !> @brief Create a new structured discretization object + !< subroutine dis_cr(dis, name_model, input_mempath, inunit, iout) -! ****************************************************************************** -! dis_cr -- Create a new discretization 3d object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use KindModule, only: LGP - use MemoryManagerExtModule, only: mem_set_value ! -- dummy class(DisBaseType), pointer :: dis character(len=*), intent(in) :: name_model @@ -83,22 +84,17 @@ subroutine dis_cr(dis, name_model, input_mempath, inunit, iout) integer(I4B), intent(in) :: iout ! -- locals type(GwfDisType), pointer :: disnew - logical(LGP) :: found_fname + ! -- formats character(len=*), parameter :: fmtheader = & "(1X, /1X, 'DIS -- STRUCTURED GRID DISCRETIZATION PACKAGE,', & &' VERSION 2 : 3/27/2014 - INPUT READ FROM MEMPATH: ', A, /)" -! ------------------------------------------------------------------------------ + ! allocate (disnew) dis => disnew - call disnew%allocate_scalars(name_model) - dis%input_mempath = input_mempath + call disnew%allocate_scalars(name_model, input_mempath) dis%inunit = inunit dis%iout = iout ! - ! -- set name of input file - call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, & - found_fname) - ! ! -- If dis enabled if (inunit > 0) then ! @@ -108,22 +104,14 @@ subroutine dis_cr(dis, name_model, input_mempath, inunit, iout) end if end if ! - ! -- Return - return end subroutine dis_cr + !> @brief Define the discretization + !< subroutine dis3d_df(this) -! ****************************************************************************** -! dis3d_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisType) :: this - ! -- locals -! ------------------------------------------------------------------------------ + ! ! -- Transfer the data from the memory manager into this package object if (this%inunit /= 0) then ! @@ -140,25 +128,13 @@ subroutine dis3d_df(this) ! -- Final grid initialization call this%grid_finalize() ! - ! -- Return - return end subroutine dis3d_df + !> @brief Deallocate variables + !< subroutine dis3d_da(this) -! ****************************************************************************** -! dis3d_da -- Deallocate discretization data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_deallocate - use MemoryManagerExtModule, only: memorylist_remove - use SimVariablesModule, only: idm_context ! -- dummy class(GwfDisType) :: this - ! -- locals -! ------------------------------------------------------------------------------ ! ! -- Deallocate idm memory call memorylist_remove(this%name_model, 'DIS', idm_context) @@ -182,16 +158,11 @@ subroutine dis3d_da(this) call mem_deallocate(this%bot3d) call mem_deallocate(this%idomain) ! - ! -- Return - return end subroutine dis3d_da !> @brief Copy options from IDM into package !< subroutine source_options(this) - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this ! -- locals @@ -212,50 +183,46 @@ subroutine source_options(this) call this%log_options(found) end if ! - ! -- Return - return end subroutine source_options !> @brief Write user options to list file !< subroutine log_options(this, found) - use GwfDisInputModule, only: GwfDisParamFoundType + ! -- dummy class(GwfDisType) :: this type(GwfDisParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Options' - + ! if (found%length_units) then write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if - + ! if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & &set as ', this%nogrb end if - + ! if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - + ! if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - + ! if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Options' - + ! end subroutine log_options !> @brief Copy dimensions from IDM into package !< subroutine source_dimensions(this) - use MemoryManagerExtModule, only: mem_set_value - use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this ! -- locals @@ -312,51 +279,39 @@ subroutine source_dimensions(this) end do end do ! - ! -- Return - return end subroutine source_dimensions !> @brief Write dimensions to list file !< subroutine log_dimensions(this, found) - use GwfDisInputModule, only: GwfDisParamFoundType + ! -- dummy class(GwfDisType) :: this type(GwfDisParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - + ! if (found%nlay) then write (this%iout, '(4x,a,i0)') 'NLAY = ', this%nlay end if - + ! if (found%nrow) then write (this%iout, '(4x,a,i0)') 'NROW = ', this%nrow end if - + ! if (found%ncol) then write (this%iout, '(4x,a,i0)') 'NCOL = ', this%ncol end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Dimensions' - + ! end subroutine log_dimensions + !> @brief Copy grid data from IDM into package + !< subroutine source_griddata(this) -! ****************************************************************************** -! source_griddata -- update simulation mempath griddata -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this - ! -- locals type(GwfDisParamFoundType) :: found - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%delr, 'DELR', this%input_mempath, found%delr) @@ -370,57 +325,49 @@ subroutine source_griddata(this) call this%log_griddata(found) end if ! - ! -- Return - return end subroutine source_griddata !> @brief Write dimensions to list file !< subroutine log_griddata(this, found) - use GwfDisInputModule, only: GwfDisParamFoundType + ! -- dummy class(GwfDisType) :: this type(GwfDisParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - + ! if (found%delr) then write (this%iout, '(4x,a)') 'DELR set from input file' end if - + ! if (found%delc) then write (this%iout, '(4x,a)') 'DELC set from input file' end if - + ! if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - + ! if (found%botm) then write (this%iout, '(4x,a)') 'BOTM set from input file' end if - + ! if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Griddata' - + ! end subroutine log_griddata + !> @brief Finalize grid (check properties, allocate arrays, compute connections) + !< subroutine grid_finalize(this) -! ****************************************************************************** -! grid_finalize -- Finalize grid -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use ConstantsModule, only: LINELENGTH, DZERO use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfDisType) :: this ! -- locals - character(len=300) :: ermsg integer(I4B) :: n, i, j, k integer(I4B) :: node integer(I4B) :: noder @@ -435,7 +382,6 @@ subroutine grid_finalize(this) "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& &/1x, 'Number of user nodes: ',I0,& &/1X, 'Number of nodes in solution: ', I0, //)" -! ------------------------------------------------------------------------------ ! ! -- count active cells this%nodes = 0 @@ -469,8 +415,8 @@ subroutine grid_finalize(this) dz = top - this%bot3d(j, i, k) if (dz <= DZERO) then n = n + 1 - write (ermsg, fmt=fmtdz) k, i, j, top, this%bot3d(j, i, k) - call store_error(ermsg) + write (errmsg, fmt=fmtdz) k, i, j, top, this%bot3d(j, i, k) + call store_error(errmsg) end if end do end do @@ -576,21 +522,13 @@ subroutine grid_finalize(this) this%nja = this%con%nja this%njas = this%con%njas ! - ! -- Return - return end subroutine grid_finalize + !> @brief Write a binary grid file + !< subroutine write_grb(this, icelltype) -! ****************************************************************************** -! write_grb -- Write the binary grid file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: getunit, openfile use OpenSpecModule, only: access, form - use ConstantsModule, only: DZERO ! -- dummy class(GwfDisType) :: this integer(I4B), dimension(:), intent(in) :: icelltype @@ -603,7 +541,6 @@ subroutine write_grb(this, icelltype) character(len=*), parameter :: fmtgrdsave = & "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', & &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)" -! ------------------------------------------------------------------------------ ! ! -- Initialize ntxt = 16 @@ -701,27 +638,18 @@ subroutine write_grb(this, icelltype) ! -- Close the file close (iunit) ! - ! -- return - return end subroutine write_grb + !> @brief Convert a user nodenumber to a string (nodenumber) or (k,i,j) + !< subroutine nodeu_to_string(this, nodeu, str) -! ****************************************************************************** -! nodeu_to_string -- Convert user node number to a string in the form of -! (nodenumber) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_ijk - implicit none + ! -- dummy class(GwfDisType) :: this integer(I4B), intent(in) :: nodeu character(len=*), intent(inout) :: str ! -- local integer(I4B) :: i, j, k character(len=10) :: kstr, istr, jstr -! ------------------------------------------------------------------------------ ! call get_ijk(nodeu, this%nrow, this%ncol, this%nlay, i, j, k) write (kstr, '(i10)') k @@ -731,28 +659,18 @@ subroutine nodeu_to_string(this, nodeu, str) trim(adjustl(istr))//','// & trim(adjustl(jstr))//')' ! - ! -- return - return end subroutine nodeu_to_string + !> @brief Convert a user nodenumber to an array (nodenumber) or (k,i,j) + !< subroutine nodeu_to_array(this, nodeu, arr) -! ****************************************************************************** -! nodeu_to_array -- Convert user node number to cellid and fill array with -! (nodenumber) or (k,j) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_ijk - implicit none + ! -- dummy class(GwfDisType) :: this integer(I4B), intent(in) :: nodeu integer(I4B), dimension(:), intent(inout) :: arr ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: isize integer(I4B) :: i, j, k -! ------------------------------------------------------------------------------ ! ! -- check the size of arr isize = size(arr) @@ -771,37 +689,26 @@ subroutine nodeu_to_array(this, nodeu, arr) arr(2) = i arr(3) = j ! - ! -- return - return end subroutine nodeu_to_array + !> @brief Get reduced node number from user node number + !< function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber -- Return a nodenumber from the user specified node number -! with an option to perform a check. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH ! -- return integer(I4B) :: nodenumber ! -- dummy class(GwfDisType), intent(in) :: this integer(I4B), intent(in) :: nodeu integer(I4B), intent(in) :: icheck - ! -- local - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ ! ! -- check the node number if requested if (icheck /= 0) then ! ! -- If within valid range, convert to reduced nodenumber if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, '(a,i10)') & - 'Nodenumber less than 1 or greater than nodes:', nodeu + write (errmsg, '(a,i0,a)') & + 'Node number (', nodeu, & + ') less than 1 or greater than the number of nodes.' call store_error(errmsg) nodenumber = 0 else @@ -813,22 +720,11 @@ function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu) end if ! - ! -- return - return end function get_nodenumber_idx1 - function get_nodenumber_idx3(this, k, i, j, icheck) & - result(nodenumber) -! ****************************************************************************** -! get_nodenumber_idx3 -- Return a nodenumber from the user specified layer, row, -! and column with an option to perform a check. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: LINELENGTH - use InputOutputModule, only: get_node - implicit none + !> @brief Get reduced node number from layer, row and column indices + !< + function get_nodenumber_idx3(this, k, i, j, icheck) result(nodenumber) ! -- return integer(I4B) :: nodenumber ! -- dummy @@ -836,13 +732,11 @@ function get_nodenumber_idx3(this, k, i, j, icheck) & integer(I4B), intent(in) :: k, i, j integer(I4B), intent(in) :: icheck ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: nodeu ! formats character(len=*), parameter :: fmterr = & "('Error in structured-grid cell indices: layer = ',i0,', & &row = ',i0,', column = ',i0)" -! ------------------------------------------------------------------------------ ! nodeu = get_node(k, i, j, this%nlay, this%nrow, this%ncol) if (nodeu < 1) then @@ -864,31 +758,24 @@ function get_nodenumber_idx3(this, k, i, j, icheck) & ! ! -- Error if outside of range if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, '(a,i10)') & - 'Nodenumber less than 1 or greater than nodes:', nodeu + write (errmsg, '(a,i0,a)') & + 'Node number (', nodeu, ')less than 1 or greater than nodes.' call store_error(errmsg) end if end if ! - ! -- return - return end function get_nodenumber_idx3 - subroutine allocate_scalars(this, name_model) -! ****************************************************************************** -! allocate_scalars -- Allocate and initialize scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules + !> @brief Allocate and initialize scalar variables + !< + subroutine allocate_scalars(this, name_model, input_mempath) ! -- dummy class(GwfDisType) :: this character(len=*), intent(in) :: name_model -! ------------------------------------------------------------------------------ + character(len=*), intent(in) :: input_mempath ! ! -- Allocate parent scalars - call this%DisBaseType%allocate_scalars(name_model) + call this%DisBaseType%allocate_scalars(name_model, input_mempath) ! ! -- Allocate call mem_allocate(this%nlay, 'NLAY', this%memoryPath) @@ -901,22 +788,13 @@ subroutine allocate_scalars(this, name_model) this%ncol = 0 this%ndim = 3 ! - ! -- Return - return end subroutine allocate_scalars + !> @brief Allocate and initialize arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfDisType) :: this -! ------------------------------------------------------------------------------ ! ! -- Allocate arrays in DisBaseType (mshape, top, bot, area) call this%DisBaseType%allocate_arrays() @@ -936,22 +814,16 @@ subroutine allocate_arrays(this) this%mshape(2) = this%nrow this%mshape(3) = this%ncol ! - ! -- Return - return end subroutine allocate_arrays + !> @brief Convert a string to a user nodenumber + !! + !! Parse layer, row and column and return user nodenumber. + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !< function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & flag_string, allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_string -- Receive a string and convert the string to a user -! nodenumber. The model discretization is DIS; read layer, row, and column. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisType) :: this integer(I4B), intent(inout) :: lloc @@ -967,8 +839,6 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & integer(I4B) :: k, i, j, nlay, nrow, ncol integer(I4B) :: lloclocal, ndum, istat, n real(DP) :: r - character(len=LINELENGTH) :: ermsg, fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1001,51 +871,50 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & end if end if ! + errmsg = "" + ! if (k < 1 .or. k > nlay) then - write (ermsg, *) ' Layer number in list is outside of the grid', k - call store_error(ermsg) + write (errmsg, '(a,i0,a)') & + 'Layer number in list (', k, ') is outside of the grid.' end if if (i < 1 .or. i > nrow) then - write (ermsg, *) ' Row number in list is outside of the grid', i - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Row number in list (', i, & + ') is outside of the grid.' end if if (j < 1 .or. j > ncol) then - write (ermsg, *) ' Column number in list is outside of the grid', j - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Column number in list (', j, & + ') is outside of the grid.' end if + ! nodeu = get_node(k, i, j, nlay, nrow, ncol) ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (ermsg, *) ' Node number in list is outside of the grid', nodeu - call store_error(ermsg) - inquire (unit=in, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in line: ') - call store_error(trim(adjustl(line))) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), & + "Node number in list (", nodeu, ") is outside of the grid. "// & + "Cell number cannot be determined in line '"// & + trim(adjustl(line))//"'." + end if + ! + if (len_trim(adjustl(errmsg)) > 0) then + call store_error(errmsg) call store_error_unit(in) end if ! - ! -- return - return - end function nodeu_from_string + !> @brief Convert a cellid string to a user nodenumber + !! + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !! + !! If allow_zero is present and true, and all indices are zero, the + !! result can be zero. If allow_zero is false, a zero in any index is an error. + !< function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_cellid -- Receive cellid as a string and convert the string to a -! user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! If allow_zero argument is present and true, if all indices equal zero, the -! result can be zero. If allow_zero is false, a zero in any index causes an -! error. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: nodeu ! -- dummy @@ -1060,8 +929,6 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & integer(I4B) :: k, i, j, nlay, nrow, ncol integer(I4B) :: istat real(DP) :: r - character(len=LINELENGTH) :: ermsg, fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1095,84 +962,69 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & end if end if ! + errmsg = "" + ! if (k < 1 .or. k > nlay) then - write (ermsg, *) ' Layer number in list is outside of the grid', k - call store_error(ermsg) + write (errmsg, '(a,i0,a)') & + 'Layer number in list (', k, ') is outside of the grid.' end if if (i < 1 .or. i > nrow) then - write (ermsg, *) ' Row number in list is outside of the grid', i - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Row number in list (', i, & + ') is outside of the grid.' end if if (j < 1 .or. j > ncol) then - write (ermsg, *) ' Column number in list is outside of the grid', j - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Column number in list (', j, & + ') is outside of the grid.' end if + ! nodeu = get_node(k, i, j, nlay, nrow, ncol) ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (ermsg, *) ' Node number in list is outside of the grid', nodeu - call store_error(ermsg) - inquire (unit=inunit, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in cellid: ') - call store_error(trim(adjustl(cellid))) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), & + "Cell number cannot be determined for cellid ("// & + trim(adjustl(cellid))//") and results in a user "// & + "node number (", nodeu, ") that is outside of the grid." + end if + ! + if (len_trim(adjustl(errmsg)) > 0) then + call store_error(errmsg) call store_error_unit(inunit) end if ! - ! -- return - return end function nodeu_from_cellid + !> @brief Indicates whether the grid discretization supports layers + !< logical function supports_layers(this) - implicit none ! -- dummy class(GwfDisType) :: this ! supports_layers = .true. - return + ! end function supports_layers + !> @brief Return number of cells per layer (nrow * ncol) + !< function get_ncpl(this) -! ****************************************************************************** -! get_ncpl -- Return number of cells per layer. This is nrow * ncol -! for a DIS3D grid. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return integer(I4B) :: get_ncpl - ! -- dummy class(GwfDisType) :: this -! ------------------------------------------------------------------------------ - ! get_ncpl = this%nrow * this%ncol - ! - ! -- Return - return end function get_ncpl + !> @brief Get normal vector components between the cell and a given neighbor + !! + !! The normal points outward from the shared face between noden and nodem. + !< subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ipos) -! ****************************************************************************** -! connection_normal -- calculate the normal vector components for reduced -! nodenumber cell (noden) and its shared face with cell nodem. ihc is the -! horizontal connection flag. Connection normal is a normal vector pointing -! outward from the shared face between noden and nodem. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: DZERO, DONE - use InputOutputModule, only: get_ijk ! -- dummy class(GwfDisType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp @@ -1180,7 +1032,6 @@ subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ! -- local integer(I4B) :: nodeu1, i1, j1, k1 integer(I4B) :: nodeu2, i2, j2, k2 -! ------------------------------------------------------------------------------ ! ! -- Set vector components based on ihc if (ihc == 0) then @@ -1215,33 +1066,25 @@ subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ! end if ! - ! -- return - return end subroutine connection_normal + !> @brief Get unit vector components between the cell and a given neighbor + !! + !! Saturation must be provided to compute cell center vertical coordinates. + !! Also return the straight-line connection length. + !< subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & xcomp, ycomp, zcomp, conlen) -! ****************************************************************************** -! connection_vector -- calculate the unit vector components from reduced -! nodenumber cell (noden) to its neighbor cell (nodem). The saturation for -! for these cells are also required so that the vertical position of the cell -! cell centers can be calculated. ihc is the horizontal flag. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use ConstantsModule, only: DZERO, DONE, DHALF use DisvGeom, only: line_unit_vector - use InputOutputModule, only: get_ijk ! -- dummy class(GwfDisType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) logical, intent(in) :: nozee real(DP), intent(in) :: satn real(DP), intent(in) :: satm - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp @@ -1252,7 +1095,6 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & real(DP) :: ds integer(I4B) :: i1, i2, j1, j2, k1, k2 integer(I4B) :: nodeu1, nodeu2, ipos -! ------------------------------------------------------------------------------ ! ! -- Set vector components based on ihc if (ihc == 0) then @@ -1299,30 +1141,72 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & call line_unit_vector(x1, y1, z1, x2, y2, z2, xcomp, ycomp, zcomp, conlen) end if ! - ! -- return - return end subroutine - ! return discretization type + !> @brief Get the discretization type + !< subroutine get_dis_type(this, dis_type) + ! -- dummy class(GwfDisType), intent(in) :: this character(len=*), intent(out) :: dis_type - + ! dis_type = "DIS" - + ! end subroutine get_dis_type + !> @brief Get a 2D array of polygon vertices, listed in + !! + !! clockwise order beginning with the lower left corner + !< + subroutine get_polyverts(this, ic, polyverts, closed) + ! -- dummy + class(GwfDisType), intent(inout) :: this + integer(I4B), intent(in) :: ic !< cell number (reduced) + real(DP), allocatable, intent(out) :: polyverts(:, :) !< polygon vertices (column-major indexing) + logical(LGP), intent(in), optional :: closed !< whether to close the polygon, duplicating a vertex + ! -- local + integer(I4B) :: icu, nverts, irow, jcol, klay + real(DP) :: cellx, celly, dxhalf, dyhalf + logical(LGP) :: lclosed + ! + nverts = 4 + ! + ! check closed option + if (.not. (present(closed))) then + lclosed = .false. + else + lclosed = closed + end if + ! + ! allocate vertices array + if (lclosed) then + allocate (polyverts(2, nverts + 1)) + else + allocate (polyverts(2, nverts)) + end if + ! + ! set vertices + icu = this%get_nodeuser(ic) + call get_ijk(icu, this%nrow, this%ncol, this%nlay, irow, jcol, klay) + cellx = this%cellx(jcol) + celly = this%celly(irow) + dxhalf = DHALF * this%delr(jcol) + dyhalf = DHALF * this%delc(irow) + polyverts(:, 1) = (/cellx - dxhalf, celly - dyhalf/) ! SW + polyverts(:, 2) = (/cellx - dxhalf, celly + dyhalf/) ! NW + polyverts(:, 3) = (/cellx + dxhalf, celly + dyhalf/) ! NE + polyverts(:, 4) = (/cellx + dxhalf, celly - dyhalf/) ! SE + ! + ! close if enabled + if (lclosed) & + polyverts(:, nverts + 1) = polyverts(:, 1) + ! + end subroutine + + !> @brief Read an integer array + !< subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & iarray, aname) -! ****************************************************************************** -! read_int_array -- Read a GWF integer array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: urword - use ConstantsModule, only: LINELENGTH ! -- dummy class(GwfDisType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1341,7 +1225,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & integer(I4B) :: ncol integer(I4B) :: nval integer(I4B), dimension(:), pointer, contiguous :: itemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to ibuff if it is a @@ -1377,21 +1260,12 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(itemp, iarray) end if ! - ! -- return - return end subroutine read_int_array + !> @brief Read a double precision array + !< subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & darray, aname) -! ****************************************************************************** -! read_dbl_array -- Read a GWF double precision array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: urword - use ConstantsModule, only: LINELENGTH ! -- dummy class(GwfDisType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1410,7 +1284,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & integer(I4B) :: ncol integer(I4B) :: nval real(DP), dimension(:), pointer, contiguous :: dtemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to dbuff if it is a @@ -1446,22 +1319,15 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(dtemp, darray) end if ! - ! -- return - return end subroutine read_dbl_array + !> @brief Read a 2d double array into col icolbnd of darray + !! + !! For cells that are outside of the active domain, + !! do not copy the array value into darray. + !< subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & icolbnd, aname, inunit, iout) -! ****************************************************************************** -! read_layer_array -- Read a 2d double array into col icolbnd of darray. -! For cells that are outside of the active domain, -! do not copy the array value into darray. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_node ! -- dummy class(GwfDisType) :: this integer(I4B), intent(in) :: maxbnd @@ -1474,7 +1340,6 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: ir, ic, ncol, nrow, nlay, nval, ipos, nodeu -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1500,44 +1365,27 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & end do end do ! - ! -- return end subroutine read_layer_array + !> @brief Record a double precision array. + !! + !! The array is written to a formatted or unformatted external file + !! depending on the arguments. + !< subroutine record_array(this, darray, iout, iprint, idataun, aname, & cdatafmp, nvaluesp, nwidthp, editdesc, dinact) -! ****************************************************************************** -! record_array -- Record a double precision array. The array will be -! printed to an external file and/or written to an unformatted external file -! depending on the argument specifications. -! ****************************************************************************** -! -! SPECIFICATIONS: -! darray is the double precision array to record -! iout is the unit number for ascii output -! iprint is a flag indicating whether or not to print the array -! idataun is the unit number to which the array will be written in binary -! form; if negative then do not write by layers, write entire array -! aname is the text descriptor of the array -! cdatafmp is the fortran format for writing the array -! nvaluesp is the number of values per line for printing -! nwidthp is the width of the number for printing -! editdesc is the format type (I, G, F, S, E) -! dinact is the double precision value to use for cells that are excluded -! from the model domain -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisType), intent(inout) :: this - real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray - integer(I4B), intent(in) :: iout - integer(I4B), intent(in) :: iprint - integer(I4B), intent(in) :: idataun - character(len=*), intent(in) :: aname - character(len=*), intent(in) :: cdatafmp - integer(I4B), intent(in) :: nvaluesp - integer(I4B), intent(in) :: nwidthp - character(len=*), intent(in) :: editdesc - real(DP), intent(in) :: dinact + real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record + integer(I4B), intent(in) :: iout !< ascii output unit number + integer(I4B), intent(in) :: iprint !< whether to print the array + integer(I4B), intent(in) :: idataun !< binary output unit number, if negative don't write by layers, write entire array + character(len=*), intent(in) :: aname !< text descriptor + character(len=*), intent(in) :: cdatafmp !< write format + integer(I4B), intent(in) :: nvaluesp !< values per line + integer(I4B), intent(in) :: nwidthp !< number width + character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E) + real(DP), intent(in) :: dinact !< double precision value for cells excluded from model domain ! -- local integer(I4B) :: k, ifirst integer(I4B) :: nlay @@ -1551,7 +1399,6 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & character(len=*), parameter :: fmthsv = & "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, & &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)" -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1609,19 +1456,13 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & iout, delt, pertim, totim) end if ! - ! -- return - return end subroutine record_array + !> @brief Record list header for imeth=6 + !< subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & dstmodel, dstpackage, naux, auxtxt, & ibdchn, nlist, iout) -! ****************************************************************************** -! record_srcdst_list_header -- Record list header for imeth=6 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisType) :: this character(len=16), intent(in) :: text @@ -1636,7 +1477,6 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: nlay, nrow, ncol -! ------------------------------------------------------------------------------ ! nlay = this%mshape(1) nrow = this%mshape(2) @@ -1647,35 +1487,20 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & ibdchn, naux, auxtxt, ncol, nrow, nlay, & nlist, iout, delt, pertim, totim) ! - ! -- return - return end subroutine record_srcdst_list_header - subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & - inunit, iout) -! ****************************************************************************** -! nlarray_to_nodelist -- Read an integer array into nodelist. For structured -! model, integer array is layer number; for unstructured -! model, integer array is node number. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_node - use ConstantsModule, only: LINELENGTH + !> @brief Convert an integer array (layer numbers) to nodelist + !< + subroutine nlarray_to_nodelist(this, darray, nodelist, maxbnd, nbound, aname) ! -- dummy class(GwfDisType) :: this integer(I4B), intent(in) :: maxbnd + integer(I4B), dimension(:), pointer, contiguous :: darray integer(I4B), dimension(maxbnd), intent(inout) :: nodelist integer(I4B), intent(inout) :: nbound character(len=*), intent(in) :: aname - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nval, nodeu, noder, ipos, ierr - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1685,8 +1510,6 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & if (this%ndim > 1) then ! nval = ncol * nrow - call ReadArray(inunit, this%ibuff, aname, this%ndim, ncol, nrow, nlay, & - nval, iout, 0, 0) ! ! -- Copy array into nodelist ipos = 1 @@ -1694,9 +1517,9 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & do ir = 1, nrow do ic = 1, ncol nodeu = get_node(1, ir, ic, nlay, nrow, ncol) - il = this%ibuff(nodeu) + il = darray(nodeu) if (il < 1 .or. il > nlay) then - write (errmsg, *) 'INVALID LAYER NUMBER: ', il + write (errmsg, '(a,1x,i0)') 'Invalid layer number:', il call store_error(errmsg, terminate=.TRUE.) end if nodeu = get_node(il, ir, ic, nlay, nrow, ncol) @@ -1713,9 +1536,9 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & ! -- Check for errors nbound = ipos - 1 if (ierr > 0) then - write (errmsg, *) 'MAXBOUND DIMENSION IS TOO SMALL.' - call store_error(errmsg) - write (errmsg, *) 'INCREASE MAXBOUND TO: ', ierr + write (errmsg, '(a,1x,i0)') & + 'MAXBOUND dimension is too small.'// & + 'INCREASE MAXBOUND TO:', ierr call store_error(errmsg, terminate=.TRUE.) end if ! @@ -1729,10 +1552,10 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & else ! ! -- For unstructured, read nodelist directly, then check node numbers - call ReadArray(inunit, nodelist, aname, this%ndim, maxbnd, iout, 0) + nodelist = darray do noder = 1, maxbnd if (noder < 1 .or. noder > this%nodes) then - write (errmsg, *) 'INVALID NODE NUMBER: ', noder + write (errmsg, '(a,1x,i0)') 'Invalid node number:', noder call store_error(errmsg, terminate=.TRUE.) end if end do @@ -1740,7 +1563,6 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & ! end if ! - ! -- return end subroutine nlarray_to_nodelist end module GwfDisModule diff --git a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 index 0c8d8cd90b1..35a4db3f326 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -40,7 +41,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -56,7 +58,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -72,7 +75,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -88,7 +92,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -104,7 +109,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -120,7 +126,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -136,7 +143,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -152,7 +160,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -168,7 +177,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -184,7 +194,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -200,7 +211,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -216,7 +228,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -232,7 +245,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +282,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90 index 003ba6091c8..e5ee2aaac74 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8.f90 @@ -3,15 +3,20 @@ module GwfDisuModule use ArrayReadersModule, only: ReadArray use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME, & - DZERO, DONE + DZERO, DONE, DHALF use ConnectionsModule, only: iac_to_ia - use InputOutputModule, only: URWORD, ulasav, ulaprufw, ubdsv1, ubdsv06 + use InputOutputModule, only: URWORD, ulasav, ulaprufw, ubdsv1, ubdsv06, & + getunit, openfile use SimModule, only: count_errors, store_error, store_error_unit, & store_error_filename - use SimVariablesModule, only: errmsg + use SimVariablesModule, only: errmsg, idm_context use BaseDisModule, only: DisBaseType - use MemoryManagerModule, only: mem_allocate + use MemoryManagerModule, only: mem_allocate, mem_deallocate, & + mem_reallocate, mem_setptr + use MemoryManagerExtModule, only: mem_set_value, memorylist_remove use TdisModule, only: kstp, kper, pertim, totim, delt + use GwfDisuInputModule, only: GwfDisuParamFoundType + use DisvGeom, only: line_unit_vector implicit none @@ -40,7 +45,9 @@ module GwfDisuModule integer(I4B), dimension(:), pointer, contiguous :: javert => null() ! cell vertex pointer ja array integer(I4B), dimension(:), pointer, contiguous :: idomain => null() ! idomain (nodes) logical(LGP) :: readFromFile ! True, when DIS is read from file (almost always) + contains + procedure :: dis_df => disu_df procedure :: disu_load procedure :: dis_da => disu_da @@ -78,20 +85,14 @@ module GwfDisuModule ! -- Read a node-sized model array (reduced or not) procedure :: read_int_array procedure :: read_dbl_array + end type GwfDisuType contains + !> @brief Create a new unstructured discretization object + !< subroutine disu_cr(dis, name_model, input_mempath, inunit, iout) -! ****************************************************************************** -! disu_cr -- Create discretization object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use KindModule, only: LGP - use MemoryManagerExtModule, only: mem_set_value ! -- dummy class(DisBaseType), pointer :: dis character(len=*), intent(in) :: name_model @@ -100,26 +101,19 @@ subroutine disu_cr(dis, name_model, input_mempath, inunit, iout) integer(I4B), intent(in) :: iout ! -- local type(GwfDisuType), pointer :: disnew - logical(LGP) :: found_fname character(len=*), parameter :: fmtheader = & "(1X, /1X, 'DISU -- UNSTRUCTURED GRID DISCRETIZATION PACKAGE,', & &' VERSION 2 : 3/27/2014 - INPUT READ FROM MEMPATH: ', A, //)" -! ------------------------------------------------------------------------------ ! ! -- Create a new discretization object allocate (disnew) dis => disnew ! ! -- Allocate scalars and assign data - call dis%allocate_scalars(name_model) - dis%input_mempath = input_mempath + call dis%allocate_scalars(name_model, input_mempath) dis%inunit = inunit dis%iout = iout ! - ! -- set name of input file - call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, & - found_fname) - ! ! -- If disu is enabled if (inunit > 0) then ! @@ -132,21 +126,13 @@ subroutine disu_cr(dis, name_model, input_mempath, inunit, iout) call disnew%disu_load() end if ! - ! -- Return - return end subroutine disu_cr + !> @brief Transfer IDM data into this discretization object + !< subroutine disu_load(this) -! ****************************************************************************** -! disu_load -- transfer data into this discretization object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType) :: this -! ------------------------------------------------------------------------------ ! ! -- source input data call this%source_options() @@ -167,38 +153,21 @@ subroutine disu_load(this) ! input call this%disu_ck() ! - ! -- Return - return end subroutine disu_load + !> @brief Define the discretization + !< subroutine disu_df(this) -! ****************************************************************************** -! disu_df -- Read discretization information from DISU input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisuType) :: this -! ------------------------------------------------------------------------------ ! - ! -- Finalize the grid by creating the connection object and reducing the - ! grid using IDOMAIN, if necessary call this%grid_finalize() ! - ! -- Return - return end subroutine disu_df + !> @brief Finalize the grid + !< subroutine grid_finalize(this) -! ****************************************************************************** -! grid_finalize -- Finalize grid -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate, mem_reallocate ! -- dummy class(GwfDisuType) :: this ! -- locals @@ -214,7 +183,6 @@ subroutine grid_finalize(this) "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& &/1x, 'Number of user nodes: ',I0,& &/1X, 'Number of nodes in solution: ', I0, //)" -! ------------------------------------------------------------------------------ ! ! -- count active cells this%nodes = 0 @@ -305,18 +273,11 @@ subroutine grid_finalize(this) this%nja = this%con%nja this%njas = this%con%njas ! - ! -- Return - return end subroutine grid_finalize + !> @brief Check discretization info + !< subroutine disu_ck(this) -! ****************************************************************************** -! disu_ck -- Check the discretization information -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType) :: this ! -- local @@ -339,7 +300,6 @@ subroutine disu_ck(this) "('Top elevation (', 1pg15.6, ') for cell ', i0, ' is above bottom & &elevation (', 1pg15.6, ') for cell ', i0, '. Based on node numbering & &rules cell ', i0, ' must be below cell ', i0, '.')" -! ------------------------------------------------------------------------------ ! ! -- Check connectivity do n = 1, this%nodesuser @@ -433,24 +393,13 @@ subroutine disu_ck(this) end if end if ! - ! -- Return - return end subroutine disu_ck + !> @brief Deallocate variables + !< subroutine disu_da(this) -! ****************************************************************************** -! disu_da -- Deallocate discretization object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_deallocate - use MemoryManagerExtModule, only: memorylist_remove - use SimVariablesModule, only: idm_context ! -- dummy class(GwfDisuType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate idm memory call memorylist_remove(this%name_model, 'DISU', idm_context) @@ -480,59 +429,41 @@ subroutine disu_da(this) call mem_deallocate(this%hwvainp) call mem_deallocate(this%angldegxinp) end if - + ! call mem_deallocate(this%idomain) call mem_deallocate(this%cellxy) - + ! call mem_deallocate(this%nodeuser) call mem_deallocate(this%nodereduced) ! ! -- DisBaseType deallocate call this%DisBaseType%dis_da() ! - ! -- Return - return end subroutine disu_da + !> @brief Convert a user nodenumber to a string (nodenumber) + !< subroutine nodeu_to_string(this, nodeu, str) -! ****************************************************************************** -! nodeu_to_string -- Convert user node number to a string in the form of -! (nodenumber) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisuType) :: this integer(I4B), intent(in) :: nodeu character(len=*), intent(inout) :: str ! -- local character(len=10) :: nstr -! ------------------------------------------------------------------------------ ! write (nstr, '(i0)') nodeu str = '('//trim(adjustl(nstr))//')' ! - ! -- return - return end subroutine nodeu_to_string + !> @brief Convert a user nodenumber to an array (nodenumber) + !< subroutine nodeu_to_array(this, nodeu, arr) -! ****************************************************************************** -! nodeu_to_array -- Convert user node number to cellid and fill array with -! (nodenumber) or (k,j) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_ijk - implicit none class(GwfDisuType) :: this integer(I4B), intent(in) :: nodeu integer(I4B), dimension(:), intent(inout) :: arr ! -- local integer(I4B) :: isize -! ------------------------------------------------------------------------------ ! ! -- check the size of arr isize = size(arr) @@ -546,69 +477,57 @@ subroutine nodeu_to_array(this, nodeu, arr) ! -- fill array arr(1) = nodeu ! - ! -- return - return end subroutine nodeu_to_array !> @brief Write user options to list file !< subroutine log_options(this, found) - use GwfDisuInputModule, only: GwfDisuParamFoundType + ! -- dummy class(GwfDisuType) :: this type(GwfDisuParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Options' - + ! if (found%length_units) then write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if - + ! if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & &set as ', this%nogrb end if - + ! if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - + ! if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - + ! if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if - + ! if (found%voffsettol) then write (this%iout, '(4x,a,G0)') 'VERTICAL_OFFSET_TOLERANCE = ', & this%voffsettol end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Options' - + ! end subroutine log_options !> @brief Copy options from IDM into package !< subroutine source_options(this) -! ****************************************************************************** -! source_options -- source options from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals character(len=LENVARNAME), dimension(3) :: lenunits = & &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS'] type(GwfDisuParamFoundType) :: found -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%lenuni, 'LENGTH_UNITS', this%input_mempath, & @@ -625,52 +544,40 @@ subroutine source_options(this) call this%log_options(found) end if ! - ! -- Return - return end subroutine source_options !> @brief Write dimensions to list file !< subroutine log_dimensions(this, found) - use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this type(GwfDisuParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - + ! if (found%nodes) then write (this%iout, '(4x,a,i0)') 'NODES = ', this%nodesuser end if - + ! if (found%nja) then write (this%iout, '(4x,a,i0)') 'NJA = ', this%njausr end if - + ! if (found%nvert) then write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Dimensions' - + ! end subroutine log_dimensions !> @brief Copy dimensions from IDM into package !< subroutine source_dimensions(this) -! ****************************************************************************** -! source_dimensions -- source dimensions from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use MemoryManagerExtModule, only: mem_set_value - use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals integer(I4B) :: n type(GwfDisuParamFoundType) :: found -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%nodesuser, 'NODES', this%input_mempath, found%nodes) @@ -722,55 +629,44 @@ subroutine source_dimensions(this) this%idomain(n) = 1 end do ! - ! -- Return - return end subroutine source_dimensions !> @brief Write griddata found to list file !< subroutine log_griddata(this, found) - use GwfDisuInputModule, only: GwfDisuParamFoundType + ! -- dummy class(GwfDisuType) :: this type(GwfDisuParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - + ! if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - + ! if (found%bot) then write (this%iout, '(4x,a)') 'BOT set from input file' end if - + ! if (found%area) then write (this%iout, '(4x,a)') 'AREA set from input file' end if - + ! if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Griddata' - + ! end subroutine log_griddata + !> @brief Copy grid data from IDM into package + !< subroutine source_griddata(this) -! ****************************************************************************** -! source_griddata -- source griddata from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals type(GwfDisuParamFoundType) :: found - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%top1d, 'TOP', this%input_mempath, found%top) @@ -783,66 +679,54 @@ subroutine source_griddata(this) call this%log_griddata(found) end if ! - ! -- Return - return end subroutine source_griddata !> @brief Write griddata found to list file !< subroutine log_connectivity(this, found, iac) - use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this type(GwfDisuParamFoundType), intent(in) :: found integer(I4B), dimension(:), contiguous, pointer, intent(in) :: iac - + ! write (this%iout, '(1x,a)') 'Setting Discretization Connectivity' - + ! if (associated(iac)) then write (this%iout, '(4x,a)') 'IAC set from input file' end if - + ! if (found%ja) then write (this%iout, '(4x,a)') 'JA set from input file' end if - + ! if (found%ihc) then write (this%iout, '(4x,a)') 'IHC set from input file' end if - + ! if (found%cl12) then write (this%iout, '(4x,a)') 'CL12 set from input file' end if - + ! if (found%hwva) then write (this%iout, '(4x,a)') 'HWVA set from input file' end if - + ! if (found%angldegx) then write (this%iout, '(4x,a)') 'ANGLDEGX set from input file' end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Connectivity' - + ! end subroutine log_connectivity + !> @brief Copy grid connectivity info from IDM into package + !< subroutine source_connectivity(this) -! ****************************************************************************** -! source_connectivity -- source connection data from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_setptr - use MemoryManagerExtModule, only: mem_set_value - use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals type(GwfDisuParamFoundType) :: found integer(I4B), dimension(:), contiguous, pointer :: iac => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%jainp, 'JA', this%input_mempath, found%ja) @@ -866,19 +750,11 @@ subroutine source_connectivity(this) call this%log_connectivity(found, iac) end if ! - ! -- Return - return end subroutine source_connectivity + !> @brief Copy grid vertex data from IDM into package + !< subroutine source_vertices(this) -! ****************************************************************************** -! source_vertices -- source vertex data from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_setptr ! -- dummy class(GwfDisuType) :: this ! -- local @@ -886,7 +762,6 @@ subroutine source_vertices(this) real(DP), dimension(:), contiguous, pointer :: vert_x => null() real(DP), dimension(:), contiguous, pointer :: vert_y => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set pointers to memory manager input arrays call mem_setptr(vert_x, 'XV', this%input_mempath) @@ -907,10 +782,10 @@ subroutine source_vertices(this) write (this%iout, '(1x,a)') 'Discretization Vertex data loaded' end if ! - ! -- Return - return end subroutine source_vertices + !> @brief Build data structures to hold cell vertex info + !< subroutine define_cellverts(this, icell2d, ncvert, icvert) ! -- modules use SparseModule, only: sparsematrix @@ -923,7 +798,6 @@ subroutine define_cellverts(this, icell2d, ncvert, icvert) type(sparsematrix) :: vert_spm integer(I4B) :: i, j, ierr integer(I4B) :: icv_idx, startvert, maxnnz = 5 -! ------------------------------------------------------------------------------ ! ! -- initialize sparse matrix call vert_spm%init(this%nodesuser, this%nvert, maxnnz) @@ -949,19 +823,11 @@ subroutine define_cellverts(this, icell2d, ncvert, icvert) call vert_spm%filliaja(this%iavert, this%javert, ierr) call vert_spm%destroy() ! - ! -- Return - return end subroutine define_cellverts + !> @brief Copy cell2d data from IDM into package + !< subroutine source_cell2d(this) -! ****************************************************************************** -! source_cell2d -- source cell2d data from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_setptr ! -- dummy class(GwfDisuType) :: this ! -- locals @@ -971,8 +837,6 @@ subroutine source_cell2d(this) real(DP), dimension(:), contiguous, pointer :: cell_x => null() real(DP), dimension(:), contiguous, pointer :: cell_y => null() integer(I4B) :: i - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set pointers to input path ncvert and icvert call mem_setptr(icell2d, 'ICELL2D', this%input_mempath) @@ -1006,19 +870,12 @@ subroutine source_cell2d(this) write (this%iout, '(1x,a)') 'Discretization Cell2d data loaded' end if ! - ! -- Return - return end subroutine source_cell2d + !> @brief Write a binary grid file + !< subroutine write_grb(this, icelltype) -! ****************************************************************************** -! write_grb -- Write the binary grid file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: getunit, openfile use OpenSpecModule, only: access, form ! -- dummy class(GwfDisuType) :: this @@ -1029,10 +886,10 @@ subroutine write_grb(this, icelltype) character(len=50) :: txthdr character(len=lentxt) :: txt character(len=LINELENGTH) :: fname + ! -- formats character(len=*), parameter :: fmtgrdsave = & "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', & &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)" -! ------------------------------------------------------------------------------ ! ! -- Initialize ntxt = 10 @@ -1134,30 +991,21 @@ subroutine write_grb(this, icelltype) ! -- Close the file close (iunit) ! - ! -- return - return end subroutine write_grb + !> @brief Get reduced node number from user node number + !< function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber -- Return a nodenumber from the user specified node number -! with an option to perform a check. This subroutine -! can be overridden by child classes to perform mapping -! to a model node number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(GwfDisuType), intent(in) :: this integer(I4B), intent(in) :: nodeu integer(I4B), intent(in) :: icheck integer(I4B) :: nodenumber -! ------------------------------------------------------------------------------ ! if (icheck /= 0) then if (nodeu < 1 .or. nodeu > this%nodes) then - write (errmsg, '(a,i10)') & - 'Nodenumber less than 1 or greater than nodes:', nodeu + write (errmsg, '(a,i0,a,i0,a)') & + 'Node number (', nodeu, ') is less than 1 or greater than nodes (', & + this%nodes, ').' call store_error(errmsg) end if end if @@ -1170,33 +1018,25 @@ function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) nodenumber = this%nodereduced(nodeu) end if ! - ! -- return - return end function get_nodenumber_idx1 + !> @brief Get normal vector components between the cell and a given neighbor + !! + !! The normal points outward from the shared face between noden and nodem. + !< subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ipos) -! ****************************************************************************** -! connection_normal -- calculate the normal vector components for reduced -! nodenumber cell (noden) and its shared face with cell nodem. ihc is the -! horizontal connection flag. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp integer(I4B), intent(in) :: ipos ! -- local real(DP) :: angle, dmult -! ------------------------------------------------------------------------------ ! ! -- Set vector components based on ihc if (ihc == 0) then @@ -1224,25 +1064,15 @@ subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & zcomp = DZERO end if ! - ! -- return - return end subroutine connection_normal + !> @brief Get unit vector components between the cell and a given neighbor + !! + !! Saturation must be provided to compute cell center vertical coordinates. + !! Also return the straight-line connection length. + !< subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & xcomp, ycomp, zcomp, conlen) -! ****************************************************************************** -! connection_vector -- calculate the unit vector components from reduced -! nodenumber cell (noden) to its neighbor cell (nodem). The saturation for -! for these cells are also required so that the vertical position of the cell -! cell centers can be calculated. ihc is the horizontal flag. Also return -! the straight-line connection length. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: DHALF - use DisvGeom, only: line_unit_vector ! -- dummy class(GwfDisuType) :: this integer(I4B), intent(in) :: noden @@ -1257,7 +1087,6 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & real(DP), intent(inout) :: conlen ! -- local real(DP) :: xn, xm, yn, ym, zn, zm -! ------------------------------------------------------------------------------ ! ! -- Terminate with error if requesting unit vector components for problems ! without cell data @@ -1297,36 +1126,29 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & call line_unit_vector(xn, yn, zn, xm, ym, zm, xcomp, ycomp, zcomp, & conlen) ! - ! -- return - return end subroutine connection_vector - ! return discretization type + !> @brief Get the discretization type + !< subroutine get_dis_type(this, dis_type) + ! -- dummy class(GwfDisuType), intent(in) :: this character(len=*), intent(out) :: dis_type - + ! dis_type = "DISU" - + ! end subroutine get_dis_type - subroutine allocate_scalars(this, name_model) -! ****************************************************************************** -! allocate_scalars -- Allocate and initialize scalar variables in this class -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate + !> @brief Allocate and initialize scalar variables + !< + subroutine allocate_scalars(this, name_model, input_mempath) ! -- dummy class(GwfDisuType) :: this character(len=*), intent(in) :: name_model - ! -- local -! ------------------------------------------------------------------------------ + character(len=*), intent(in) :: input_mempath ! ! -- Allocate parent scalars - call this%DisBaseType%allocate_scalars(name_model) + call this%DisBaseType%allocate_scalars(name_model, input_mempath) ! ! -- Allocate variables for DISU call mem_allocate(this%njausr, 'NJAUSR', this%memoryPath) @@ -1342,23 +1164,13 @@ subroutine allocate_scalars(this, name_model) this%iangledegx = 0 this%readFromFile = .false. ! - ! -- Return - return end subroutine allocate_scalars + !> @brief Allocate and initialize arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Read discretization information from file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfDisuType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Allocate arrays in DisBaseType (mshape, top, bot, area) call this%DisBaseType%allocate_arrays() @@ -1376,32 +1188,30 @@ subroutine allocate_arrays(this) ! -- Initialize this%mshape(1) = this%nodesuser ! - ! -- Return - return end subroutine allocate_arrays + !> @brief Allocate arrays in memory manager + !< subroutine allocate_arrays_mem(this) + ! -- modules use MemoryManagerModule, only: mem_allocate + ! -- dummy class(GwfDisuType) :: this - + ! call mem_allocate(this%idomain, this%nodes, 'IDOMAIN', this%memoryPath) call mem_allocate(this%vertices, 2, this%nvert, 'VERTICES', this%memoryPath) call mem_allocate(this%cellxy, 2, this%nodes, 'CELLXY', this%memoryPath) - + ! end subroutine allocate_arrays_mem + !> @brief Convert a string to a user nodenumber + !! + !! Parse and return user nodenumber. + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !< function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & flag_string, allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_string -- Receive a string and convert the string to a user -! nodenumber. The model is unstructured; just read user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisuType) :: this integer(I4B), intent(inout) :: lloc @@ -1416,8 +1226,6 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & ! -- local integer(I4B) :: lloclocal, ndum, istat, n real(DP) :: r - character(len=LINELENGTH) :: fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1444,36 +1252,26 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & end if ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, *) ' Node number in list is outside of the grid', nodeu + write (errmsg, '(a,i0,a)') & + "Node number in list (", nodeu, ") is outside of the grid. "// & + "Cell number cannot be determined in line '"// & + trim(adjustl(line))//"'." call store_error(errmsg) - inquire (unit=in, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in line: ') - call store_error(trim(adjustl(line))) call store_error_unit(in) end if ! - ! -- return - return - end function nodeu_from_string + !> @brief Convert a cellid string to a user nodenumber + !! + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !! + !! If allow_zero is present and true, and all indices are zero, the + !! result can be zero. If allow_zero is false, a zero in any index is an error. + !< function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_cellid -- Receive cellid as a string and convert the string to a -! user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! If allow_zero argument is present and true, if all indices equal zero, the -! result can be zero. If allow_zero is false, a zero in any index causes an -! error. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: nodeu ! -- dummy @@ -1487,8 +1285,6 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & integer(I4B) :: lloclocal, istart, istop, ndum, n integer(I4B) :: istat real(DP) :: r - character(len=LINELENGTH) :: fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1516,59 +1312,42 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & end if ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, *) ' Node number in list is outside of the grid', nodeu + write (errmsg, '(a,i0,a)') & + "Cell number cannot be determined for cellid ("// & + trim(adjustl(cellid))//") and results in a user "// & + "node number (", nodeu, ") that is outside of the grid." call store_error(errmsg) - inquire (unit=inunit, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in cellid: ') - call store_error(trim(adjustl(cellid))) call store_error_unit(inunit) end if ! - ! -- return - return end function nodeu_from_cellid + !> @brief Indicates whether the grid discretization supports layers + !< logical function supports_layers(this) - implicit none ! -- dummy class(GwfDisuType) :: this ! supports_layers = .false. - return + ! end function supports_layers + !> @brief Get number of cells per layer (total nodes since DISU isn't layered) + !< function get_ncpl(this) -! ****************************************************************************** -! get_ncpl -- Return number of cells per layer. This is nodes -! for a DISU grid, as there are no layers. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return integer(I4B) :: get_ncpl ! -- dummy class(GwfDisuType) :: this -! ------------------------------------------------------------------------------ ! get_ncpl = this%nodesuser ! - ! -- Return - return end function get_ncpl + !> @brief Read an integer array + !< subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & iarray, aname) -! ****************************************************************************** -! read_int_array -- Read a GWF integer array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1582,7 +1361,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & ! -- local integer(I4B) :: nval integer(I4B), dimension(:), pointer, contiguous :: itemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to ibuff if it is a @@ -1605,19 +1383,12 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(itemp, iarray) end if ! - ! -- return - return end subroutine read_int_array + !> @brief Read a double precision array + !< subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & darray, aname) -! ****************************************************************************** -! read_dbl_array -- Read a GWF double precision array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1631,7 +1402,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & ! -- local integer(I4B) :: nval real(DP), dimension(:), pointer, contiguous :: dtemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to dbuff if it is a @@ -1653,45 +1423,27 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(dtemp, darray) end if ! - ! -- return - return end subroutine read_dbl_array + !> @brief Record a double precision array + !! + !! The array is written to a formatted or unformatted external file + !! depending on the arguments. + !< subroutine record_array(this, darray, iout, iprint, idataun, aname, & cdatafmp, nvaluesp, nwidthp, editdesc, dinact) -! ****************************************************************************** -! record_array -- Record a double precision array. The array will be -! printed to an external file and/or written to an unformatted external file -! depending on the argument specifications. -! ****************************************************************************** -! -! SPECIFICATIONS: -! darray is the double precision array to record -! iout is the unit number for ascii output -! iprint is a flag indicating whether or not to print the array -! idataun is the unit number to which the array will be written in binary -! form; if negative then do not write by layers, write entire array -! aname is the text descriptor of the array -! cdatafmp is the fortran format for writing the array -! nvaluesp is the number of values per line for printing -! nwidthp is the width of the number for printing -! editdesc is the format type (I, G, F, S, E) -! dinact is the double precision value to use for cells that are excluded -! from the model domain -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisuType), intent(inout) :: this - real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray - integer(I4B), intent(in) :: iout - integer(I4B), intent(in) :: iprint - integer(I4B), intent(in) :: idataun - character(len=*), intent(in) :: aname - character(len=*), intent(in) :: cdatafmp - integer(I4B), intent(in) :: nvaluesp - integer(I4B), intent(in) :: nwidthp - character(len=*), intent(in) :: editdesc - real(DP), intent(in) :: dinact + real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record + integer(I4B), intent(in) :: iout !< ascii output unit number + integer(I4B), intent(in) :: iprint !< whether to print the array + integer(I4B), intent(in) :: idataun !< binary output unit number + character(len=*), intent(in) :: aname !< text descriptor + character(len=*), intent(in) :: cdatafmp ! write format + integer(I4B), intent(in) :: nvaluesp !< values per line + integer(I4B), intent(in) :: nwidthp !< number width + character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E) + real(DP), intent(in) :: dinact !< double precision value for cells excluded from model domain ! -- local integer(I4B) :: k, ifirst integer(I4B) :: nlay @@ -1705,7 +1457,6 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & character(len=*), parameter :: fmthsv = & "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, & &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)" -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = 1 @@ -1763,19 +1514,13 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & iout, delt, pertim, totim) end if ! - ! -- return - return end subroutine record_array + !> @brief Record list header for imeth=6 + !< subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & dstmodel, dstpackage, naux, auxtxt, & ibdchn, nlist, iout) -! ****************************************************************************** -! record_srcdst_list_header -- Record list header for imeth=6 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisuType) :: this character(len=16), intent(in) :: text @@ -1790,7 +1535,6 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: nlay, nrow, ncol -! ------------------------------------------------------------------------------ ! nlay = 1 nrow = 1 @@ -1801,22 +1545,22 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & ibdchn, naux, auxtxt, ncol, nrow, nlay, & nlist, iout, delt, pertim, totim) ! - ! -- return - return end subroutine record_srcdst_list_header !> @brief Cast base to DISU !< function CastAsDisuType(dis) result(disu) + ! -- dummy class(*), pointer :: dis !< base pointer to DISU object + ! -- return class(GwfDisuType), pointer :: disu !< the resulting DISU pointer - + ! disu => null() select type (dis) class is (GwfDisuType) disu => dis end select - + ! end function CastAsDisuType end module GwfDisuModule diff --git a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 index 10a61f84702..7f09d38be19 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisuInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -54,7 +55,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -70,7 +72,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -86,7 +89,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -102,7 +106,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -118,7 +123,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -134,7 +140,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -150,7 +157,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -166,7 +174,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -182,7 +191,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -198,7 +208,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -214,7 +225,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -230,7 +242,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -246,7 +259,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -262,7 +276,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -278,7 +293,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -294,7 +310,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -310,7 +327,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -326,7 +344,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -342,7 +361,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -358,7 +378,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +395,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +412,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -406,7 +429,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -422,7 +446,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -438,7 +463,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -454,7 +480,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -470,7 +497,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -515,10 +543,11 @@ module GwfDisuInputModule 'VERTICES', & ! fortran variable 'RECARRAY IV XV YV', & ! type 'NVERT', & ! shape - .true., & ! required + .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -531,10 +560,11 @@ module GwfDisuInputModule 'CELL2D', & ! fortran variable 'RECARRAY ICELL2D XC YC NCVERT ICVERT', & ! type 'NODES', & ! shape - .true., & ! required + .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -573,13 +603,13 @@ module GwfDisuInputModule ), & InputBlockDefinitionType( & 'VERTICES', & ! blockname - .true., & ! required + .false., & ! required .true., & ! aggregate .false. & ! block_variable ), & InputBlockDefinitionType( & 'CELL2D', & ! blockname - .true., & ! required + .false., & ! required .true., & ! aggregate .false. & ! block_variable ) & diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90 index 63630cc0190..41237ddacf8 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8.f90 @@ -1,17 +1,21 @@ module GwfDisvModule use ArrayReadersModule, only: ReadArray - use KindModule, only: DP, I4B - use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME, DZERO, DONE, & - DHALF + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME, & + DZERO, DONE, DHALF use BaseDisModule, only: DisBaseType - use InputOutputModule, only: get_node, URWORD, ulasav, ulaprufw, ubdsv1, & - ubdsv06 + use GeomUtilModule, only: get_node, get_ijk, get_jk + use InputOutputModule, only: URWORD, ulasav, & + ulaprufw, ubdsv1, ubdsv06, getunit, openfile use SimModule, only: count_errors, store_error, store_error_unit, & store_error_filename - use DisvGeom, only: DisvGeomType - use MemoryManagerModule, only: mem_allocate + use SimVariablesModule, only: errmsg, idm_context + use DisvGeom, only: DisvGeomType, line_unit_vector + use MemoryManagerModule, only: mem_allocate, mem_deallocate, mem_setptr + use MemoryManagerExtModule, only: mem_set_value, memorylist_remove use TdisModule, only: kstp, kper, pertim, totim, delt + use GwfDisvInputModule, only: GwfDisvParamFoundType implicit none private @@ -28,7 +32,9 @@ module GwfDisvModule real(DP), dimension(:), pointer, contiguous :: top1d => null() ! top elevations for each cell at top of model (ncpl) real(DP), dimension(:, :), pointer, contiguous :: bot2d => null() ! bottom elevations for each cell (ncpl, nlay) integer(I4B), dimension(:, :), pointer, contiguous :: idomain => null() ! idomain (ncpl, nlay) + contains + procedure :: dis_df => disv_df procedure :: dis_da => disv_da procedure :: disv_load @@ -48,6 +54,7 @@ module GwfDisvModule procedure :: connection_vector procedure :: supports_layers procedure :: get_ncpl + procedure :: get_polyverts ! -- private procedure :: source_options procedure :: source_dimensions @@ -65,44 +72,36 @@ module GwfDisvModule procedure :: allocate_arrays procedure :: get_cell2d_area ! + ! -- Read a node-sized model array (reduced or not) procedure :: read_int_array procedure :: read_dbl_array - ! + end type GwfDisvType contains + !> @brief Create a new discretization by vertices object + !< subroutine disv_cr(dis, name_model, input_mempath, inunit, iout) -! ****************************************************************************** -! disv_cr -- Create a new discretization by vertices object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use KindModule, only: LGP - use MemoryManagerExtModule, only: mem_set_value + ! -- dummy class(DisBaseType), pointer :: dis character(len=*), intent(in) :: name_model character(len=*), intent(in) :: input_mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout + ! -- local type(GwfDisvType), pointer :: disnew - logical(LGP) :: found_fname + ! -- formats character(len=*), parameter :: fmtheader = & "(1X, /1X, 'DISV -- VERTEX GRID DISCRETIZATION PACKAGE,', & &' VERSION 1 : 12/23/2015 - INPUT READ FROM MEMPATH: ', A, //)" -! ------------------------------------------------------------------------------ + ! allocate (disnew) dis => disnew - call disnew%allocate_scalars(name_model) - dis%input_mempath = input_mempath + call disnew%allocate_scalars(name_model, input_mempath) dis%inunit = inunit dis%iout = iout ! - ! -- set name of input file - call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, & - found_fname) - ! ! -- If disv enabled if (inunit > 0) then ! @@ -115,22 +114,13 @@ subroutine disv_cr(dis, name_model, input_mempath, inunit, iout) call disnew%disv_load() end if ! - ! -- Return - return end subroutine disv_cr + !> @brief Transfer IDM data into this discretization object + !< subroutine disv_load(this) -! ****************************************************************************** -! disv_load -- transfer data into this discretization object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType) :: this - ! -- locals -! ------------------------------------------------------------------------------ ! ! -- source input data call this%source_options() @@ -139,45 +129,23 @@ subroutine disv_load(this) call this%source_vertices() call this%source_cell2d() ! - ! -- Return - return end subroutine disv_load + !> @brief Define the discretization + !< subroutine disv_df(this) -! ****************************************************************************** -! disv_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType) :: this - ! -- locals -! ------------------------------------------------------------------------------ ! - ! -- Final grid initialization call this%grid_finalize() ! - ! -- Return - return end subroutine disv_df + !> @brief Deallocate variables + !< subroutine disv_da(this) -! ****************************************************************************** -! disv_da -- Deallocate discretization data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_deallocate - use MemoryManagerExtModule, only: memorylist_remove - use SimVariablesModule, only: idm_context ! -- dummy class(GwfDisvType) :: this - ! -- locals -! ------------------------------------------------------------------------------ ! ! -- Deallocate idm memory call memorylist_remove(this%name_model, 'DISV', idm_context) @@ -203,29 +171,17 @@ subroutine disv_da(this) call mem_deallocate(this%bot2d) call mem_deallocate(this%idomain) ! - ! -- Return - return end subroutine disv_da !> @brief Copy options from IDM into package !< subroutine source_options(this) -! ****************************************************************************** -! source_options -- source options from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals character(len=LENVARNAME), dimension(3) :: lenunits = & &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS'] type(GwfDisvParamFoundType) :: found -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%lenuni, 'LENGTH_UNITS', this%input_mempath, & @@ -240,62 +196,51 @@ subroutine source_options(this) call this%log_options(found) end if ! - ! -- Return - return end subroutine source_options !> @brief Write user options to list file !< subroutine log_options(this, found) - use GwfDisvInputModule, only: GwfDisvParamFoundType + ! -- dummy class(GwfDisvType) :: this type(GwfDisvParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Options' - + ! if (found%length_units) then write (this%iout, '(4x,a,i0)') 'Model length unit [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] set as ', this%lenuni end if - + ! if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] & &set as ', this%nogrb end if - + ! if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - + ! if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - + ! if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Options' - + ! end subroutine log_options !> @brief Copy dimensions from IDM into package !< subroutine source_dimensions(this) -! ****************************************************************************** -! source_dimensions -- source dimensions from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use MemoryManagerExtModule, only: mem_set_value - use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals integer(I4B) :: j, k type(GwfDisvParamFoundType) :: found -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%nlay, 'NLAY', this%input_mempath, found%nlay) @@ -345,51 +290,41 @@ subroutine source_dimensions(this) end do end do ! - ! -- Return - return end subroutine source_dimensions !> @brief Write dimensions to list file !< subroutine log_dimensions(this, found) - use GwfDisvInputModule, only: GwfDisvParamFoundType + ! -- dummy class(GwfDisvType) :: this type(GwfDisvParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - + ! if (found%nlay) then write (this%iout, '(4x,a,i0)') 'NLAY = ', this%nlay end if - + ! if (found%ncpl) then write (this%iout, '(4x,a,i0)') 'NCPL = ', this%ncpl end if - + ! if (found%nvert) then write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Dimensions' - + ! end subroutine log_dimensions + !> @brief Copy grid data from IDM into package + !< subroutine source_griddata(this) -! ****************************************************************************** -! source_griddata -- source griddata from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals type(GwfDisvParamFoundType) :: found ! -- formats -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%top1d, 'TOP', this%input_mempath, found%top) @@ -401,50 +336,42 @@ subroutine source_griddata(this) call this%log_griddata(found) end if ! - ! -- Return - return end subroutine source_griddata !> @brief Write griddata found to list file !< subroutine log_griddata(this, found) - use GwfDisvInputModule, only: GwfDisvParamFoundType + ! -- dummy class(GwfDisvType) :: this type(GwfDisvParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - + ! if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - + ! if (found%botm) then write (this%iout, '(4x,a)') 'BOTM set from input file' end if - + ! if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if - + ! write (this%iout, '(1x,a,/)') 'End Setting Discretization Griddata' - + ! end subroutine log_griddata + !> @brief Finalize grid (check properties, allocate arrays, compute connections) + !< subroutine grid_finalize(this) -! ****************************************************************************** -! grid_finalize -- Finalize grid -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType) :: this ! -- locals integer(I4B) :: node, noder, j, k real(DP) :: top real(DP) :: dz - character(len=300) :: ermsg ! -- formats character(len=*), parameter :: fmtdz = & "('CELL (',i0,',',i0,') THICKNESS <= 0. ', & @@ -453,8 +380,6 @@ subroutine grid_finalize(this) "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',& &/1x, 'Number of user nodes: ',I0,& &/1X, 'Number of nodes in solution: ', I0, //)" - ! -- data -! ------------------------------------------------------------------------------ ! ! -- count active cells this%nodes = 0 @@ -484,8 +409,8 @@ subroutine grid_finalize(this) end if dz = top - this%bot2d(j, k) if (dz <= DZERO) then - write (ermsg, fmt=fmtdz) k, j, top, this%bot2d(j, k) - call store_error(ermsg) + write (errmsg, fmt=fmtdz) k, j, top, this%bot2d(j, k) + call store_error(errmsg) end if end if end do @@ -563,27 +488,17 @@ subroutine grid_finalize(this) ! -- Build connections call this%connect() ! - ! -- Return - return end subroutine grid_finalize + !> @brief Load grid vertices from IDM into package + !< subroutine source_vertices(this) -! ****************************************************************************** -! source_vertices -- source vertex data from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_setptr ! -- dummy class(GwfDisvType) :: this ! -- local integer(I4B) :: i real(DP), dimension(:), contiguous, pointer :: vert_x => null() real(DP), dimension(:), contiguous, pointer :: vert_y => null() - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set pointers to memory manager input arrays call mem_setptr(vert_x, 'XV', this%input_mempath) @@ -604,10 +519,10 @@ subroutine source_vertices(this) write (this%iout, '(1x,a)') 'Discretization Vertex data loaded' end if ! - ! -- Return - return end subroutine source_vertices + !> @brief Build data structures to hold cell vertex info + !< subroutine define_cellverts(this, icell2d, ncvert, icvert) ! -- modules use SparseModule, only: sparsematrix @@ -620,7 +535,6 @@ subroutine define_cellverts(this, icell2d, ncvert, icvert) type(sparsematrix) :: vert_spm integer(I4B) :: i, j, ierr integer(I4B) :: icv_idx, startvert, maxnnz = 5 -! ------------------------------------------------------------------------------ ! ! -- initialize sparse matrix call vert_spm%init(this%ncpl, this%nvert, maxnnz) @@ -646,19 +560,11 @@ subroutine define_cellverts(this, icell2d, ncvert, icvert) call vert_spm%filliaja(this%iavert, this%javert, ierr) call vert_spm%destroy() ! - ! -- Return - return end subroutine define_cellverts + !> @brief Copy cell2d data from IDM into package + !< subroutine source_cell2d(this) -! ****************************************************************************** -! source_cell2d -- source cell2d data from memory manager input path -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_setptr ! -- dummy class(GwfDisvType) :: this ! -- locals @@ -668,8 +574,6 @@ subroutine source_cell2d(this) real(DP), dimension(:), contiguous, pointer :: cell_x => null() real(DP), dimension(:), contiguous, pointer :: cell_y => null() integer(I4B) :: i - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set pointers to input path ncvert and icvert call mem_setptr(icell2d, 'ICELL2D', this%input_mempath) @@ -704,18 +608,11 @@ subroutine source_cell2d(this) write (this%iout, '(1x,a)') 'Discretization Cell2d data loaded' end if ! - ! -- Return - return end subroutine source_cell2d + !> @brief Build grid connections + !< subroutine connect(this) -! ****************************************************************************** -! connect -- Build grid connections -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType) :: this ! -- local @@ -724,8 +621,6 @@ subroutine connect(this) integer(I4B) :: narea_eq_zero integer(I4B) :: narea_lt_zero real(DP) :: area - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ ! ! -- Initialize narea_eq_zero = 0 @@ -740,14 +635,14 @@ subroutine connect(this) end do if (area < DZERO) then narea_lt_zero = narea_lt_zero + 1 - write (errmsg, '(a,i0)') & - &'Calculated CELL2D area less than zero for cell ', j + write (errmsg, '(a,i0,a)') & + &'Calculated CELL2D area less than zero for cell ', j, '.' call store_error(errmsg) end if if (area == DZERO) then narea_eq_zero = narea_eq_zero + 1 - write (errmsg, '(a,i0)') & - 'Calculated CELL2D area is zero for cell ', j + write (errmsg, '(a,i0,a)') & + 'Calculated CELL2D area is zero for cell ', j, '.' call store_error(errmsg) end if end do @@ -755,16 +650,16 @@ subroutine connect(this) ! -- check for errors if (count_errors() > 0) then if (narea_lt_zero > 0) then - write (errmsg, '(i0, a)') narea_lt_zero, & - ' cell(s) have an area less than zero. Calculated cell & - &areas must be greater than zero. Negative areas often & + write (errmsg, '(i0,a)') narea_lt_zero, & + ' cell(s) have an area less than zero. Calculated cell & + &areas must be greater than zero. Negative areas often & &mean vertices are not listed in clockwise order.' call store_error(errmsg) end if if (narea_eq_zero > 0) then - write (errmsg, '(i0, a)') narea_eq_zero, & - ' cell(s) have an area equal to zero. Calculated cell & - &areas must be greater than zero. Calculated cell & + write (errmsg, '(i0,a)') narea_eq_zero, & + ' cell(s) have an area equal to zero. Calculated cell & + &areas must be greater than zero. Calculated cell & &areas equal to zero indicate that the cell is not defined & &by a valid polygon.' call store_error(errmsg) @@ -785,20 +680,12 @@ subroutine connect(this) this%nja = this%con%nja this%njas = this%con%njas ! - ! - ! -- return - return end subroutine connect + !> @brief Write a binary grid file + !< subroutine write_grb(this, icelltype) -! ****************************************************************************** -! write_grb -- Write the binary grid file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: getunit, openfile use OpenSpecModule, only: access, form ! -- dummy class(GwfDisvType) :: this @@ -809,10 +696,10 @@ subroutine write_grb(this, icelltype) character(len=50) :: txthdr character(len=lentxt) :: txt character(len=LINELENGTH) :: fname + ! -- formats character(len=*), parameter :: fmtgrdsave = & "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', & &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)" -! ------------------------------------------------------------------------------ ! ! -- Initialize ntxt = 20 @@ -927,20 +814,11 @@ subroutine write_grb(this, icelltype) ! -- Close the file close (iunit) ! - ! -- return - return end subroutine write_grb + !> @brief Convert a user nodenumber to a string (nodenumber) or (k,j) + !< subroutine nodeu_to_string(this, nodeu, str) -! ****************************************************************************** -! nodeu_to_string -- Convert user node number to a string in the form of -! (nodenumber) or (k,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_ijk ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(in) :: nodeu @@ -948,7 +826,6 @@ subroutine nodeu_to_string(this, nodeu, str) ! -- local integer(I4B) :: i, j, k character(len=10) :: kstr, jstr -! ------------------------------------------------------------------------------ ! call get_ijk(nodeu, 1, this%ncpl, this%nlay, i, j, k) write (kstr, '(i10)') k @@ -956,35 +833,25 @@ subroutine nodeu_to_string(this, nodeu, str) str = '('//trim(adjustl(kstr))//','// & trim(adjustl(jstr))//')' ! - ! -- return - return end subroutine nodeu_to_string + !> @brief Convert a user nodenumber to an array (nodenumber) or (k,j) + !< subroutine nodeu_to_array(this, nodeu, arr) -! ****************************************************************************** -! nodeu_to_array -- Convert user node number to cellid and fill array with -! (nodenumber) or (k, j) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_ijk - implicit none + ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(in) :: nodeu integer(I4B), dimension(:), intent(inout) :: arr ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: isize integer(I4B) :: i, j, k -! ------------------------------------------------------------------------------ ! ! -- check the size of arr isize = size(arr) if (isize /= this%ndim) then write (errmsg, '(a,i0,a,i0,a)') & 'Program error: nodeu_to_array size of array (', isize, & - ') is not equal to the discretization dimension (', this%ndim, ')' + ') is not equal to the discretization dimension (', this%ndim, ').' call store_error(errmsg, terminate=.TRUE.) end if ! @@ -995,19 +862,11 @@ subroutine nodeu_to_array(this, nodeu, arr) arr(1) = k arr(2) = j ! - ! -- return - return end subroutine nodeu_to_array + !> @brief Get reduced node number from user node number + !< function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber -- Return a nodenumber from the user specified node number -! with an option to perform a check. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return integer(I4B) :: nodenumber ! -- dummy @@ -1015,18 +874,17 @@ function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) integer(I4B), intent(in) :: nodeu integer(I4B), intent(in) :: icheck ! -- local - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ ! ! -- check the node number if requested if (icheck /= 0) then ! ! -- If within valid range, convert to reduced nodenumber if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, '(a,i10)') & - 'Nodenumber less than 1 or greater than nodes:', nodeu - call store_error(errmsg) nodenumber = 0 + write (errmsg, '(a,i0,a,i0,a)') & + 'Node number (', nodeu, ') is less than 1 or greater than nodes (', & + this%nodesuser, ').' + call store_error(errmsg) else nodenumber = nodeu if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu) @@ -1036,21 +894,11 @@ function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu) end if ! - ! -- return - return end function get_nodenumber_idx1 - function get_nodenumber_idx2(this, k, j, icheck) & - result(nodenumber) -! ****************************************************************************** -! get_nodenumber_idx2 -- Return a nodenumber from the user specified layer and -! column with an option to perform a check. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_node - implicit none + !> @brief Get reduced node number from layer and within-layer node indices + !< + function get_nodenumber_idx2(this, k, j, icheck) result(nodenumber) ! -- return integer(I4B) :: nodenumber ! -- dummy @@ -1058,12 +906,10 @@ function get_nodenumber_idx2(this, k, j, icheck) & integer(I4B), intent(in) :: k, j integer(I4B), intent(in) :: icheck ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: nodeu - ! formats + ! -- formats character(len=*), parameter :: fmterr = & &"('Error in disv grid cell indices: layer = ',i0,', node = ',i0)" -! ------------------------------------------------------------------------------ ! nodeu = get_node(k, 1, j, this%nlay, 1, this%ncpl) if (nodeu < 1) then @@ -1076,48 +922,51 @@ function get_nodenumber_idx2(this, k, j, icheck) & ! -- check the node number if requested if (icheck /= 0) then ! - if (k < 1 .or. k > this%nlay) & - call store_error('Layer less than one or greater than nlay') - if (j < 1 .or. j > this%ncpl) & - call store_error('Node number less than one or greater than ncpl') + errmsg = "" + ! + if (k < 1 .or. k > this%nlay) then + write (errmsg, '(a,i0,a)') & + 'Layer number in list (', k, ') is outside of the grid.' + end if + if (j < 1 .or. j > this%ncpl) then + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Node number in list (', j, & + ') is outside of the grid.' + end if ! ! -- Error if outside of range if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (errmsg, '(a,i10)') & - 'Nodenumber less than 1 or greater than nodes:', nodeu + write (errmsg, '(a,1x,a,i0,a,i0,a)') & + trim(adjustl(errmsg)), & + 'Node number (', nodeu, ') is less than 1 or greater '// & + 'than nodes (', this%nodesuser, ').' + end if + ! + if (len_trim(adjustl(errmsg)) > 0) then call store_error(errmsg) end if + ! end if ! - ! -- return - return end function get_nodenumber_idx2 + !> @brief Get normal vector components between the cell and a given neighbor + !! + !! The normal points outward from the shared face between noden and nodem. + !< subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ipos) -! ****************************************************************************** -! connection_normal -- calculate the normal vector components for reduced -! nodenumber cell (noden) and its shared face with cell nodem. ihc is the -! horizontal connection flag. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp integer(I4B), intent(in) :: ipos ! -- local - !integer(I4B) :: ipos - !integer(I4B) :: ncell3d, mcell3d real(DP) :: angle, dmult -! ------------------------------------------------------------------------------ ! ! -- Set vector components based on ihc if (ihc == 0) then @@ -1144,33 +993,23 @@ subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & zcomp = DZERO end if ! - ! -- return - return end subroutine connection_normal + !> @brief Get unit vector components between the cell and a given neighbor + !! + !! Saturation must be provided to compute cell center vertical coordinates. + !! Also return the straight-line connection length. + !< subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & xcomp, ycomp, zcomp, conlen) -! ****************************************************************************** -! connection_vector -- calculate the unit vector components from reduced -! nodenumber cell (noden) to its neighbor cell (nodem). The saturation for -! for these cells are also required so that the vertical position of the cell -! cell centers can be calculated. ihc is the horizontal flag. Also return -! the straight-line connection length. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_jk - use DisvGeom, only: line_unit_vector ! -- dummy class(GwfDisvType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) logical, intent(in) :: nozee real(DP), intent(in) :: satn real(DP), intent(in) :: satm - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp @@ -1178,7 +1017,6 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & ! -- local integer(I4B) :: nodeu, ncell2d, mcell2d, k real(DP) :: xn, xm, yn, ym, zn, zm -! ------------------------------------------------------------------------------ ! ! -- Set vector components based on ihc if (ihc == 0) then @@ -1217,35 +1055,29 @@ subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & conlen) end if ! - ! -- return - return end subroutine connection_vector - ! return discretization type + !> @brief Get the discretization type + !< subroutine get_dis_type(this, dis_type) + ! -- dummy class(GwfDisvType), intent(in) :: this character(len=*), intent(out) :: dis_type - + ! dis_type = "DISV" - + ! end subroutine get_dis_type - subroutine allocate_scalars(this, name_model) -! ****************************************************************************** -! allocate_scalars -- Allocate and initialize scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate + !> @brief Allocate and initialize scalars + !< + subroutine allocate_scalars(this, name_model, input_mempath) ! -- dummy class(GwfDisvType) :: this character(len=*), intent(in) :: name_model -! ------------------------------------------------------------------------------ + character(len=*), intent(in) :: input_mempath ! ! -- Allocate parent scalars - call this%DisBaseType%allocate_scalars(name_model) + call this%DisBaseType%allocate_scalars(name_model, input_mempath) ! ! -- Allocate call mem_allocate(this%nlay, 'NLAY', this%memoryPath) @@ -1258,22 +1090,13 @@ subroutine allocate_scalars(this, name_model) this%nvert = 0 this%ndim = 2 ! - ! -- Return - return end subroutine allocate_scalars + !> @brief Allocate and initialize arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfDisvType) :: this -! ------------------------------------------------------------------------------ ! ! -- Allocate arrays in DisBaseType (mshape, top, bot, area) call this%DisBaseType%allocate_arrays() @@ -1291,21 +1114,16 @@ subroutine allocate_arrays(this) this%mshape(1) = this%nlay this%mshape(2) = this%ncpl ! - ! -- Return - return end subroutine allocate_arrays + !> @brief Get the signed area of the cell + !! + !! A negative result means points are in counter-clockwise orientation. + !! Area is computed from the formula: + !! a = 1/2 *[(x1*y2 + x2*y3 + x3*y4 + ... + xn*y1) - + !! (x2*y1 + x3*y2 + x4*y3 + ... + x1*yn)] + !< function get_cell2d_area(this, icell2d) result(area) -! ****************************************************************************** -! get_cell2d_area -- Calculate and return the signed area of the cell. A -! negative area means the points are in counter clockwise orientation. -! a = 1/2 *[(x1*y2 + x2*y3 + x3*y4 + ... + xn*y1) - -! (x2*y1 + x3*y2 + x4*y3 + ... + x1*yn)] -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(in) :: icell2d @@ -1315,13 +1133,18 @@ function get_cell2d_area(this, icell2d) result(area) integer(I4B) :: ivert integer(I4B) :: nvert integer(I4B) :: icount + integer(I4B) :: iv1 real(DP) :: x real(DP) :: y -! ------------------------------------------------------------------------------ + real(DP) :: x1 + real(DP) :: y1 ! area = DZERO nvert = this%iavert(icell2d + 1) - this%iavert(icell2d) icount = 1 + iv1 = this%javert(this%iavert(icell2d)) + x1 = this%vertices(1, iv1) + y1 = this%vertices(2, iv1) do ivert = this%iavert(icell2d), this%iavert(icell2d + 1) - 1 x = this%vertices(1, this%javert(ivert)) if (icount < nvert) then @@ -1329,7 +1152,7 @@ function get_cell2d_area(this, icell2d) result(area) else y = this%vertices(2, this%javert(this%iavert(icell2d))) end if - area = area + x * y + area = area + (x - x1) * (y - y1) icount = icount + 1 end do ! @@ -1341,28 +1164,22 @@ function get_cell2d_area(this, icell2d) result(area) else x = this%vertices(1, this%javert(this%iavert(icell2d))) end if - area = area - x * y + area = area - (x - x1) * (y - y1) icount = icount + 1 end do ! area = -DONE * area * DHALF ! - ! -- return - return end function get_cell2d_area + !> @brief Convert a string to a user nodenumber + !! + !! Parse layer and within-layer cell number and return user nodenumber. + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !< function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & flag_string, allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_string -- Receive a string and convert the string to a user -! nodenumber. The model discretization is DISV; read layer and cell number. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(inout) :: lloc @@ -1378,8 +1195,6 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & integer(I4B) :: j, k, nlay, nrow, ncpl integer(I4B) :: lloclocal, ndum, istat, n real(DP) :: r - character(len=LINELENGTH) :: ermsg, fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1411,46 +1226,45 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & end if end if ! + errmsg = '' + ! if (k < 1 .or. k > nlay) then - write (ermsg, *) ' Layer number in list is outside of the grid', k - call store_error(ermsg) + write (errmsg, '(a,i0,a)') & + 'Layer number in list (', k, ') is outside of the grid.' end if if (j < 1 .or. j > ncpl) then - write (ermsg, *) ' Cell2d number in list is outside of the grid', j - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Cell2d number in list (', j, & + ') is outside of the grid.' end if + ! nodeu = get_node(k, 1, j, nlay, nrow, ncpl) ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (ermsg, *) ' Node number in list is outside of the grid', nodeu - call store_error(ermsg) - inquire (unit=in, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in line: ') - call store_error(trim(adjustl(line))) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), & + "Node number in list (", nodeu, ") is outside of the grid. "// & + "Cell number cannot be determined in line '"// & + trim(adjustl(line))//"'." + end if + ! + if (len_trim(adjustl(errmsg)) > 0) then + call store_error(errmsg) call store_error_unit(in) end if ! - ! -- return - return end function nodeu_from_string + !> @brief Convert a cellid string to a user nodenumber + !! + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !! + !! If allow_zero is present and true, and all indices are zero, the + !! result can be zero. If allow_zero is false, a zero in any index is an error. + !< function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_cellid -- Receive cellid as a string and convert the string to a -! user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! If allow_zero argument is present and true, if all indices equal zero, the -! result can be zero. If allow_zero is false, a zero in any index causes an -! error. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: nodeu ! -- dummy @@ -1465,8 +1279,6 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & integer(I4B) :: lloclocal, ndum, istat, n integer(I4B) :: istart, istop real(DP) :: r - character(len=LINELENGTH) :: ermsg, fname -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then if (flag_string) then @@ -1499,70 +1311,108 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & end if end if ! + errmsg = '' + ! if (k < 1 .or. k > nlay) then - write (ermsg, *) ' Layer number in list is outside of the grid', k - call store_error(ermsg) + write (errmsg, '(a,i0,a)') & + 'Layer number in list (', k, ') is outside of the grid.' end if if (j < 1 .or. j > ncpl) then - write (ermsg, *) ' Cell2d number in list is outside of the grid', j - call store_error(ermsg) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), 'Cell2d number in list (', j, & + ') is outside of the grid.' end if + ! nodeu = get_node(k, 1, j, nlay, nrow, ncpl) ! if (nodeu < 1 .or. nodeu > this%nodesuser) then - write (ermsg, *) ' Node number in list is outside of the grid', nodeu - call store_error(ermsg) - inquire (unit=inunit, name=fname) - call store_error('Error converting in file: ') - call store_error(trim(adjustl(fname))) - call store_error('Cell number cannot be determined in cellid: ') - call store_error(trim(adjustl(cellid))) + write (errmsg, '(a,1x,a,i0,a)') & + trim(adjustl(errmsg)), & + "Cell number cannot be determined for cellid ("// & + trim(adjustl(cellid))//") and results in a user "// & + "node number (", nodeu, ") that is outside of the grid." + end if + ! + if (len_trim(adjustl(errmsg)) > 0) then + call store_error(errmsg) call store_error_unit(inunit) end if ! - ! -- return - return end function nodeu_from_cellid + !> @brief Indicates whether the grid discretization supports layers + !< logical function supports_layers(this) - implicit none ! -- dummy class(GwfDisvType) :: this ! supports_layers = .true. - return + ! end function supports_layers + !> @brief Get number of cells per layer (ncpl) + !< function get_ncpl(this) -! ****************************************************************************** -! get_ncpl -- Return number of cells per layer. This is ncpl -! for a DISV grid. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return integer(I4B) :: get_ncpl ! -- dummy class(GwfDisvType) :: this -! ------------------------------------------------------------------------------ ! get_ncpl = this%ncpl ! - ! -- Return - return end function get_ncpl + !> @brief Get a 2D array of polygon vertices, listed in clockwise order + !! beginning with the lower left corner + !< + subroutine get_polyverts(this, ic, polyverts, closed) + ! -- dummy + class(GwfDisvType), intent(inout) :: this + integer(I4B), intent(in) :: ic !< cell number (reduced) + real(DP), allocatable, intent(out) :: polyverts(:, :) !< polygon vertices (column-major indexing) + logical(LGP), intent(in), optional :: closed !< whether to close the polygon, duplicating a vertex + ! -- local + integer(I4B) :: icu, icu2d, iavert, ncpl, nverts, m, j + logical(LGP) :: lclosed + ! + ! count vertices + ncpl = this%get_ncpl() + icu = this%get_nodeuser(ic) + icu2d = icu - ((icu - 1) / ncpl) * ncpl + nverts = this%iavert(icu2d + 1) - this%iavert(icu2d) - 1 + if (nverts .le. 0) nverts = nverts + size(this%javert) + ! + ! check closed option + if (.not. (present(closed))) then + lclosed = .false. + else + lclosed = closed + end if + ! + ! allocate vertices array + if (lclosed) then + allocate (polyverts(2, nverts + 1)) + else + allocate (polyverts(2, nverts)) + end if + ! + ! set vertices + iavert = this%iavert(icu2d) + do m = 1, nverts + j = this%javert(iavert - 1 + m) + polyverts(:, m) = (/this%vertices(1, j), this%vertices(2, j)/) + end do + ! + ! close if enabled + if (lclosed) & + polyverts(:, nverts + 1) = polyverts(:, 1) + ! + end subroutine + + !> @brief Read an integer array + !< subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & iarray, aname) -! ****************************************************************************** -! read_int_array -- Read a GWF integer array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1581,7 +1431,6 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & integer(I4B) :: ncol integer(I4B) :: nval integer(I4B), dimension(:), pointer, contiguous :: itemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to ibuff if it is a @@ -1617,19 +1466,12 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(itemp, iarray) end if ! - ! -- return - return end subroutine read_int_array + !> @brief Read a double precision array + !< subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & darray, aname) -! ****************************************************************************** -! read_dbl_array -- Read a GWF double precision array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -1648,7 +1490,6 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & integer(I4B) :: ncol integer(I4B) :: nval real(DP), dimension(:), pointer, contiguous :: dtemp -! ------------------------------------------------------------------------------ ! ! -- Point the temporary pointer array, which is passed to the reading ! subroutine. The temporary array will point to dbuff if it is a @@ -1684,22 +1525,15 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & call this%fill_grid_array(dtemp, darray) end if ! - ! -- return - return end subroutine read_dbl_array + !> @brief Read a 2d double array into col icolbnd of darray + !! + !! For cells that are outside of the active domain, do not copy the array + !! value into darray. + !< subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & icolbnd, aname, inunit, iout) -! ****************************************************************************** -! read_layer_array -- Read a 2d double array into col icolbnd of darray. -! For cells that are outside of the active domain, -! do not copy the array value into darray. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_node ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(in) :: ncolbnd @@ -1712,7 +1546,6 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: ir, ic, ncol, nrow, nlay, nval, ipos, nodeu -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1736,44 +1569,27 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & end do end do ! - ! -- return end subroutine read_layer_array + !> @brief Record a double precision array + !! + !! The array is written to a formatted or unformatted external file depending + !! on the arguments. + !< subroutine record_array(this, darray, iout, iprint, idataun, aname, & cdatafmp, nvaluesp, nwidthp, editdesc, dinact) -! ****************************************************************************** -! record_array -- Record a double precision array. The array will be -! printed to an external file and/or written to an unformatted external file -! depending on the argument specifications. -! ****************************************************************************** -! -! SPECIFICATIONS: -! darray is the double precision array to record -! iout is the unit number for ascii output -! iprint is a flag indicating whether or not to print the array -! idataun is the unit number to which the array will be written in binary -! form; if negative then do not write by layers, write entire array -! aname is the text descriptor of the array -! cdatafmp is the fortran format for writing the array -! nvaluesp is the number of values per line for printing -! nwidthp is the width of the number for printing -! editdesc is the format type (I, G, F, S, E) -! dinact is the double precision value to use for cells that are excluded -! from the model domain -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfDisvType), intent(inout) :: this - real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray - integer(I4B), intent(in) :: iout - integer(I4B), intent(in) :: iprint - integer(I4B), intent(in) :: idataun - character(len=*), intent(in) :: aname - character(len=*), intent(in) :: cdatafmp - integer(I4B), intent(in) :: nvaluesp - integer(I4B), intent(in) :: nwidthp - character(len=*), intent(in) :: editdesc - real(DP), intent(in) :: dinact + real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record + integer(I4B), intent(in) :: iout !< ascii output unit number + integer(I4B), intent(in) :: iprint !< whether to print the array + integer(I4B), intent(in) :: idataun !< binary output unit number, if negative don't write by layers, write entire array + character(len=*), intent(in) :: aname !< text descriptor + character(len=*), intent(in) :: cdatafmp !< write format + integer(I4B), intent(in) :: nvaluesp !< values per line + integer(I4B), intent(in) :: nwidthp !< number width + character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E) + real(DP), intent(in) :: dinact !< double precision value for cells excluded from model domain ! -- local integer(I4B) :: k, ifirst integer(I4B) :: nlay @@ -1787,7 +1603,6 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & character(len=*), parameter :: fmthsv = & "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, & &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)" -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1845,19 +1660,13 @@ subroutine record_array(this, darray, iout, iprint, idataun, aname, & iout, delt, pertim, totim) end if ! - ! -- return - return end subroutine record_array + !> @brief Record list header for imeth=6 + !< subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & dstmodel, dstpackage, naux, auxtxt, & ibdchn, nlist, iout) -! ****************************************************************************** -! record_srcdst_list_header -- Record list header for imeth=6 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfDisvType) :: this character(len=16), intent(in) :: text @@ -1872,7 +1681,6 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: nlay, nrow, ncol -! ------------------------------------------------------------------------------ ! nlay = this%mshape(1) nrow = 1 @@ -1883,34 +1691,20 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & ibdchn, naux, auxtxt, ncol, nrow, nlay, & nlist, iout, delt, pertim, totim) ! - ! -- return - return end subroutine record_srcdst_list_header - subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & - inunit, iout) -! ****************************************************************************** -! nlarray_to_nodelist -- Read an integer array into nodelist. For structured -! model, integer array is layer number; for unstructured -! model, integer array is node number. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_node + !> @brief Convert an integer array (layer numbers) to nodelist + !< + subroutine nlarray_to_nodelist(this, darray, nodelist, maxbnd, nbound, aname) ! -- dummy class(GwfDisvType) :: this integer(I4B), intent(in) :: maxbnd + integer(I4B), dimension(:), pointer, contiguous :: darray integer(I4B), dimension(maxbnd), intent(inout) :: nodelist integer(I4B), intent(inout) :: nbound character(len=*), intent(in) :: aname - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout ! -- local integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nval, nodeu, noder, ipos, ierr - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ ! ! -- set variables nlay = this%mshape(1) @@ -1918,7 +1712,6 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & ncol = this%mshape(2) ! nval = ncol * nrow - call ReadArray(inunit, this%ibuff, aname, this%ndim, nval, iout, 0) ! ! -- Copy array into nodelist ipos = 1 @@ -1926,9 +1719,10 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & do ir = 1, nrow do ic = 1, ncol nodeu = get_node(1, ir, ic, nlay, nrow, ncol) - il = this%ibuff(nodeu) + il = darray(nodeu) if (il < 1 .or. il > nlay) then - write (errmsg, *) 'Invalid layer number: ', il + write (errmsg, '(a,i0,a)') & + 'Invalid layer number (', il, ').' call store_error(errmsg, terminate=.TRUE.) end if nodeu = get_node(il, ir, ic, nlay, nrow, ncol) @@ -1945,8 +1739,8 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & ! -- Check for errors nbound = ipos - 1 if (ierr > 0) then - write (errmsg, '(a, i0)') & - 'MAXBOUND dimension is too small. Increase MAXBOUND to ', ierr + write (errmsg, '(a,i0,a)') & + 'MAXBOUND dimension is too small. Increase MAXBOUND to ', ierr, '.' call store_error(errmsg, terminate=.TRUE.) end if ! @@ -1957,7 +1751,6 @@ subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & end do end if ! - ! -- return end subroutine nlarray_to_nodelist end module GwfDisvModule diff --git a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 index 142d32945d7..657d138186f 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisvInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -46,7 +47,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -62,7 +64,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -78,7 +81,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -94,7 +98,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -110,7 +115,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -126,7 +132,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -142,7 +149,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +166,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -174,7 +183,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -190,7 +200,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -206,7 +217,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -222,7 +234,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -238,7 +251,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -254,7 +268,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -270,7 +285,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -286,7 +302,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -302,7 +319,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -318,7 +336,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -334,7 +353,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +394,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +411,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterFlow/gwf3drn8.f90 b/src/Model/GroundWaterFlow/gwf3drn8.f90 index c0b5562c555..64a7f1240d3 100644 --- a/src/Model/GroundWaterFlow/gwf3drn8.f90 +++ b/src/Model/GroundWaterFlow/gwf3drn8.f90 @@ -2,13 +2,14 @@ module DrnModule use KindModule, only: DP, I4B use ConstantsModule, only: DZERO, DONE, DTWO, & LENFTYPE, LENPACKAGENAME, LENAUXNAME, LINELENGTH + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename use MemoryHelperModule, only: create_mem_path use SmoothingModule, only: sQSaturation, sQSaturationDerivative, & sQuadraticSaturation use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObsModule, only: DefaultObsIdProcessor - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use MatrixBaseModule ! implicit none @@ -20,14 +21,20 @@ module DrnModule character(len=LENFTYPE) :: ftype = 'DRN' character(len=LENPACKAGENAME) :: text = ' DRN' ! - type, extends(BndType) :: DrnType + type, extends(BndExtType) :: DrnType + real(DP), dimension(:), pointer, contiguous :: elev => null() !< DRN elevation + real(DP), dimension(:), pointer, contiguous :: cond => null() !< DRN conductance at aquifer interface integer(I4B), pointer :: iauxddrncol => null() integer(I4B), pointer :: icubic_scaling => null() contains + procedure :: allocate_scalars => drn_allocate_scalars - procedure :: bnd_options => drn_options + procedure :: allocate_arrays => drn_allocate_arrays + procedure :: source_options => drn_options + procedure :: log_drn_options + procedure :: bnd_rp => drn_rp procedure :: bnd_ck => drn_ck procedure :: bnd_cf => drn_cf procedure :: bnd_fc => drn_fc @@ -36,24 +43,20 @@ module DrnModule procedure :: define_listlabel procedure :: get_drain_elevations procedure :: get_drain_factor + procedure :: bound_value => drn_bound_value + procedure :: cond_mult ! -- methods for observations procedure, public :: bnd_obs_supported => drn_obs_supported procedure, public :: bnd_df_obs => drn_df_obs - ! -- method for time series - procedure, public :: bnd_rp_ts => drn_rp_ts + procedure, public :: drn_store_user_cond end type DrnType contains - subroutine drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! drn_create -- Create a New Drn Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a New Drn Package and point packobj to the new package + !< + subroutine drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -62,16 +65,16 @@ subroutine drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(DrnType), pointer :: drnobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (drnobj) packobj => drnobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -85,52 +88,45 @@ subroutine drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 2 ! drnelev, conductance - packobj%iscloc = 2 !sfac applies to conductance packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine drn_create + !> @brief Deallocate memory + !< subroutine drn_da(this) -! ****************************************************************************** -! drn_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(DrnType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! ! -- scalars call mem_deallocate(this%iauxddrncol) call mem_deallocate(this%icubic_scaling) ! - ! -- return + ! -- arrays + call mem_deallocate(this%elev, 'ELEV', this%memoryPath) + call mem_deallocate(this%cond, 'COND', this%memoryPath) + ! + ! -- Return return end subroutine drn_da + !> @brief Allocate package scalar members + !< subroutine drn_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(DrnType) :: this -! ------------------------------------------------------------------------------ ! - ! -- call standard BndType allocate scalars - call this%BndType%allocate_scalars() + ! -- call base type allocate scalars + call this%BndExtType%allocate_scalars() ! ! -- allocate the object and assign values to object variables call mem_allocate(this%iauxddrncol, 'IAUXDDRNCOL', this%memoryPath) @@ -144,60 +140,90 @@ subroutine drn_allocate_scalars(this) this%icubic_scaling = 0 end if ! - ! -- return + ! -- Return return end subroutine drn_allocate_scalars - subroutine drn_options(this, option, found) -! ****************************************************************************** -! drn_options -- set options specific to DrnType -! -! drn_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Allocate package arrays + !< + subroutine drn_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(DrnType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! + ! -- call base type allocate arrays + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set drn input context pointers + call mem_setptr(this%elev, 'ELEV', this%input_mempath) + call mem_setptr(this%cond, 'COND', this%input_mempath) + ! + ! --checkin drn input context pointers + call mem_checkin(this%elev, 'ELEV', this%memoryPath, & + 'ELEV', this%input_mempath) + call mem_checkin(this%cond, 'COND', this%memoryPath, & + 'COND', this%input_mempath) + ! + ! -- Return + return + end subroutine drn_allocate_arrays + + !> @brief Read and prepare + !< + subroutine drn_rp(this) + use TdisModule, only: kper + ! -- dummy + class(DrnType), intent(inout) :: this + ! + if (this%iper /= kper) return + ! + ! -- Call the parent class read and prepare + call this%BndExtType%bnd_rp() + ! + ! -- store user cond + if (this%ivsc == 1) then + call this%drn_store_user_cond() + end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! + ! -- Return + return + end subroutine drn_rp + + !> @brief Source options specific to DrnType + !< + subroutine drn_options(this) + ! -- modules use InputOutputModule, only: urword - use SimModule, only: store_error + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use GwfDrnInputModule, only: GwfDrnParamFoundType ! -- dummy class(DrnType), intent(inout) :: this - character(len=*), intent(inout) :: option - logical, intent(inout) :: found ! -- local - character(len=LINELENGTH) :: errmsg + type(GwfDrnParamFoundType) :: found character(len=LENAUXNAME) :: ddrnauxname integer(I4B) :: n -! ------------------------------------------------------------------------------ ! - found = .true. - select case (option) - case ('MOVER') - this%imover = 1 - write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' - case ('AUXDEPTHNAME') - call this%parser%GetStringCaps(ddrnauxname) - this%iauxddrncol = -1 - write (this%iout, '(4x,a,a)') & - 'AUXILIARY DRAIN DEPTH NAME: ', trim(ddrnauxname) - ! - ! -- right now these are options that are only available in the - ! development version and are not included in the documentation. - ! These options are only available when IDEVELOPMODE in - ! constants module is set to 1 - case ('DEV_CUBIC_SCALING') - call this%parser%DevOpt() - this%icubic_scaling = 1 - write (this%iout, '(4x,a,1x,a)') & - 'CUBIC SCALING will be used for drains with non-zero DDRN values', & - 'even if the NEWTON-RAPHSON method is not being used.' - case default - ! - ! -- No options found - found = .false. - end select + ! -- source base class options + call this%BndExtType%source_options() ! - ! -- DDRN was specified, so find column of auxvar that will be used - if (this%iauxddrncol < 0) then + ! -- source drain options + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) + call mem_set_value(ddrnauxname, 'AUXDEPTHNAME', this%input_mempath, & + found%auxdepthname) + call mem_set_value(this%icubic_scaling, 'ICUBICSFAC', this%input_mempath, & + found%icubicsfac) + ! + if (found%auxdepthname) then + this%iauxddrncol = -1 ! ! -- Error if no aux variable specified if (this%naux == 0) then @@ -225,24 +251,56 @@ subroutine drn_options(this, option, found) end if end if ! - ! -- return + if (found%icubicsfac) then + call this%parser%DevOpt() + end if + ! + ! -- log DRN specific options + call this%log_drn_options(found) + ! + ! -- Return return end subroutine drn_options - subroutine drn_ck(this) -! ****************************************************************************** -! drn_ck -- Check drain boundary condition data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @ brief Log DRN specific package options + !< + subroutine log_drn_options(this, found) ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, count_errors, store_error_unit + use GwfDrnInputModule, only: GwfDrnParamFoundType + ! -- dummy variables + class(DrnType), intent(inout) :: this !< BndExtType object + type(GwfDrnParamFoundType), intent(in) :: found + ! -- local variables + ! -- format + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found%mover) then + write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' + end if + ! + if (found%icubicsfac) then + write (this%iout, '(4x,a,1x,a)') & + 'CUBIC SCALING will be used for drains with non-zero DDRN values', & + 'even if the NEWTON-RAPHSON method is not being used.' + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' + ! + ! -- Return + return + end subroutine log_drn_options + + !> @brief Check drain boundary condition data + !< + subroutine drn_ck(this) ! -- dummy class(DrnType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: i integer(I4B) :: node real(DP) :: bt @@ -256,7 +314,6 @@ subroutine drn_ck(this) character(len=*), parameter :: fmtdrnerr = & "('DRN BOUNDARY (',i0,') ELEVATION (',f10.3,') IS LESS THAN CELL & &BOTTOM (',f10.3,')')" -! ------------------------------------------------------------------------------ ! ! -- check stress period data do i = 1, this%nbound @@ -280,44 +337,30 @@ subroutine drn_ck(this) ! ! -- write summary of drain package error messages if (count_errors() > 0) then - call store_error_unit(this%inunit) + call store_error_filename(this%input_fname) end if ! - ! -- return + ! -- Return return end subroutine drn_ck - subroutine drn_cf(this, reset_mover) -! ****************************************************************************** -! drn_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no drains -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no drains + !< + subroutine drn_cf(this) ! -- dummy class(DrnType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i integer(I4B) :: node real(DP) :: cdrn real(DP) :: drnbot real(DP) :: fact - logical :: lrm -! ------------------------------------------------------------------------------ ! ! -- Return if no drains if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each drn entry do i = 1, this%nbound node = this%nodelist(i) @@ -328,7 +371,8 @@ subroutine drn_cf(this, reset_mover) end if ! ! -- set local variables for this drain - cdrn = this%bound(2, i) + cdrn = this%cond_mult(i) + ! ! -- calculate the drainage scaling factor call this%get_drain_factor(i, fact, drnbot) @@ -338,17 +382,13 @@ subroutine drn_cf(this, reset_mover) this%hcof(i) = -fact * cdrn end do ! - ! -- return + ! -- Return return end subroutine drn_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine drn_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! drn_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(DrnType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -363,7 +403,6 @@ subroutine drn_fc(this, rhs, ia, idxglo, matrix_sln) real(DP) :: drnbot real(DP) :: drncond real(DP) :: qdrn -! -------------------------------------------------------------------------- ! ! -- packmvrobj fc if (this%imover == 1) then @@ -383,23 +422,19 @@ subroutine drn_fc(this, rhs, ia, idxglo, matrix_sln) ! -- If mover is active and this drain is discharging, ! store available water (as positive value). if (this%imover == 1 .and. fact > DZERO) then - drncond = this%bound(2, i) + drncond = this%cond_mult(i) qdrn = fact * drncond * (this%xnew(n) - drnbot) call this%pakmvrobj%accumulate_qformvr(i, qdrn) end if end do ! - ! -- return + ! -- Return return end subroutine drn_fc + !> @brief Fill newton terms + !< subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! drn_fn -- Fill newton terms -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- implicit none ! -- dummy class(DrnType) :: this @@ -417,8 +452,6 @@ subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln) real(DP) :: drntop real(DP) :: drnbot real(DP) :: drterm -! -------------------------------------------------------------------------- - ! ! -- Copy package rhs and hcof into solution rhs and amat if (this%iauxddrncol /= 0) then @@ -431,7 +464,7 @@ subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln) end if ! ! -- set local variables for this drain - cdrn = this%bound(2, i) + cdrn = this%cond_mult(i) xnew = this%xnew(node) ! ! -- calculate the drainage depth and the top and bottom of @@ -452,20 +485,16 @@ subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln) end do end if ! - ! -- return + ! -- Return return end subroutine drn_fn + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(DrnType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -485,18 +514,14 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel + !> @brief Define drain depth and the top and bottom elevations used to scale + !! the drain conductance + !< subroutine get_drain_elevations(this, i, drndepth, drntop, drnbot) -! ****************************************************************************** -! get_drain_elevations -- Define drain depth and the top and bottom elevations -! used to scale the drain conductance. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DrnType), intent(inout) :: this integer(I4B), intent(in) :: i @@ -506,11 +531,10 @@ subroutine get_drain_elevations(this, i, drndepth, drntop, drnbot) ! -- local real(DP) :: drnelev real(DP) :: elev -! ------------------------------------------------------------------------------ ! ! -- initialize dummy and local variables drndepth = DZERO - drnelev = this%bound(1, i) + drnelev = this%elev(i) ! ! -- set the drain depth if (this%iauxddrncol > 0) then @@ -527,17 +551,13 @@ subroutine get_drain_elevations(this, i, drndepth, drntop, drnbot) drnbot = drnelev end if ! - ! -- return + ! -- Return return end subroutine get_drain_elevations + !> @brief Get the drain conductance scale factor + !< subroutine get_drain_factor(this, i, factor, opt_drnbot) -! ****************************************************************************** -! get_drain_factor -- Get the drain conductance scale factor. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DrnType), intent(inout) :: this integer(I4B), intent(in) :: i @@ -549,7 +569,6 @@ subroutine get_drain_factor(this, i, factor, opt_drnbot) real(DP) :: drndepth real(DP) :: drntop real(DP) :: drnbot -! ------------------------------------------------------------------------------ ! ! -- set local variables for this drain node = this%nodelist(i) @@ -579,45 +598,38 @@ subroutine get_drain_factor(this, i, factor, opt_drnbot) end if end if ! - ! -- return + ! -- Return return end subroutine get_drain_factor ! -- Procedures related to observations + !> @brief Return true because DRN package supports observations + !! + !! Overrides BndType%bnd_obs_supported() + !< logical function drn_obs_supported(this) -! ****************************************************************************** -! drn_obs_supported -! -- Return true because DRN package supports observations. -! -- Overrides BndType%bnd_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! -- dummy class(DrnType) :: this -! ------------------------------------------------------------------------------ + ! drn_obs_supported = .true. ! - ! -- return + ! -- Return return end function drn_obs_supported + !> @brief Store observation type supported by DRN package + !! + !! Overrides BndType%bnd_df_obs + !< subroutine drn_df_obs(this) -! ****************************************************************************** -! drn_df_obs (implements bnd_df_obs) -! -- Store observation type supported by DRN package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none ! -- dummy class(DrnType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('drn', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! @@ -626,37 +638,74 @@ subroutine drn_df_obs(this) call this%obs%StoreObsType('to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine drn_df_obs - ! -- Procedure related to time series - - subroutine drn_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In DRN package variables ELEV and COND - ! can be controlled by time series. + !> @brief Store user-specified drain conductance + !< + subroutine drn_store_user_cond(this) ! -- dummy - class(DrnType), intent(inout) :: this + class(DrnType), intent(inout) :: this !< BndExtType object ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'ELEV' - case (2) - tslink%Text = 'COND' - end select - end if + integer(I4B) :: n + ! + ! -- store backup copy of conductance values + do n = 1, this%nbound + this%condinput(n) = this%cond_mult(n) end do ! + ! -- Return + return + end subroutine drn_store_user_cond + + !> @brief Apply multiplier to conductance value depending on user-selected option + !< + function cond_mult(this, row) result(cond) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(DrnType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: cond + ! + if (this%iauxmultcol > 0) then + cond = this%cond(row) * this%auxvar(this%iauxmultcol, row) + else + cond = this%cond(row) + end if + ! + ! -- Return + return + end function cond_mult + + !> @brief Return requested boundary value + !< + function drn_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(DrnType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%elev(row) + case (2) + bndval = this%cond_mult(row) + case default + errmsg = 'Programming error. DRN bound value requested column '& + &'outside range of ncolbnd (2).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + ! + ! -- Return return - end subroutine drn_rp_ts + end function drn_bound_value end module DrnModule diff --git a/src/Model/GroundWaterFlow/gwf3drn8idm.f90 b/src/Model/GroundWaterFlow/gwf3drn8idm.f90 new file mode 100644 index 00000000000..ddd87932b4c --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3drn8idm.f90 @@ -0,0 +1,487 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfDrnInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_drn_param_definitions + public gwf_drn_aggregate_definitions + public gwf_drn_block_definitions + public GwfDrnParamFoundType + public gwf_drn_multi_package + + type GwfDrnParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: auxdepthname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: mover = .false. + logical :: icubicsfac = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: elev = .false. + logical :: cond = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfDrnParamFoundType + + logical :: gwf_drn_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfdrn_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_auxdepthname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'AUXDEPTHNAME', & ! tag name + 'AUXDEPTHNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_mover = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'MOVER', & ! tag name + 'MOVER', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_icubicsfac = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'OPTIONS', & ! block + 'DEV_CUBIC_SCALING', & ! tag name + 'ICUBICSFAC', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_elev = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'ELEV', & ! tag name + 'ELEV', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_cond = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'COND', & ! tag name + 'COND', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfdrn_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_drn_param_definitions(*) = & + [ & + gwfdrn_auxiliary, & + gwfdrn_auxmultname, & + gwfdrn_auxdepthname, & + gwfdrn_boundnames, & + gwfdrn_iprpak, & + gwfdrn_iprflow, & + gwfdrn_ipakcb, & + gwfdrn_ts_filerecord, & + gwfdrn_ts6, & + gwfdrn_filein, & + gwfdrn_ts6_filename, & + gwfdrn_obs_filerecord, & + gwfdrn_obs6, & + gwfdrn_obs6_filename, & + gwfdrn_mover, & + gwfdrn_icubicsfac, & + gwfdrn_maxbound, & + gwfdrn_cellid, & + gwfdrn_elev, & + gwfdrn_cond, & + gwfdrn_auxvar, & + gwfdrn_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfdrn_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'DRN', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID ELEV COND AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_drn_aggregate_definitions(*) = & + [ & + gwfdrn_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_drn_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfDrnInputModule diff --git a/src/Model/GroundWaterFlow/gwf3evt8.f90 b/src/Model/GroundWaterFlow/gwf3evt8.f90 index 34d687cfbdf..66ce0154798 100644 --- a/src/Model/GroundWaterFlow/gwf3evt8.f90 +++ b/src/Model/GroundWaterFlow/gwf3evt8.f90 @@ -1,18 +1,18 @@ module EvtModule ! - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: DZERO, DONE, LENFTYPE, LENPACKAGENAME, MAXCHARLEN, & IWETLAKE use MemoryHelperModule, only: create_mem_path use BndModule, only: BndType - use SimModule, only: store_error, store_error_unit, count_errors + use BndExtModule, only: BndExtType + use SimModule, only: store_error, store_error_filename, count_errors use SimVariablesModule, only: errmsg use ObsModule, only: DefaultObsIdProcessor - use TimeArraySeriesLinkModule, only: TimeArraySeriesLinkType - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use BlockParserModule, only: BlockParserType + use CharacterStringModule, only: CharacterStringType use MatrixBaseModule + use GeomUtilModule, only: get_node ! implicit none ! @@ -23,21 +23,28 @@ module EvtModule character(len=LENPACKAGENAME) :: text = ' EVT' character(len=LENPACKAGENAME) :: texta = ' EVTA' ! - type, extends(BndType) :: EvtType + type, extends(BndExtType) :: EvtType ! -- logicals - logical, private :: segsdefined = .true. - logical, private :: fixed_cell = .false. - logical, private :: read_as_arrays = .false. - logical, private :: surfratespecified = .false. + logical, pointer, private :: segsdefined + logical, pointer, private :: fixed_cell + logical, pointer, private :: read_as_arrays + logical, pointer, private :: surfratespecified ! -- integers - integer(I4B), pointer :: inievt => null() - integer(I4B), pointer, private :: nseg => null() + integer(I4B), pointer, private :: nseg => null() !< number of ET segments ! -- arrays + real(DP), dimension(:), pointer, contiguous :: surface => null() !< elevation of the ET surface + real(DP), dimension(:), pointer, contiguous :: rate => null() !< maximum ET flux rate + real(DP), dimension(:), pointer, contiguous :: depth => null() !< ET extinction depth + real(DP), dimension(:, :), pointer, contiguous :: pxdp => null() !< proportion of ET extinction depth at bottom of segment + real(DP), dimension(:, :), pointer, contiguous :: petm => null() !< proportion of max ET flux rate at bottom of segment + real(DP), dimension(:), pointer, contiguous :: petm0 => null() !< proportion of max ET flux rate that will apply when head is at or above ET surface integer(I4B), dimension(:), pointer, contiguous :: nodesontop => null() contains procedure :: evt_allocate_scalars - procedure :: bnd_options => evt_options - procedure :: read_dimensions => evt_read_dimensions + procedure :: allocate_arrays => evt_allocate_arrays + procedure :: source_options => evt_source_options + procedure :: source_dimensions => evt_source_dimensions + procedure :: evt_log_options procedure :: read_initial_attr => evt_read_initial_attr procedure :: bnd_rp => evt_rp procedure :: set_nodesontop @@ -45,40 +52,21 @@ module EvtModule procedure :: bnd_fc => evt_fc procedure :: bnd_da => evt_da procedure :: define_listlabel => evt_define_listlabel - procedure, private :: evt_rp_array - procedure, private :: evt_rp_list + procedure :: bound_value => evt_bound_value procedure, private :: default_nodelist procedure, private :: check_pxdp ! -- for observations procedure, public :: bnd_obs_supported => evt_obs_supported procedure, public :: bnd_df_obs => evt_df_obs - ! -- for time series - procedure, public :: bnd_rp_ts => evt_rp_ts end type EvtType - ! EVT uses BndType%bound array columns: - ! Index Description old name Keyword - ! (1,n) ET Surface elevation ETSS SURFACE - ! (2,n) Max ET Rate ETSR RATE - ! (3,n) Extinction Depth ETSX DEPTH - ! Used only if nseg > 1 and surfratespecified is false: - ! 4->2+nseg Proportion of Extinction Depth PXDP PXDP - ! 3+nseg->3+2(nseg-1) Proportion of Max ET Rate PETM PETM - ! If nseg > 1 and surfratespecified is true: - ! 4->3+nseg Proportion of Extinction Depth PXDP PXDP - ! 4+nseg->3+2(nseg) Proportion of Max ET Rate PETM PETM - contains - subroutine evt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! evt_create -- Create a new Evapotranspiration Segments Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new Evapotranspiration Segments Package and point pakobj + !! to the new package + !< + subroutine evt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -87,16 +75,16 @@ subroutine evt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(EvtType), pointer :: evtobj -! ------------------------------------------------------------------------------ ! ! -- allocate evt object and scalar variables allocate (evtobj) packobj => evtobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -109,61 +97,163 @@ subroutine evt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 3 ! Assumes NSEG = 1 and SURF_RATE_SPECIFIED=False - packobj%iscloc = 2 ! sfac applies to max. ET rate packobj%ictMemPath = create_mem_path(namemodel, 'NPF') - ! indxconvertflux is Column index of bound that will be multiplied by - ! cell area to convert flux rates to flow rates - packobj%indxconvertflux = 2 - packobj%AllowTimeArraySeries = .true. ! - ! -- return + ! -- Return return end subroutine evt_create + !> @brief Allocate package scalar members + !< subroutine evt_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use MemoryManagerModule, only: mem_allocate + use MemoryManagerModule, only: mem_allocate, mem_setptr ! -- dummy class(EvtType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars - call this%BndType%allocate_scalars() + call this%BndExtType%allocate_scalars() ! ! -- allocate the object and assign values to object variables - call mem_allocate(this%inievt, 'INIEVT', this%memoryPath) call mem_allocate(this%nseg, 'NSEG', this%memoryPath) ! + ! -- allocate internal members + allocate (this%segsdefined) + allocate (this%fixed_cell) + allocate (this%read_as_arrays) + allocate (this%surfratespecified) + ! ! -- Set values - this%inievt = 0 this%nseg = 1 + this%segsdefined = .true. this%fixed_cell = .false. + this%read_as_arrays = .false. + this%surfratespecified = .false. ! - ! -- return + ! -- Return return end subroutine evt_allocate_scalars - subroutine evt_options(this, option, found) -! ****************************************************************************** -! evt_options -- set options specific to EvtType -! evt_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Allocate package arrays + !< + subroutine evt_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(EvtType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! + ! -- call standard BndType allocate scalars + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set EVT input context pointers + call mem_setptr(this%surface, 'SURFACE', this%input_mempath) + call mem_setptr(this%rate, 'RATE', this%input_mempath) + call mem_setptr(this%depth, 'DEPTH', this%input_mempath) + ! + ! -- checkin EVT input context pointers + call mem_checkin(this%surface, 'SURFACE', this%memoryPath, & + 'SURFACE', this%input_mempath) + call mem_checkin(this%rate, 'RATE', this%memoryPath, & + 'RATE', this%input_mempath) + call mem_checkin(this%depth, 'DEPTH', this%memoryPath, & + 'DEPTH', this%input_mempath) + ! + ! -- set list input segment descriptors + if (.not. this%read_as_arrays) then + if (this%nseg > 1) then + ! + ! -- set pxdp and petm input context pointers + call mem_setptr(this%pxdp, 'PXDP', this%input_mempath) + call mem_setptr(this%petm, 'PETM', this%input_mempath) + ! + ! -- checkin pxdp and petm input context pointers + call mem_checkin(this%pxdp, 'PXDP', this%memoryPath, & + 'PXDP', this%input_mempath) + call mem_checkin(this%petm, 'PETM', this%memoryPath, & + 'PETM', this%input_mempath) + end if + ! + if (this%surfratespecified) then + ! + ! -- set petm0 input context pointer + call mem_setptr(this%petm0, 'PETM0', this%input_mempath) + ! + ! -- cehckin petm0 input context pointer + call mem_checkin(this%petm0, 'PETM0', this%memoryPath, & + 'PETM0', this%input_mempath) + end if + end if + ! + ! -- Return + return + end subroutine evt_allocate_arrays + + !> @brief Source options specific to EvtType + !< + subroutine evt_source_options(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value ! -- dummy class(EvtType), intent(inout) :: this - character(len=*), intent(inout) :: option - logical, intent(inout) :: found ! -- local - character(len=MAXCHARLEN) :: ermsg + logical(LGP) :: found_fixed_cell = .false. + logical(LGP) :: found_readasarrays = .false. + logical(LGP) :: found_surfratespec = .false. + ! + ! -- source common bound options + call this%BndExtType%source_options() + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%fixed_cell, 'FIXED_CELL', & + this%input_mempath, found_fixed_cell) + call mem_set_value(this%read_as_arrays, 'READASARRAYS', & + this%input_mempath, found_readasarrays) + call mem_set_value(this%surfratespecified, 'SURFRATESPEC', & + this%input_mempath, found_surfratespec) + ! + if (found_readasarrays) then + if (this%dis%supports_layers()) then + this%text = texta + else + errmsg = 'READASARRAYS option is not compatible with selected'// & + ' discretization type.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + end if + ! + if (found_readasarrays .and. found_surfratespec) then + if (this%read_as_arrays) then + errmsg = 'READASARRAYS option is not compatible with the'// & + ' SURF_RATE_SPECIFIED option.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + end if + ! + ! -- log evt specific options + call this%evt_log_options(found_fixed_cell, found_readasarrays, & + found_surfratespec) + ! + ! -- Return + return + end subroutine evt_source_options + + !> @brief Source options specific to EvtType + !< + subroutine evt_log_options(this, found_fixed_cell, found_readasarrays, & + found_surfratespec) + ! -- modules + use MemoryManagerModule, only: mem_reallocate, mem_setptr + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + ! -- dummy + class(EvtType), intent(inout) :: this + logical(LGP), intent(in) :: found_fixed_cell + logical(LGP), intent(in) :: found_readasarrays + logical(LGP), intent(in) :: found_surfratespec ! -- formats character(len=*), parameter :: fmtihact = & &"(4x, 'EVAPOTRANSPIRATION WILL BE APPLIED TO HIGHEST ACTIVE CELL.')" @@ -175,173 +265,110 @@ subroutine evt_options(this, option, found) &"(4x, 'ET RATE AT SURFACE WILL BE ZERO.')" character(len=*), parameter :: fmtsrs = & &"(4x, 'ET RATE AT SURFACE WILL BE AS SPECIFIED BY PETM0.')" -! ------------------------------------------------------------------------------ ! - ! -- Check for FIXED_CELL AND LAYERED - select case (option) - case ('FIXED_CELL') - this%fixed_cell = .true. + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found_fixed_cell) then write (this%iout, fmtfixedcell) - found = .true. - case ('SURF_RATE_SPECIFIED') - this%surfratespecified = .true. - write (this%iout, fmtsrs) - found = .true. - ! - if (this%read_as_arrays) then - ermsg = 'READASARRAYS option is not compatible with the'// & - ' SURF_RATE_SPECIFIED option.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - case ('READASARRAYS') - if (this%dis%supports_layers()) then - this%read_as_arrays = .true. - this%text = texta - else - ermsg = 'READASARRAYS option is not compatible with selected'// & - ' discretization type.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - if (this%surfratespecified) then - ermsg = 'READASARRAYS option is not compatible with the'// & - ' SURF_RATE_SPECIFIED option.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - ! -- Write option + end if + ! + if (found_readasarrays) then write (this%iout, fmtreadasarrays) - ! - found = .true. - case default - ! - ! -- No options found - found = .false. - end select + end if + ! + if (found_surfratespec) then + write (this%iout, fmtsrs) + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' ! - ! -- return + ! -- Return return - end subroutine evt_options + end subroutine evt_log_options - subroutine evt_read_dimensions(this) -! ****************************************************************************** -! bnd_read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, store_error_unit + !> @brief Source the dimensions for this package + !< + subroutine evt_source_dimensions(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value ! -- dummy class(EvtType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: keyword - integer(I4B) :: ierr - logical :: isfound, endOfBlock + logical(LGP) :: found_nseg = .false. ! -- format character(len=*), parameter :: fmtnsegerr = & &"('Error: In EVT, NSEG must be > 0 but is specified as ',i0)" -! ------------------------------------------------------------------------------ ! ! Dimensions block is not required if: ! (1) discretization is DIS or DISV, and ! (2) READASARRAYS option has been specified. if (this%read_as_arrays) then this%maxbound = this%dis%get_ncpl() + ! + ! -- verify dimensions were set + if (this%maxbound <= 0) then + write (errmsg, '(a)') & + 'MAXBOUND must be an integer greater than zero.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! else - ! -- get dimensions block - call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & - supportOpenClose=.true.) ! - ! -- parse dimensions block if detected - if (isfound) then - write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & - ' DIMENSIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case ('MAXBOUND') - if (this%read_as_arrays) then - errmsg = 'When READASARRAYS option is used for the selected'// & - ' discretization package, MAXBOUND may not be specified.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() - else - this%maxbound = this%parser%GetInteger() - write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound - end if - case ('NSEG') - this%nseg = this%parser%GetInteger() - write (this%iout, '(4x,a,i0)') 'NSEG = ', this%nseg - if (this%nseg < 1) then - write (errmsg, fmtnsegerr) this%nseg - call store_error(errmsg) - call this%parser%StoreErrorUnit() - elseif (this%nseg > 1) then - ! NSEG>1 is supported only if readasarrays is false - if (this%read_as_arrays) then - errmsg = 'In the EVT package, NSEG cannot be greater than 1'// & - ' when READASARRAYS is used.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end if - ! -- Recalculate number of columns required in bound array. - if (this%surfratespecified) then - this%ncolbnd = 4 + 2 * (this%nseg - 1) - else - this%ncolbnd = 3 + 2 * (this%nseg - 1) - end if - elseif (this%nseg == 1) then - ! if surf_rate_specified is true, will still read petm0 - if (this%surfratespecified) then - this%ncolbnd = this%ncolbnd + 1 - end if - end if - case default - write (errmsg, '(a,a)') & - 'Unknown '//trim(this%text)//' DIMENSION: ', trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do + ! -- source maxbound + call this%BndExtType%source_dimensions() + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' DIMENSIONS' + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%nseg, 'NSEG', this%input_mempath, found_nseg) + ! + if (found_nseg) then ! - write (this%iout, '(1x,a)') & - 'END OF '//trim(adjustl(this%text))//' DIMENSIONS' - else - call store_error('Required DIMENSIONS block not found.') - call this%parser%StoreErrorUnit() + write (this%iout, '(4x,a,i0)') 'NSEG = ', this%nseg + ! + if (this%nseg < 1) then + write (errmsg, fmtnsegerr) this%nseg + call store_error(errmsg) + call store_error_filename(this%input_fname) + ! + elseif (this%nseg > 1) then + ! NSEG>1 is supported only if readasarrays is false + if (this%read_as_arrays) then + errmsg = 'In the EVT package, NSEG cannot be greater than 1'// & + ' when READASARRAYS is used.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + end if end if - end if - ! - ! -- verify dimensions were set - if (this%maxbound <= 0) then - write (errmsg, '(a)') & - 'MAXBOUND must be an integer greater than zero.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' DIMENSIONS' + ! end if ! ! -- Call define_listlabel to construct the list label that is written ! when PRINT_INPUT option is used. call this%define_listlabel() ! - ! -- return + ! -- Return return - end subroutine evt_read_dimensions + end subroutine evt_source_dimensions + !> @brief Part of allocate and read + !! + !! If READASARRAYS has been specified, assign default IEVT = 1 + !< subroutine evt_read_initial_attr(this) -! ****************************************************************************** -! evt_read_initial_attr -- Part of allocate and read -! If READASARRAYS has been specified, assign default IEVT = 1 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(EvtType), intent(inout) :: this ! @@ -349,138 +376,49 @@ subroutine evt_read_initial_attr(this) call this%default_nodelist() end if ! + ! -- Return return end subroutine evt_read_initial_attr + !> @brief Read and Prepare + !! + !! Read itmp and new boundaries if itmp > 0 + !< subroutine evt_rp(this) -! ****************************************************************************** -! evt_rp -- Read and Prepare -! Read new boundaries -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH - use TdisModule, only: kper, nper - use SimModule, only: store_error - use ArrayHandlersModule, only: ifind + use TdisModule, only: kper + implicit none ! -- dummy class(EvtType), intent(inout) :: this - ! -- local - integer(I4B) :: ierr - integer(I4B) :: node, n - integer(I4B) :: inievt, inrate, insurf, indepth - integer(I4B) :: kpxdp, kpetm - logical :: isfound, supportopenclose - character(len=LINELENGTH) :: line, msg - ! -- formats - character(len=*), parameter :: fmtblkerr = & - &"('Error. Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" - character(len=*), parameter :: fmtlsp = & - &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" - character(len=*), parameter :: fmtnbd = & - "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6,& - &') IS GREATER THAN MAXIMUM(',I6,')')" -! ------------------------------------------------------------------------------ - ! - ! -- Set ionper to the stress period number for which a new block of data - ! will be read. - if (this%inunit == 0) return - ! - ! -- get stress period data - if (this%ionper < kper) then - ! - ! -- get period block - supportopenclose = .not. this%read_as_arrays - ! When reading a list, OPEN/CLOSE is handled by list reader, - ! so supportOpenClose needs to be false in call the GetBlock. - ! When reading as arrays, set supportOpenClose as desired. - call this%parser%GetBlock('PERIOD', isfound, ierr, & - blockRequired=.false.) - if (isfound) then - ! - ! -- read ionper and check for increasing period numbers - call this%read_check_ionper() - else - ! - ! -- PERIOD block not found - if (ierr < 0) then - ! -- End of file found; data applies for remainder of simulation. - this%ionper = nper + 1 - else - ! -- Found invalid block - call this%parser%GetCurrentLine(line) - write (errmsg, fmtblkerr) adjustl(trim(line)) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end if - end if - end if ! - ! -- Read data if ionper == kper - inrate = 0 - insurf = 0 - indepth = 0 - inievt = 0 - if (this%ionper == kper) then - ! - ! -- Remove all time-series links associated with this package - call this%TsManager%Reset(this%packName) - call this%TasManager%Reset(this%packName) - ! - ! -- Read IEVT, SURFACE, RATE, DEPTH, PXDP, PETM, and AUX - ! variables, if any - kpetm = 0 - kpxdp = 0 + if (this%iper /= kper) return + ! + if (this%read_as_arrays) then ! - if (.not. this%read_as_arrays) then - ! -- Read EVT input as a list - call this%evt_rp_list(inrate) - else - ! -- Read Evt input as arrays - call this%evt_rp_array(line, inrate, insurf, indepth, & - kpxdp, kpetm) - end if + ! -- update nodelist based on IRCH input + call nodelist_update(this%nodelist, this%nbound, this%maxbound, & + this%dis, this%input_mempath) ! - ! -- Ensure that all required PXDP and PETM arrays - ! have been defined or redefined. - if (this%surfratespecified) then - if (kpxdp == this%nseg .and. kpetm == this%nseg) then - this%segsdefined = .true. - end if - else - if (kpxdp == this%nseg - 1 .and. kpxdp == this%nseg - 1) then - this%segsdefined = .true. - end if - end if - if (.not. this%segsdefined) then - msg = 'Error in EVT input: Definition of PXDP or PETM is incomplete.' - call store_error(msg) - call this%parser%StoreErrorUnit() - end if else - write (this%iout, fmtlsp) trim(this%filtyp) - end if - ! - ! -- If rate was read, then multiply by cell area. If inrate = 2, then - ! rate is begin managed as a time series, and the time series object - ! will multiply the rate by the cell area. - if (inrate == 1) then - do n = 1, this%nbound - node = this%nodelist(n) - if (node > 0) then - this%bound(2, n) = this%bound(2, n) * this%dis%get_area(node) - end if - end do + ! + ! -- process the input list arrays + call this%BndExtType%bnd_rp() ! ! -- ensure pxdp is monotonically increasing if (this%nseg > 1) then call this%check_pxdp() end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! end if ! - ! -- return + ! -- copy nodelist to nodesontop if not fixed cell + if (.not. this%fixed_cell) call this%set_nodesontop() + ! + ! -- Return return end subroutine evt_rp @@ -489,7 +427,6 @@ end subroutine evt_rp !! If the number of EVT segments (nseg) is greater than one, then !! pxdp must be monotically increasing from zero to one. Check !! to make sure this is the case. - !! !< subroutine check_pxdp(this) ! -- dummy @@ -518,7 +455,7 @@ subroutine check_pxdp(this) ! ! -- set and check pxdp2 if (i < this%nseg) then - pxdp2 = this%bound(i + 3, n) + pxdp2 = this%pxdp(i, n) if (pxdp2 <= DZERO .or. pxdp2 >= DONE) then call this%dis%noder_to_string(node, nodestr) write (errmsg, fmtpxdp0) pxdp2, trim(nodestr) @@ -547,23 +484,17 @@ subroutine check_pxdp(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine check_pxdp + !> @brief Store nodelist in nodesontop + !< subroutine set_nodesontop(this) -! ****************************************************************************** -! set_nodesontop -- store nodelist in nodesontop -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(EvtType), intent(inout) :: this ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- allocate if necessary if (.not. associated(this%nodesontop)) then @@ -575,27 +506,21 @@ subroutine set_nodesontop(this) this%nodesontop(n) = this%nodelist(n) end do ! - ! -- return + ! -- Return return end subroutine set_nodesontop - subroutine evt_cf(this, reset_mover) -! ****************************************************************************** -! evt_cf -- Formulate the HCOF and RHS terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !< + subroutine evt_cf(this) ! -- dummy class(EvtType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, iseg, node integer(I4B) :: idxdepth, idxrate real(DP) :: c, d, h, s, x real(DP) :: petm0 real(DP) :: petm1, petm2, pxdp1, pxdp2, thcof, trhs -! ------------------------------------------------------------------------------ ! ! -- Return if no ET nodes if (this%nbound == 0) return @@ -631,11 +556,16 @@ subroutine evt_cf(this, reset_mover) ! -- if ibound is positive and not overlain by a lake, then add terms if (this%ibound(node) > 0 .and. this%ibound(node) /= IWETLAKE) then ! - c = this%bound(2, i) ! RATE -- max. ET rate - s = this%bound(1, i) ! SURFACE -- ET surface elevation + if (this%iauxmultcol > 0) then + c = this%rate(i) * this%dis%get_area(node) * & + this%auxvar(this%iauxmultcol, i) + else + c = this%rate(i) * this%dis%get_area(node) + end if + s = this%surface(i) h = this%xnew(node) if (this%surfratespecified) then - petm0 = this%bound(4 + 2 * (this%nseg - 1), i) ! PETM0 + petm0 = this%petm0(i) end if ! ! -- If head in cell is greater than or equal to SURFACE, ET is constant @@ -650,7 +580,7 @@ subroutine evt_cf(this, reset_mover) else ! -- If depth to water >= extinction depth, then ET is 0 d = S - h - x = this%bound(3, i) ! DEPTH -- extinction depth + x = this%depth(i) if (d < x) then ! -- Variable range. add ET terms to both RHS and HCOF. if (this%nseg > 1) then @@ -673,8 +603,8 @@ subroutine evt_cf(this, reset_mover) end if ! -- Initialize indices to point to elements preceding ! pxdp1 and petm1 (values for lower end of segment 1). - idxdepth = 3 - idxrate = 2 + this%nseg + idxdepth = 0 + idxrate = 0 ! -- Iterate through segments to find segment that contains ! current depth of head below ET surface. segloop: do iseg = 1, this%nseg @@ -685,8 +615,8 @@ subroutine evt_cf(this, reset_mover) idxdepth = idxdepth + 1 idxrate = idxrate + 1 ! -- Get proportions for lower end of segment - pxdp2 = this%bound(idxdepth, i) - petm2 = this%bound(idxrate, i) + pxdp2 = this%pxdp(idxdepth, i) + petm2 = this%petm(idxrate, i) else pxdp2 = DONE petm2 = DZERO @@ -718,17 +648,13 @@ subroutine evt_cf(this, reset_mover) ! end do ! - ! -- return + ! -- Return return end subroutine evt_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine evt_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! evt_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(EvtType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -737,7 +663,6 @@ subroutine evt_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, n, ipos -! -------------------------------------------------------------------------- ! ! -- Copy package rhs and hcof into solution rhs and amat do i = 1, this%nbound @@ -754,379 +679,57 @@ subroutine evt_fc(this, rhs, ia, idxglo, matrix_sln) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) end do ! - ! -- return + ! -- Return return end subroutine evt_fc + !> @brief Deallocate + !< subroutine evt_da(this) -! ****************************************************************************** -! evt_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(EvtType) :: this -! ------------------------------------------------------------------------------ ! ! -- arrays if (associated(this%nodesontop)) deallocate (this%nodesontop) + call mem_deallocate(this%surface, 'SURFACE', this%memoryPath) + call mem_deallocate(this%rate, 'RATE', this%memoryPath) + call mem_deallocate(this%depth, 'DEPTH', this%memoryPath) + ! + if (.not. this%read_as_arrays) then + if (this%nseg > 1) then + call mem_deallocate(this%pxdp, 'PXDP', this%memoryPath) + call mem_deallocate(this%petm, 'PETM', this%memoryPath) + end if + ! + if (this%surfratespecified) then + call mem_deallocate(this%petm0, 'PETM0', this%memoryPath) + end if + end if ! ! -- scalars - call mem_deallocate(this%inievt) call mem_deallocate(this%nseg) + deallocate (this%segsdefined) + deallocate (this%fixed_cell) + deallocate (this%read_as_arrays) + deallocate (this%surfratespecified) ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! - ! -- return + ! -- Return return end subroutine evt_da - subroutine evt_rp_array(this, line, inrate, insurf, indepth, & - kpxdp, kpetm) -! ****************************************************************************** -! evt_rp_array -- Read and Prepare EVT as arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LENTIMESERIESNAME, LINELENGTH - use SimModule, only: store_error - use ArrayHandlersModule, only: ifind - ! -- dummy - class(EvtType), intent(inout) :: this - character(len=LINELENGTH), intent(inout) :: line - integer(I4B), intent(inout) :: inrate - integer(I4B), intent(inout) :: insurf - integer(I4B), intent(inout) :: indepth - integer(I4B), intent(inout) :: kpxdp - integer(I4B), intent(inout) :: kpetm - ! -- local - integer(I4B) :: n - integer(I4B) :: indx, ipos - integer(I4B) :: jcol, jauxcol, lpos, ivarsread - character(len=LENTIMESERIESNAME) :: tasName - character(len=24), dimension(6) :: aname - character(len=100) :: ermsg, keyword, atemp - logical :: found, endOfBlock - logical :: convertFlux - ! - ! -- these time array series pointers need to be non-contiguous - ! beacuse a slice of bound is passed - real(DP), dimension(:), pointer :: bndArrayPtr => null() - real(DP), dimension(:), pointer :: auxArrayPtr => null() - real(DP), dimension(:), pointer :: auxMultArray => null() - type(TimeArraySeriesLinkType), pointer :: tasLink => null() - ! -- formats - character(len=*), parameter :: fmtevtauxmult = & - "(4x, 'THE ET RATE ARRAY IS BEING MULTIPLED BY THE AUXILIARY ARRAY WITH & - &THE NAME: ', A)" - ! -- data - data aname(1)/' LAYER OR NODE INDEX'/ - data aname(2)/' ET SURFACE'/ - data aname(3)/' EVAPOTRANSPIRATION RATE'/ - data aname(4)/' EXTINCTION DEPTH'/ - data aname(5)/'EXTINCT. DEP. PROPORTION'/ - data aname(6)/' ET RATE PROPORTION'/ -! ------------------------------------------------------------------------------ - ! - ! -- Initialize - jauxcol = 0 - ivarsread = 0 - ! - ! -- Read IEVT, SURFACE, RATE, DEPTH, PXDP, PETM, and AUX - ! as arrays - kpetm = 0 - kpxdp = 0 - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - ! - ! -- Parse the keywords - select case (keyword) - case ('IEVT') - ! - ! -- Check to see if other variables have already been read. If so, - ! then terminate with an error that IEVT must be read first. - if (ivarsread > 0) then - call store_error('IEVT is not first variable in & - &period block or it is specified more than once.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Read the IEVT array - call this%dis%nlarray_to_nodelist(this%nodelist, this%maxbound, & - this%nbound, aname(1), & - this%parser%iuactive, this%iout) - ! - ! -- set flag to indicate that IEVT has been read - this%inievt = 1 - ! - ! -- if highest_active option set, then need to store nodelist - ! in the nodesontop array - if (.not. this%fixed_cell) call this%set_nodesontop() - ! - case ('SURFACE') - ! - if (this%inievt == 0) then - call store_error('IEVT must be read at least once & - &prior to reading the SURFACE array.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Read the surface array, then indicate - ! that surface array was read by setting insurf - call this%dis%read_layer_array(this%nodelist, this%bound, this%ncolbnd, & - this%maxbound, 1, aname(2), & - this%parser%iuactive, this%iout) - insurf = 1 - ! - case ('RATE') - ! - ! -- Look for keyword TIMEARRAYSERIES and time-array series - ! name on line, following RATE - call this%parser%GetStringCaps(keyword) - if (keyword == 'TIMEARRAYSERIES') then - ! -- Get time-array series name - call this%parser%GetStringCaps(tasName) - ! -- Ensure that time-array series has been defined and that name - ! of time-array series is valid. - jcol = 2 ! for max ET rate - bndArrayPtr => this%bound(jcol, :) - ! Make a time-array-series link and add it to the list of links - ! contained in the TimeArraySeriesManagerType object. - convertflux = .true. - call this%TasManager%MakeTasLink(this%packName, bndArrayPtr, & - this%iprpak, tasName, 'RATE', & - convertFlux, this%nodelist, & - this%parser%iuactive) - lpos = this%TasManager%CountLinks() - tasLink => this%TasManager%GetLink(lpos) - inrate = 2 - else - ! - ! -- Read the Max. ET Rate array, then indicate - ! that rate array was read by setting inrate - call this%dis%read_layer_array(this%nodelist, this%bound, & - this%ncolbnd, this%maxbound, 2, & - aname(3), this%parser%iuactive, & - this%iout) - inrate = 1 - end if - ! - case ('DEPTH') - ! - if (this%inievt == 0) then - call store_error('IEVT must be read at least once & - &prior to reading the DEPTH array.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Read the extinction-depth array, then indicate - ! that depth array was read by setting indepth - call this%dis%read_layer_array(this%nodelist, this%bound, this%ncolbnd, & - this%maxbound, 3, aname(4), & - this%parser%iuactive, this%iout) - indepth = 1 - ! - case ('PXDP') - if (this%nseg < 2) then - ermsg = 'EVT input: PXDP cannot be specified when NSEG < 2' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - if (this%inievt == 0) then - call store_error('IEVT must be read at least once & - &prior to reading any PXDP array.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Assign column for this PXDP vector in bound array - kpxdp = kpxdp + 1 - if (kpxdp < this%nseg - 1) this%segsdefined = .false. - if (kpxdp > this%nseg - 1) then - ermsg = 'EVT: Number of PXDP arrays exceeds NSEG-1.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - indx = 3 + kpxdp - ! - ! -- Read the PXDP array - call this%dis%read_layer_array(this%nodelist, this%bound, this%ncolbnd, & - this%maxbound, indx, aname(5), & - this%parser%iuactive, this%iout) - ! - case ('PETM') - if (this%nseg < 2) then - ermsg = 'EVT input: PETM cannot be specified when NSEG < 2' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - if (this%inievt == 0) then - call store_error('IEVT must be read at least once & - &prior to reading any PETM array.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Assign column for this PETM vector in bound array - kpetm = kpetm + 1 - if (kpetm < this%nseg - 1) this%segsdefined = .false. - if (kpetm > this%nseg - 1) then - ermsg = 'EVT: Number of PETM arrays exceeds NSEG-1.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - indx = 3 + this%nseg - 1 + kpetm - ! - ! -- Read the PETM array - call this%dis%read_layer_array(this%nodelist, this%bound, this%ncolbnd, & - this%maxbound, indx, aname(6), & - this%parser%iuactive, this%iout) - ! - case default - ! - ! -- Check for auxname, and if found, then read into auxvar array - found = .false. - ipos = ifind(this%auxname, keyword) - if (ipos > 0) then - found = .true. - atemp = keyword - ! - ! -- Look for keyword TIMEARRAYSERIES and time-array series - ! name on line, following auxname - call this%parser%GetStringCaps(keyword) - if (keyword == 'TIMEARRAYSERIES') then - ! -- Get time-array series name - call this%parser%GetStringCaps(tasName) - jauxcol = jauxcol + 1 - auxArrayPtr => this%auxvar(jauxcol, :) - ! Make a time-array-series link and add it to the list of links - ! contained in the TimeArraySeriesManagerType object. - convertflux = .false. - call this%TasManager%MakeTasLink(this%packName, auxArrayPtr, & - this%iprpak, tasName, & - this%auxname(ipos), convertFlux, & - this%nodelist, this%parser%iuactive) - else - ! - ! -- Read the aux variable array - call this%dis%read_layer_array(this%nodelist, this%auxvar, & - this%naux, this%maxbound, ipos, & - atemp, this%parser%iuactive, & - this%iout) - end if - end if - ! - ! -- Nothing found - if (.not. found) then - call this%parser%GetCurrentLine(line) - call store_error('Looking for valid variable name. Found: ') - call store_error(trim(line)) - call this%parser%StoreErrorUnit() - end if - ! - ! If this aux variable has been designated as a multiplier array - ! by presence of AUXMULTNAME, set local pointer appropriately. - if (this%iauxmultcol > 0 .and. this%iauxmultcol == ipos) then - auxMultArray => this%auxvar(this%iauxmultcol, :) - end if - end select - ! - ! -- Increment the number of variables read - ivarsread = ivarsread + 1 - ! - end do - ! - ! -- Ensure that all required PXDP and PETM arrays - ! have been defined or redefined. - if (kpxdp == this%nseg - 1 .and. kpxdp == this%nseg - 1) then - this%segsdefined = .true. - end if - if (.not. this%segsdefined) then - ermsg = 'EVT input: Definition of PXDP or PETM is incomplete.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - ! If the multiplier-array pointer has been assigned and - ! stress is controlled by a time-array series, assign - ! multiplier-array pointer in time-array series link. - if (associated(auxMultArray)) then - if (associated(tasLink)) then - tasLink%RMultArray => auxMultArray - end if - end if - ! - ! -- If et rate was read and auxmultcol was specified, then multiply - ! the et rate by the multplier column - if (inrate == 1 .and. this%iauxmultcol > 0) then - write (this%iout, fmtevtauxmult) this%auxname(this%iauxmultcol) - do n = 1, this%nbound - this%bound(this%iscloc, n) = this%bound(this%iscloc, n) * & - this%auxvar(this%iauxmultcol, n) - end do - end if - ! - return - end subroutine evt_rp_array - - subroutine evt_rp_list(this, inrate) -! ****************************************************************************** -! evt_rp_list -- Read and Prepare EVT as a list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< + subroutine evt_define_listlabel(this) ! -- dummy class(EvtType), intent(inout) :: this - integer(I4B), intent(inout) :: inrate ! -- local - integer(I4B) :: maxboundorig, nlist -! ------------------------------------------------------------------------------ - ! - nlist = -1 - maxboundorig = this%maxbound - call this%dis%read_list(this%parser%iuactive, this%iout, this%iprpak, & - nlist, this%inamedbound, this%iauxmultcol, & - this%nodelist, this%bound, this%auxvar, & - this%auxname, this%boundname, this%listlabel, & - this%packName, this%tsManager, this%iscloc, & - this%indxconvertflux) - this%nbound = nlist - if (this%maxbound > maxboundorig) then - ! -- The arrays that belong to BndType have been extended. - ! Now, EVT array nodesontop needs to be recreated. - if (associated(this%nodesontop)) then - deallocate (this%nodesontop) - end if - end if - if (.not. this%fixed_cell) call this%set_nodesontop() - inrate = 1 - ! - ! -- terminate the period block - call this%parser%terminateblock() - ! - return - end subroutine evt_rp_list - - subroutine evt_define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - class(EvtType), intent(inout) :: this integer(I4B) :: nsegm1, i -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -1169,27 +772,22 @@ subroutine evt_define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine evt_define_listlabel + !> @brief Assign default nodelist when READASARRAYS is specified. + !! + !! Equivalent to reading IEVT as CONSTANT 1 + !< subroutine default_nodelist(this) -! ****************************************************************************** -! default_nodelist -- Assign default nodelist when READASARRAYS is specified. -! Equivalent to reading IEVT as CONSTANT 1 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: get_node use SimModule, only: store_error use ConstantsModule, only: LINELENGTH ! -- dummy class(EvtType) :: this ! -- local integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nodeu, noder, ipos -! ------------------------------------------------------------------------------ ! ! -- set variables if (this%dis%ndim == 3) then @@ -1214,95 +812,159 @@ subroutine default_nodelist(this) end do end do ! - ! Set flag that indicates IEVT has been assigned, and assign nbound. - this%inievt = 1 + ! -- assign nbound. this%nbound = ipos - 1 ! ! -- if fixed_cell option not set, then need to store nodelist ! in the nodesontop array if (.not. this%fixed_cell) call this%set_nodesontop() ! - ! -- return + ! -- Return + return end subroutine default_nodelist ! -- Procedures related to observations + !> @brief Return true because EVT package supports observations + !! + !! Overrides BndType%bnd_obs_supported() + !< logical function evt_obs_supported(this) -! ****************************************************************************** -! evt_obs_supported -! -- Return true because EVT package supports observations. -! -- Overrides BndType%bnd_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(EvtType) :: this -! ------------------------------------------------------------------------------ + ! evt_obs_supported = .true. ! - ! -- return + ! -- Return return end function evt_obs_supported + !> @brief Store observation type supported by EVT package + !! + !! Overrides BndType%bnd_df_obs + !< subroutine evt_df_obs(this) -! ****************************************************************************** -! evt_df_obs (implements bnd_df_obs) -! -- Store observation type supported by EVT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(EvtType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('evt', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine evt_df_obs - ! -- Procedure related to time series + !> @brief Return requested boundary value + !< + function evt_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(EvtType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! -- local + integer(I4B) :: idx + ! + ! -- initialize + idx = 0 + ! + select case (col) + case (1) + bndval = this%surface(row) + case (2) + if (this%iauxmultcol > 0) then + bndval = this%rate(row) * this%auxvar(this%iauxmultcol, row) + else + bndval = this%rate(row) + end if + case (3) + bndval = this%depth(row) + case default + if (col > 0) then + if (this%nseg > 1) then + if (col < (3 + this%nseg)) then + idx = col - 3 + bndval = this%pxdp(idx, row) + else if (col < (3 + (2 * this%nseg) - 1)) then + idx = col - (3 + this%nseg - 1) + bndval = this%petm(idx, row) + else if (col == (3 + (2 * this%nseg) - 1)) then + if (this%surfratespecified) then + idx = 1 + bndval = this%petm0(row) + end if + end if + else if (this%surfratespecified) then + if (col == 4) then + idx = 1 + bndval = this%petm0(row) + end if + end if + end if + ! + ! -- set error if idx not found + if (idx == 0) then + write (errmsg, '(a,i0,a)') & + 'Programming error. EVT bound value requested column '& + &'outside range of ncolbnd (', this%ncolbnd, ').' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + end select + ! + ! -- Return + return + end function evt_bound_value - subroutine evt_rp_ts(this) -! ****************************************************************************** -! evt_rp_ts -- Assign tsLink%Text appropriately for -! all time series in use by package. -! In EVT package the SURFACE, RATE, DEPTH, PXDP, and PETM variables -! can be controlled by time series. -! Define Text only when time series is used for SURFACE, RATE, or DEPTH. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Update the nodelist based on IEVT input + !! + !! This is a module scoped routine to check for IEVT input. If array input + !! was provided, INIEVT and IEVT will be allocated in the input context. + !! If the read state variable INIEVT is set to 1 during this period update, + !! IEVT input was read and is used here to update the nodelist. + !< + subroutine nodelist_update(nodelist, nbound, maxbound, & + dis, input_mempath) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use BaseDisModule, only: DisBaseType ! -- dummy - class(EvtType), intent(inout) :: this + integer(I4B), dimension(:), contiguous, & + pointer, intent(inout) :: nodelist + class(DisBaseType), pointer, intent(in) :: dis + character(len=*), intent(in) :: input_mempath + integer(I4B), intent(inout) :: nbound + integer(I4B), intent(in) :: maxbound + ! -- format + character(len=24) :: aname = ' LAYER OR NODE INDEX' ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() -! ------------------------------------------------------------------------------ - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'SURFACE' - case (2) - tslink%Text = 'RATE' - case (3) - tslink%Text = 'DEPTH' - end select - end if - end do + integer(I4B), dimension(:), contiguous, pointer :: ievt => null() + integer(I4B), pointer :: inievt => NULL() + ! + ! -- set pointer to input context INIEVT + call mem_setptr(inievt, 'INIEVT', input_mempath) + ! + ! -- check INIEVT read state + if (inievt == 1) then + ! -- ievt was read this period + ! + ! -- set pointer to input context IEVT + call mem_setptr(ievt, 'IEVT', input_mempath) + ! + ! -- update nodelist + call dis%nlarray_to_nodelist(ievt, nodelist, & + maxbound, nbound, aname) + end if ! + ! -- Return return - end subroutine evt_rp_ts + end subroutine nodelist_update end module EvtModule diff --git a/src/Model/GroundWaterFlow/gwf3evt8idm.f90 b/src/Model/GroundWaterFlow/gwf3evt8idm.f90 new file mode 100644 index 00000000000..9ed6fe5ba12 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3evt8idm.f90 @@ -0,0 +1,563 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfEvtInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_evt_param_definitions + public gwf_evt_aggregate_definitions + public gwf_evt_block_definitions + public GwfEvtParamFoundType + public gwf_evt_multi_package + + type GwfEvtParamFoundType + logical :: fixed_cell = .false. + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: surfratespec = .false. + logical :: maxbound = .false. + logical :: nseg = .false. + logical :: cellid = .false. + logical :: surface = .false. + logical :: rate = .false. + logical :: depth = .false. + logical :: pxdp = .false. + logical :: petm = .false. + logical :: petm0 = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfEvtParamFoundType + + logical :: gwf_evt_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfevt_fixed_cell = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'FIXED_CELL', & ! tag name + 'FIXED_CELL', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_surfratespec = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'OPTIONS', & ! block + 'SURF_RATE_SPECIFIED', & ! tag name + 'SURFRATESPEC', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_nseg = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'DIMENSIONS', & ! block + 'NSEG', & ! tag name + 'NSEG', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_surface = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'SURFACE', & ! tag name + 'SURFACE', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_rate = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'RATE', & ! tag name + 'RATE', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_depth = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'DEPTH', & ! tag name + 'DEPTH', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_pxdp = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'PXDP', & ! tag name + 'PXDP', & ! fortran variable + 'DOUBLE1D', & ! type + 'NSEG-1', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_petm = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'PETM', & ! tag name + 'PETM', & ! fortran variable + 'DOUBLE1D', & ! type + 'NSEG-1', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_petm0 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'PETM0', & ! tag name + 'PETM0', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevt_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_evt_param_definitions(*) = & + [ & + gwfevt_fixed_cell, & + gwfevt_auxiliary, & + gwfevt_auxmultname, & + gwfevt_boundnames, & + gwfevt_iprpak, & + gwfevt_iprflow, & + gwfevt_ipakcb, & + gwfevt_ts_filerecord, & + gwfevt_ts6, & + gwfevt_filein, & + gwfevt_ts6_filename, & + gwfevt_obs_filerecord, & + gwfevt_obs6, & + gwfevt_obs6_filename, & + gwfevt_surfratespec, & + gwfevt_maxbound, & + gwfevt_nseg, & + gwfevt_cellid, & + gwfevt_surface, & + gwfevt_rate, & + gwfevt_depth, & + gwfevt_pxdp, & + gwfevt_petm, & + gwfevt_petm0, & + gwfevt_auxvar, & + gwfevt_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfevt_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVT', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID SURFACE RATE DEPTH PXDP PETM PETM0 AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_evt_aggregate_definitions(*) = & + [ & + gwfevt_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_evt_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfEvtInputModule diff --git a/src/Model/GroundWaterFlow/gwf3evta8idm.f90 b/src/Model/GroundWaterFlow/gwf3evta8idm.f90 new file mode 100644 index 00000000000..a5f9a6ea56d --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3evta8idm.f90 @@ -0,0 +1,421 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfEvtaInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_evta_param_definitions + public gwf_evta_aggregate_definitions + public gwf_evta_block_definitions + public GwfEvtaParamFoundType + public gwf_evta_multi_package + + type GwfEvtaParamFoundType + logical :: readasarrays = .false. + logical :: fixed_cell = .false. + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: tas_filerecord = .false. + logical :: tas6 = .false. + logical :: filein = .false. + logical :: tas6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: ievt = .false. + logical :: surface = .false. + logical :: rate = .false. + logical :: depth = .false. + logical :: auxvar = .false. + end type GwfEvtaParamFoundType + + logical :: gwf_evta_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfevta_readasarrays = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'READASARRAYS', & ! tag name + 'READASARRAYS', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_fixed_cell = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'FIXED_CELL', & ! tag name + 'FIXED_CELL', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_tas_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS_FILERECORD', & ! tag name + 'TAS_FILERECORD', & ! fortran variable + 'RECORD TAS6 FILEIN TAS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_tas6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6', & ! tag name + 'TAS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_tas6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6_FILENAME', & ! tag name + 'TAS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_ievt = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'PERIOD', & ! block + 'IEVT', & ! tag name + 'IEVT', & ! fortran variable + 'INTEGER1D', & ! type + 'NCPL', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_surface = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'PERIOD', & ! block + 'SURFACE', & ! tag name + 'SURFACE', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_rate = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'PERIOD', & ! block + 'RATE', & ! tag name + 'RATE', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_depth = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'PERIOD', & ! block + 'DEPTH', & ! tag name + 'DEPTH', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfevta_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'EVTA', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE2D', & ! type + 'NAUX NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_evta_param_definitions(*) = & + [ & + gwfevta_readasarrays, & + gwfevta_fixed_cell, & + gwfevta_auxiliary, & + gwfevta_auxmultname, & + gwfevta_iprpak, & + gwfevta_iprflow, & + gwfevta_ipakcb, & + gwfevta_tas_filerecord, & + gwfevta_tas6, & + gwfevta_filein, & + gwfevta_tas6_filename, & + gwfevta_obs_filerecord, & + gwfevta_obs6, & + gwfevta_obs6_filename, & + gwfevta_ievt, & + gwfevta_surface, & + gwfevta_rate, & + gwfevta_depth, & + gwfevta_auxvar & + ] + + type(InputParamDefinitionType), parameter :: & + gwf_evta_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_evta_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .false., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfEvtaInputModule diff --git a/src/Model/GroundWaterFlow/gwf3ghb8.f90 b/src/Model/GroundWaterFlow/gwf3ghb8.f90 index d3b2b956164..f4f4cc3dda2 100644 --- a/src/Model/GroundWaterFlow/gwf3ghb8.f90 +++ b/src/Model/GroundWaterFlow/gwf3ghb8.f90 @@ -1,11 +1,12 @@ module ghbmodule use KindModule, only: DP, I4B use ConstantsModule, only: DZERO, LENFTYPE, LENPACKAGENAME + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename use MemoryHelperModule, only: create_mem_path use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObsModule, only: DefaultObsIdProcessor - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use MatrixBaseModule ! implicit none @@ -17,31 +18,33 @@ module ghbmodule character(len=LENFTYPE) :: ftype = 'GHB' character(len=LENPACKAGENAME) :: text = ' GHB' ! - type, extends(BndType) :: GhbType + type, extends(BndExtType) :: GhbType + real(DP), dimension(:), pointer, contiguous :: bhead => null() !< GHB boundary head + real(DP), dimension(:), pointer, contiguous :: cond => null() !< GHB hydraulic conductance contains - procedure :: bnd_options => ghb_options + procedure :: allocate_arrays => ghb_allocate_arrays + procedure :: source_options => ghb_options + procedure :: log_ghb_options + procedure :: bnd_rp => ghb_rp procedure :: bnd_ck => ghb_ck procedure :: bnd_cf => ghb_cf procedure :: bnd_fc => ghb_fc + procedure :: bnd_da => ghb_da procedure :: define_listlabel + procedure :: bound_value => ghb_bound_value + procedure :: cond_mult ! -- methods for observations procedure, public :: bnd_obs_supported => ghb_obs_supported procedure, public :: bnd_df_obs => ghb_df_obs - ! -- method for time series - procedure, public :: bnd_rp_ts => ghb_rp_ts + procedure, public :: ghb_store_user_cond end type GhbType contains - subroutine ghb_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! ghb_create -- Create a New Ghb Package -! Subroutine: (1) create new-style package -! (2) point bndobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a New Ghb Package and point bndobj to the new package + !< + subroutine ghb_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -50,16 +53,16 @@ subroutine ghb_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(GhbType), pointer :: ghbobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (ghbobj) packobj => ghbobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -72,51 +75,138 @@ subroutine ghb_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 2 - packobj%iscloc = 2 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine ghb_create - subroutine ghb_options(this, option, found) -! ****************************************************************************** -! ghb_options -- set options specific to GhbType -! -! ghb_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Deallocate memory + !< + subroutine ghb_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(GhbType) :: this + ! + ! -- Deallocate parent package + call this%BndExtType%bnd_da() + ! + ! -- arrays + call mem_deallocate(this%bhead, 'BHEAD', this%memoryPath) + call mem_deallocate(this%cond, 'COND', this%memoryPath) + ! + ! -- Return + return + end subroutine ghb_da + + !> @brief Set options specific to GhbType + !< + subroutine ghb_options(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use GwfGhbInputModule, only: GwfGhbParamFoundType ! -- dummy class(GhbType), intent(inout) :: this - character(len=*), intent(inout) :: option - logical, intent(inout) :: found -! ------------------------------------------------------------------------------ + ! -- local + type(GwfGhbParamFoundType) :: found ! - select case (option) - case ('MOVER') - this%imover = 1 - write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' - found = .true. - case default - ! - ! -- No options found - found = .false. - end select + ! -- source base class options + call this%BndExtType%source_options() + ! + ! -- source options from input context + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) ! - ! -- return + ! -- log ghb specific options + call this%log_ghb_options(found) + ! + ! -- Return return end subroutine ghb_options + !> @brief Log options specific to GhbType + !< + subroutine log_ghb_options(this, found) + ! -- modules + use GwfGhbInputModule, only: GwfGhbParamFoundType + ! -- dummy + class(GhbType), intent(inout) :: this !< BndExtType object + type(GwfGhbParamFoundType), intent(in) :: found + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found%mover) then + write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' + ! + ! -- Return + return + end subroutine log_ghb_options + + !> @brief Allocate arrays + !< + subroutine ghb_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(GhbType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! + ! -- call base type allocate arrays + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set ghb input context pointers + call mem_setptr(this%bhead, 'BHEAD', this%input_mempath) + call mem_setptr(this%cond, 'COND', this%input_mempath) + ! + ! --checkin ghb input context pointers + call mem_checkin(this%bhead, 'BHEAD', this%memoryPath, & + 'BHEAD', this%input_mempath) + call mem_checkin(this%cond, 'COND', this%memoryPath, & + 'COND', this%input_mempath) + ! + ! -- Return + return + end subroutine ghb_allocate_arrays + + !> @brief Read and prepare + !< + subroutine ghb_rp(this) + ! -- modules + use TdisModule, only: kper + ! -- dummy + class(GhbType), intent(inout) :: this + ! + if (this%iper /= kper) return + ! + ! -- Call the parent class read and prepare + call this%BndExtType%bnd_rp() + ! + ! -- store user cond + if (this%ivsc == 1) then + call this%ghb_store_user_cond() + end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! + ! -- Return + return + end subroutine ghb_rp + + !> @brief Check ghb boundary condition data + !< subroutine ghb_ck(this) -! ****************************************************************************** -! ghb_ck -- Check ghb boundary condition data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -131,15 +221,14 @@ subroutine ghb_ck(this) character(len=*), parameter :: fmtghberr = & "('GHB BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & &BOTTOM (',f10.3,')')" -! ------------------------------------------------------------------------------ ! ! -- check stress period data do i = 1, this%nbound node = this%nodelist(i) bt = this%dis%bot(node) ! -- accumulate errors - if (this%bound(1, i) < bt .and. this%icelltype(node) /= 0) then - write (errmsg, fmt=fmtghberr) i, this%bound(1, i), bt + if (this%bhead(i) < bt .and. this%icelltype(node) /= 0) then + write (errmsg, fmt=fmtghberr) i, this%bhead(i), bt call store_error(errmsg) end if end do @@ -149,37 +238,23 @@ subroutine ghb_ck(this) call store_error_unit(this%inunit) end if ! - ! -- return + ! -- Return return end subroutine ghb_ck - subroutine ghb_cf(this, reset_mover) -! ****************************************************************************** -! ghb_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no ghbs -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no GHBs + !< + subroutine ghb_cf(this) ! -- dummy class(GhbType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node - logical :: lrm -! ------------------------------------------------------------------------------ ! ! -- Return if no ghbs if (this%nbound .eq. 0) return ! - ! -- packmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each ghb entry do i = 1, this%nbound node = this%nodelist(i) @@ -188,21 +263,17 @@ subroutine ghb_cf(this, reset_mover) this%rhs(i) = DZERO cycle end if - this%hcof(i) = -this%bound(2, i) - this%rhs(i) = -this%bound(2, i) * this%bound(1, i) + this%hcof(i) = -this%cond_mult(i) + this%rhs(i) = -this%cond_mult(i) * this%bhead(i) end do ! - ! -- return + ! -- Return return end subroutine ghb_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine ghb_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! ghb_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(GhbType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -212,7 +283,6 @@ subroutine ghb_fc(this, rhs, ia, idxglo, matrix_sln) ! -- local integer(I4B) :: i, n, ipos real(DP) :: cond, bhead, qghb -! -------------------------------------------------------------------------- ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -228,28 +298,24 @@ subroutine ghb_fc(this, rhs, ia, idxglo, matrix_sln) ! ! -- If mover is active and this boundary is discharging, ! store available water (as positive value). - bhead = this%bound(1, i) + bhead = this%bhead(i) if (this%imover == 1 .and. this%xnew(n) > bhead) then - cond = this%bound(2, i) + cond = this%cond_mult(i) qghb = cond * (this%xnew(n) - bhead) call this%pakmvrobj%accumulate_qformvr(i, qghb) end if end do ! - ! -- return + ! -- Return return end subroutine ghb_fc + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(GhbType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -269,43 +335,38 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel ! -- Procedures related to observations + !> @brief Return true because GHB package supports observations + !! + !! Overrides BndType%bnd_obs_supported() + !< logical function ghb_obs_supported(this) - ! ****************************************************************************** - ! ghb_obs_supported - ! -- Return true because GHB package supports observations. - ! -- Overrides BndType%bnd_obs_supported() - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none + ! -- dummy class(GhbType) :: this - ! ------------------------------------------------------------------------------ + ! ghb_obs_supported = .true. + ! + ! -- Return return end function ghb_obs_supported + !> @brief Store observation type supported by GHB package + !! + !! Overrides BndType%bnd_df_obs + !< subroutine ghb_df_obs(this) - ! ****************************************************************************** - ! ghb_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by GHB package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none ! -- dummy class(GhbType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('ghb', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! @@ -314,37 +375,74 @@ subroutine ghb_df_obs(this) call this%obs%StoreObsType('to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine ghb_df_obs - ! - ! -- Procedure related to time series - ! - subroutine ghb_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In GHB package variables BHEAD and COND - ! can be controlled by time series. + + !> @brief Store user-specified conductance for GHB boundary type + !< + subroutine ghb_store_user_cond(this) ! -- dummy - class(GhbType), intent(inout) :: this + class(GhbType), intent(inout) :: this !< BndExtType object ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'BHEAD' - case (2) - tslink%Text = 'COND' - end select - end if + integer(I4B) :: n + ! + ! -- store backup copy of conductance values + do n = 1, this%nbound + this%condinput(n) = this%cond_mult(n) end do ! + ! -- Return + return + end subroutine ghb_store_user_cond + + !> @brief Apply multiplier to GHB conductance if option AUXMULTCOL is used + !< + function cond_mult(this, row) result(cond) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(GhbType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: cond + ! + if (this%iauxmultcol > 0) then + cond = this%cond(row) * this%auxvar(this%iauxmultcol, row) + else + cond = this%cond(row) + end if + ! + ! -- Return + return + end function cond_mult + + !> @brief Return requested boundary value + !< + function ghb_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy + class(GhbType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%bhead(row) + case (2) + bndval = this%cond_mult(row) + case default + errmsg = 'Programming error. GHB bound value requested column '& + &'outside range of ncolbnd (2).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + ! + ! -- Return return - end subroutine ghb_rp_ts + end function ghb_bound_value end module ghbmodule diff --git a/src/Model/GroundWaterFlow/gwf3ghb8idm.f90 b/src/Model/GroundWaterFlow/gwf3ghb8idm.f90 new file mode 100644 index 00000000000..2774d26c883 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3ghb8idm.f90 @@ -0,0 +1,449 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfGhbInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_ghb_param_definitions + public gwf_ghb_aggregate_definitions + public gwf_ghb_block_definitions + public GwfGhbParamFoundType + public gwf_ghb_multi_package + + type GwfGhbParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: mover = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: bhead = .false. + logical :: cond = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfGhbParamFoundType + + logical :: gwf_ghb_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfghb_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_mover = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'OPTIONS', & ! block + 'MOVER', & ! tag name + 'MOVER', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_bhead = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'BHEAD', & ! tag name + 'BHEAD', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_cond = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'COND', & ! tag name + 'COND', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghb_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_ghb_param_definitions(*) = & + [ & + gwfghb_auxiliary, & + gwfghb_auxmultname, & + gwfghb_boundnames, & + gwfghb_iprpak, & + gwfghb_iprflow, & + gwfghb_ipakcb, & + gwfghb_ts_filerecord, & + gwfghb_ts6, & + gwfghb_filein, & + gwfghb_ts6_filename, & + gwfghb_obs_filerecord, & + gwfghb_obs6, & + gwfghb_obs6_filename, & + gwfghb_mover, & + gwfghb_maxbound, & + gwfghb_cellid, & + gwfghb_bhead, & + gwfghb_cond, & + gwfghb_auxvar, & + gwfghb_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfghb_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHB', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID BHEAD COND AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_ghb_aggregate_definitions(*) = & + [ & + gwfghb_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_ghb_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfGhbInputModule diff --git a/src/Model/GroundWaterFlow/gwf3hfb8.f90 b/src/Model/GroundWaterFlow/gwf3hfb8.f90 index 8fc3199f551..76f951a75e5 100644 --- a/src/Model/GroundWaterFlow/gwf3hfb8.f90 +++ b/src/Model/GroundWaterFlow/gwf3hfb8.f90 @@ -45,6 +45,7 @@ module GwfHfbModule integer(I4B), pointer :: ivsc => null() !< flag indicating if viscosity is active in the model contains + procedure :: hfb_ar procedure :: hfb_rp procedure :: hfb_fc @@ -63,19 +64,14 @@ module GwfHfbModule contains + !> @brief Create a new hfb object + !< subroutine hfb_cr(hfbobj, name_model, inunit, iout) -! ****************************************************************************** -! hfb_cr -- Create a new hfb object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(GwfHfbType), pointer :: hfbobj character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (hfbobj) @@ -97,13 +93,9 @@ subroutine hfb_cr(hfbobj, name_model, inunit, iout) return end subroutine hfb_cr + !> @brief Allocate and read + !< subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc) -! ****************************************************************************** -! hfb_ar -- Allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_setptr use MemoryHelperModule, only: create_mem_path @@ -114,12 +106,10 @@ subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc) class(DisBaseType), pointer, intent(inout) :: dis !< discretization package integer(I4B), pointer :: invsc !< indicates if viscosity package is active type(GwfVscType), pointer, intent(in) :: vsc !< viscosity package - ! -- local ! -- formats character(len=*), parameter :: fmtheader = & "(1x, /1x, 'HFB -- HORIZONTAL FLOW BARRIER PACKAGE, VERSION 8, ', & &'4/24/2015 INPUT READ FROM UNIT ', i4, //)" -! ------------------------------------------------------------------------------ ! ! -- Print a message identifying the node property flow package. write (this%iout, fmtheader) this%inunit @@ -128,7 +118,7 @@ subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc) this%dis => dis this%ibound => ibound this%xt3d => xt3d - + ! call mem_setptr(this%icelltype, 'ICELLTYPE', & create_mem_path(this%name_model, 'NPF')) call mem_setptr(this%ihc, 'IHC', create_mem_path(this%name_model, 'CON')) @@ -156,17 +146,13 @@ subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc) trim(this%filtyp)//' Package calculations: '//trim(adjustl(this%packName)) end if ! - ! -- return + ! -- Return return end subroutine hfb_ar + !> @brief Check for new HFB stress period data + !< subroutine hfb_rp(this) -! ****************************************************************************** -! hfb_rp -- Check for new hfb stress period data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -182,7 +168,6 @@ subroutine hfb_rp(this) &"('Error. Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" character(len=*), parameter :: fmtlsp = & &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" -! ------------------------------------------------------------------------------ ! ! -- Set ionper to the stress period number for which a new block of data ! will be read. @@ -220,21 +205,19 @@ subroutine hfb_rp(this) write (this%iout, fmtlsp) 'HFB' end if ! - ! -- return + ! -- Return return end subroutine hfb_rp + !> @brief Fill matrix terms + !! + !! Fill amatsln for the following conditions: + !! 1. XT3D + !! OR + !! 2. Not Newton, and + !! 3. Cell type n is convertible or cell type m is convertible + !< subroutine hfb_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! hfb_fc -- Fill amatsln for the following conditions: -! 1. Not Newton, and -! 2. Cell type n is convertible or cell type m is convertible -! OR -! 3. XT3D -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO, DONE ! -- dummy @@ -254,7 +237,6 @@ subroutine hfb_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) real(DP) :: fawidth, faheight real(DP) :: topn, topm, botn, botm real(DP) :: viscratio -! ------------------------------------------------------------------------------ ! ! -- initialize variables viscratio = DONE @@ -373,19 +355,16 @@ subroutine hfb_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) ! end if ! - ! -- return + ! -- Return return end subroutine hfb_fc + !> @brief flowja will automatically include the effects of the hfb for + !! confined and newton cases when xt3d is not used. + !! + !! This method recalculates flowja for the other cases. + !< subroutine hfb_cq(this, hnew, flowja) -! ****************************************************************************** -! hfb_cq -- flowja will automatically include the effects of the hfb -! for confined and newton cases when xt3d is not used. This method -! recalculates flowja for the other cases. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO, DONE ! -- dummy @@ -402,8 +381,7 @@ subroutine hfb_cq(this, hnew, flowja) real(DP) :: fawidth, faheight real(DP) :: topn, topm, botn, botm real(DP) :: viscratio -! ------------------------------------------------------------------------------ -! + ! ! -- initialize viscratio viscratio = DONE ! @@ -482,24 +460,17 @@ subroutine hfb_cq(this, hnew, flowja) ! end if ! - ! -- return + ! -- Return return end subroutine hfb_cq + !> @brief Deallocate memory + !< subroutine hfb_da(this) -! ****************************************************************************** -! hfb_da -- Deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwfHfbType) :: this -! ------------------------------------------------------------------------------ - ! - ! -- Strings ! ! -- Scalars call mem_deallocate(this%maxhfb) @@ -535,22 +506,17 @@ subroutine hfb_da(this) this%hwva => null() this%vsc => null() ! - ! -- return + ! -- Return return end subroutine hfb_da + !> @brief Allocate package scalars + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- Allocate scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfHfbType) :: this -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -567,24 +533,19 @@ subroutine allocate_scalars(this) this%nhfb = 0 this%ivsc = 0 ! - ! -- return + ! -- Return return end subroutine allocate_scalars + !> @brief Allocate package arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfHfbType) :: this ! -- local integer(I4B) :: ihfb -! ------------------------------------------------------------------------------ ! call mem_allocate(this%noden, this%maxhfb, 'NODEN', this%memoryPath) call mem_allocate(this%nodem, this%maxhfb, 'NODEM', this%memoryPath) @@ -598,17 +559,13 @@ subroutine allocate_arrays(this) this%idxloc(ihfb) = 0 end do ! - ! -- return + ! -- Return return end subroutine allocate_arrays + !> @brief Read a hfb options block + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -- read a hfb options block -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, store_error_unit @@ -618,7 +575,6 @@ subroutine read_options(this) character(len=LINELENGTH) :: errmsg, keyword integer(I4B) :: ierr logical :: isfound, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, & @@ -646,17 +602,13 @@ subroutine read_options(this) write (this%iout, '(1x,a)') 'END OF HFB OPTIONS' end if ! - ! -- return + ! -- Return return end subroutine read_options + !> @brief Read the dimensions for this package + !< subroutine read_dimensions(this) -! ****************************************************************************** -! read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, store_error_unit ! -- dummy @@ -665,8 +617,6 @@ subroutine read_dimensions(this) character(len=LINELENGTH) :: errmsg, keyword integer(I4B) :: ierr logical :: isfound, endOfBlock - ! -- format -! ------------------------------------------------------------------------------ ! ! -- get dimensions block call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -705,20 +655,18 @@ subroutine read_dimensions(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine read_dimensions + !> @brief Read HFB period block + !! + !! Data are in form of: + !! L, IROW1, ICOL1, IROW2, ICOL2, HYDCHR + !! or for unstructured: + !! N1, N2, HYDCHR + !< subroutine read_data(this) -! ****************************************************************************** -! read_data -- Read hfb period block -! Data are in form of L, IROW1, ICOL1, IROW2, ICOL2, HYDCHR -! or for unstructured -! N1, N2, HYDCHR -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -731,7 +679,6 @@ subroutine read_data(this) logical :: endOfBlock ! -- formats character(len=*), parameter :: fmthfb = "(i10, 2a10, 1(1pg15.6))" -! ------------------------------------------------------------------------------ ! write (this%iout, '(//,1x,a)') 'READING HFB DATA' if (this%iprpak > 0) then @@ -786,18 +733,15 @@ subroutine read_data(this) call this%check_data() write (this%iout, '(1x,a)') 'END READING HFB DATA' ! - ! -- return + ! -- Return return end subroutine read_data + !> @brief Check for hfb's between two unconnected cells and write a warning + !! + !! Store ipos in idxloc + !< subroutine check_data(this) -! ****************************************************************************** -! check_data -- Check for hfb's between two unconnected cells and write a -! warning. Store ipos in idxloc. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -814,7 +758,6 @@ subroutine check_data(this) &' is between two unconnected cells: ', a, ' and ', a)" character(len=*), parameter :: fmtverr = "(1x, 'HFB no. ',i0, & &' is between two cells not horizontally connected: ', a, ' and ', a)" -! ------------------------------------------------------------------------------ ! do ihfb = 1, this%nhfb n = this%noden(ihfb) @@ -854,43 +797,35 @@ subroutine check_data(this) call store_error_unit(this%inunit) end if ! - ! -- return + ! -- Return return end subroutine check_data + !> @brief Reset condsat to its value prior to being modified by hfb's + !< subroutine condsat_reset(this) -! ****************************************************************************** -! condsat_reset -- Reset condsat to its value prior to being modified by hfb's -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfHfbType) :: this ! -- local integer(I4B) :: ihfb integer(I4B) :: ipos -! ------------------------------------------------------------------------------ ! do ihfb = 1, this%nhfb ipos = this%idxloc(ihfb) this%condsat(this%jas(ipos)) = this%csatsav(ihfb) end do ! - ! -- return + ! -- Return return end subroutine condsat_reset + !> @brief Modify condsat + !! + !! Modify condsat for the following conditions: + !! 1. If Newton is active + !! 2. If icelltype for n and icelltype for m is 0 + !< subroutine condsat_modify(this) -! ****************************************************************************** -! condsat_modify -- Modify condsat for the following conditions: -! 1. If Newton is active -! 2. If icelltype for n and icelltype for m is 0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO ! -- dummy @@ -901,7 +836,6 @@ subroutine condsat_modify(this) real(DP) :: cond, condhfb real(DP) :: fawidth, faheight real(DP) :: topn, topm, botn, botm -! ------------------------------------------------------------------------------ ! do ihfb = 1, this%nhfb ipos = this%idxloc(ihfb) @@ -935,7 +869,7 @@ subroutine condsat_modify(this) end if end do ! - ! -- return + ! -- Return return end subroutine condsat_modify diff --git a/src/Model/GroundWaterFlow/gwf3ic8.f90 b/src/Model/GroundWaterFlow/gwf3ic8.f90 index 033f565819b..8d51e717aa7 100644 --- a/src/Model/GroundWaterFlow/gwf3ic8.f90 +++ b/src/Model/GroundWaterFlow/gwf3ic8.f90 @@ -1,6 +1,7 @@ module GwfIcModule - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LINELENGTH use NumericalPackageModule, only: NumericalPackageType use BlockParserModule, only: BlockParserType use BaseDisModule, only: DisBaseType @@ -11,238 +12,155 @@ module GwfIcModule public :: ic_cr type, extends(NumericalPackageType) :: GwfIcType + real(DP), dimension(:), pointer, contiguous :: strt => null() ! starting head + contains + procedure :: ic_ar procedure :: ic_da + procedure, private :: ic_load procedure, private :: allocate_arrays - procedure, private :: read_options - procedure :: read_data + procedure, private :: source_griddata + end type GwfIcType contains - subroutine ic_cr(ic, name_model, inunit, iout, dis) -! ****************************************************************************** -! ic_cr -- Create a new initial conditions object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new initial conditions object + !< + subroutine ic_cr(ic, name_model, input_mempath, inunit, iout, dis) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value ! -- dummy type(GwfIcType), pointer :: ic character(len=*), intent(in) :: name_model + character(len=*), intent(in) :: input_mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout class(DisBaseType), pointer, intent(in) :: dis -! ------------------------------------------------------------------------------ + ! -- formats + character(len=*), parameter :: fmtic = & + "(1x, /1x, 'IC -- Initial Conditions Package, Version 8, 3/28/2015', & + &' input read from mempath: ', A, //)" ! - ! -- Create the object + ! -- create IC object allocate (ic) ! ! -- create name and memory path - call ic%set_names(1, name_model, 'IC', 'IC') + call ic%set_names(1, name_model, 'IC', 'IC', input_mempath) ! - ! -- Allocate scalars + ! -- allocate scalars call ic%allocate_scalars() ! + ! -- set variables ic%inunit = inunit ic%iout = iout ! ! -- set pointers ic%dis => dis ! - ! -- Initialize block parser - call ic%parser%Initialize(ic%inunit, ic%iout) - ! - ! -- Return - return + ! -- check if pkg is enabled, + if (inunit > 0) then + ! print message identifying pkg + write (ic%iout, fmtic) input_mempath + end if end subroutine ic_cr - subroutine ic_ar(this, x) -! ****************************************************************************** -! ic_ar -- Allocate and read initial conditions -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Load data from IDM into package + !< + subroutine ic_load(this) ! -- modules use BaseDisModule, only: DisBaseType - use SimModule, only: store_error + ! -- dummy + class(GwfIcType) :: this + ! + call this%source_griddata() + end subroutine ic_load + + !> @brief Allocate arrays, load from IDM, and assign head + !< + subroutine ic_ar(this, x) ! -- dummy class(GwfIcType) :: this real(DP), dimension(:), intent(inout) :: x - ! -- locals + ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ - ! - ! -- Print a message identifying the initial conditions package. - write (this%iout, 1) this%inunit -1 format(1x, /1x, 'IC -- INITIAL CONDITIONS PACKAGE, VERSION 8, 3/28/2015', & - ' INPUT READ FROM UNIT ', i0) ! - ! -- Allocate arrays + ! -- allocate arrays call this%allocate_arrays(this%dis%nodes) ! - ! -- Read options - call this%read_options() + ! -- load from IDM + call this%ic_load() ! - ! -- Read data - call this%read_data() - ! - ! -- Assign x equal to strt + ! -- assign starting head do n = 1, this%dis%nodes x(n) = this%strt(n) end do - ! - ! -- Return - return end subroutine ic_ar + !> @brief Deallocate + !< subroutine ic_da(this) -! ****************************************************************************** -! ic_da -- Deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate + use MemoryManagerExtModule, only: memorylist_remove + use SimVariablesModule, only: idm_context ! -- dummy class(GwfIcType) :: this -! ------------------------------------------------------------------------------ ! - ! -- deallocate parent - call this%NumericalPackageType%da() - ! - ! -- Scalars + ! -- deallocate IDM memory + call memorylist_remove(this%name_model, 'IC', idm_context) ! - ! -- Arrays + ! -- deallocate arrays call mem_deallocate(this%strt) ! - ! -- Return - return + ! -- deallocate parent + call this%NumericalPackageType%da() end subroutine ic_da + !> @brief Allocate arrays + !< subroutine allocate_arrays(this, nodes) -! ****************************************************************************** -! allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfIcType) :: this integer(I4B), intent(in) :: nodes - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Allocate call mem_allocate(this%strt, nodes, 'STRT', this%memoryPath) - ! - ! -- Return - return end subroutine allocate_arrays - subroutine read_options(this) -! ****************************************************************************** -! read_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Copy grid data from IDM into package + !< + subroutine source_griddata(this) ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error + use SimModule, only: store_error, store_error_filename + use MemoryManagerExtModule, only: mem_set_value + use GwfIcInputModule, only: GwfIcParamFoundType ! -- dummy class(GwfIcType) :: this ! -- local - character(len=LINELENGTH) :: errmsg, keyword - integer(I4B) :: ierr - logical :: isfound, endOfBlock - ! -- formats -! ------------------------------------------------------------------------------ - ! - ! -- get options block - call this%parser%GetBlock('OPTIONS', isfound, ierr, & - supportOpenClose=.true., blockRequired=.false.) - ! - ! -- parse options block if detected - if (isfound) then - write (this%iout, '(1x,a)') 'PROCESSING IC OPTIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case default - write (errmsg, '(a,a)') 'Unknown IC option: ', trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - write (this%iout, '(1x,a)') 'END OF IC OPTIONS' + character(len=LINELENGTH) :: errmsg + type(GwfIcParamFoundType) :: found + integer(I4B), dimension(:), pointer, contiguous :: map + ! + ! -- set map to convert user to reduced node data + map => null() + if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser + ! + ! -- set values + call mem_set_value(this%strt, 'STRT', this%input_mempath, map, found%strt) + ! + ! -- ensure STRT was found + if (.not. found%strt) then + write (errmsg, '(a)') 'Error in GRIDDATA block: STRT not found.' + call store_error(errmsg, terminate=.false.) + call store_error_filename(this%input_fname) + else if (this%iout > 0) then + write (this%iout, '(4x,a)') 'STRT set from input file' end if - ! - ! -- Return - return - end subroutine read_options - - subroutine read_data(this) -! ****************************************************************************** -! read_data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error - ! -- dummy - class(GwfIcType) :: this - ! -- local - character(len=LINELENGTH) :: errmsg, keyword - character(len=:), allocatable :: line - integer(I4B) :: istart, istop, lloc, ierr - logical :: isfound, endOfBlock - character(len=24) :: aname(1) - ! -- formats -! ------------------------------------------------------------------------------ - ! - ! -- Setup the label - aname(1) = ' INITIAL HEAD' - ! - ! -- get griddata block - call this%parser%GetBlock('GRIDDATA', isfound, ierr) - if (isfound) then - write (this%iout, '(1x,a)') 'PROCESSING GRIDDATA' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - call this%parser%GetRemainingLine(line) - lloc = 1 - select case (keyword) - case ('STRT') - call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, & - this%parser%iuactive, this%strt, & - aname(1)) - case default - write (errmsg, '(a,a)') 'Unknown GRIDDATA tag: ', trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - write (this%iout, '(1x,a)') 'END PROCESSING GRIDDATA' - else - call store_error('Required GRIDDATA block not found.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Return - return - end subroutine read_data + end subroutine source_griddata end module GwfIcModule diff --git a/src/Model/GroundWaterFlow/gwf3ic8idm.f90 b/src/Model/GroundWaterFlow/gwf3ic8idm.f90 new file mode 100644 index 00000000000..f943a35dc98 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3ic8idm.f90 @@ -0,0 +1,79 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfIcInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_ic_param_definitions + public gwf_ic_aggregate_definitions + public gwf_ic_block_definitions + public GwfIcParamFoundType + public gwf_ic_multi_package + + type GwfIcParamFoundType + logical :: strt = .false. + end type GwfIcParamFoundType + + logical :: gwf_ic_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + gwfic_strt = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'IC', & ! subcomponent + 'GRIDDATA', & ! block + 'STRT', & ! tag name + 'STRT', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_ic_param_definitions(*) = & + [ & + gwfic_strt & + ] + + type(InputParamDefinitionType), parameter :: & + gwf_ic_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_ic_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'GRIDDATA', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module GwfIcInputModule diff --git a/src/Model/GroundWaterFlow/gwf3idm.f90 b/src/Model/GroundWaterFlow/gwf3idm.f90 index 0aaf3b5ac74..8b8acf82eeb 100644 --- a/src/Model/GroundWaterFlow/gwf3idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -37,7 +38,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -53,7 +55,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -69,7 +72,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -85,7 +89,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -101,7 +106,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -117,7 +123,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -133,7 +140,8 @@ module GwfNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -149,7 +157,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -165,7 +174,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -181,7 +191,8 @@ module GwfNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -212,7 +223,8 @@ module GwfNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterFlow/gwf3lak8.f90 b/src/Model/GroundWaterFlow/gwf3lak8.f90 index 366ebc54e23..3834f640263 100644 --- a/src/Model/GroundWaterFlow/gwf3lak8.f90 +++ b/src/Model/GroundWaterFlow/gwf3lak8.f90 @@ -1,6 +1,6 @@ module LakModule ! - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENBOUNDNAME, LENTIMESERIESNAME, & IWETLAKE, MAXADPIT, & DZERO, DPREC, DEM30, DEM9, DEM6, DEM5, & @@ -23,13 +23,15 @@ module LakModule use TableModule, only: TableType, table_cr use ObserveModule, only: ObserveType use ObsModule, only: ObsType - use InputOutputModule, only: get_node, URWORD, extract_idnum_or_bndname + use GeomUtilModule, only: get_node + use InputOutputModule, only: URWORD, extract_idnum_or_bndname use BaseDisModule, only: DisBaseType - use SimModule, only: count_errors, store_error, store_error_unit - use GenericUtilitiesModule, only: sim_message, is_same + use SimModule, only: count_errors, store_error, store_error_unit, & + deprecation_warning + use MathUtilModule, only: is_close use BlockParserModule, only: BlockParserType use BaseDisModule, only: DisBaseType - use SimVariablesModule, only: errmsg + use SimVariablesModule, only: errmsg, warnmsg use MatrixBaseModule ! implicit none @@ -199,7 +201,9 @@ module LakModule real(DP), dimension(:, :), pointer, contiguous :: viscratios => null() !< viscosity ratios (1: lak vsc ratio; 2: gwf vsc ratio) ! ! -- type bound procedures + contains + procedure :: lak_allocate_scalars procedure :: lak_allocate_arrays procedure :: bnd_options => lak_options @@ -282,15 +286,10 @@ module LakModule contains + !> @brief Create a new LAK Package and point bndobj to the new package + !< subroutine lak_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! lak_create -- Create a New LAKE Package -! Subroutine: (1) create new-style package -! (2) point bndobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id integer(I4B), intent(in) :: ibcnum @@ -298,8 +297,8 @@ subroutine lak_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + ! -- local type(LakType), pointer :: lakobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (lakobj) @@ -314,7 +313,7 @@ subroutine lak_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id @@ -324,20 +323,15 @@ subroutine lak_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%isadvpak = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine lak_create + !> @brief Allocate scalar members + !< subroutine lak_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_scalars() @@ -392,23 +386,18 @@ subroutine lak_allocate_scalars(this) this%idense = 0 this%ivsc = 0 ! - ! -- return + ! -- Return return end subroutine lak_allocate_scalars + !> @brief Allocate scalar members + !< subroutine lak_allocate_arrays(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(LakType), intent(inout) :: this ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_arrays() @@ -464,17 +453,13 @@ subroutine lak_allocate_arrays(this) ! -- allocate viscratios to size 0 call mem_allocate(this%viscratios, 2, 0, 'VISCRATIOS', this%memoryPath) ! - ! -- return + ! -- Return return end subroutine lak_allocate_arrays + !> @brief Read the dimensions for this package + !< subroutine lak_read_lakes(this) -! ****************************************************************************** -! pak1read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -487,7 +472,7 @@ subroutine lak_read_lakes(this) character(len=9) :: cno character(len=50), dimension(:), allocatable :: caux integer(I4B) :: ierr, ival - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock integer(I4B) :: n integer(I4B) :: ii, jj integer(I4B) :: iaux @@ -496,9 +481,6 @@ subroutine lak_read_lakes(this) integer(I4B) :: nconn integer(I4B), dimension(:), pointer, contiguous :: nboundchk real(DP), pointer :: bndElem => null() - ! -- format - ! - ! -- code ! ! -- initialize itmp itmp = 0 @@ -607,39 +589,39 @@ subroutine lak_read_lakes(this) call this%parser%GetNextLine(endOfBlock) if (endOfBlock) exit n = this%parser%GetInteger() - + ! if (n < 1 .or. n > this%nlakes) then write (errmsg, '(a,1x,i0)') 'lakeno MUST BE > 0 and <= ', this%nlakes call store_error(errmsg) cycle end if - + ! ! -- increment nboundchk nboundchk(n) = nboundchk(n) + 1 - + ! ! -- strt this%strt(n) = this%parser%GetDouble() - + ! ! nlakeconn ival = this%parser%GetInteger() - + ! if (ival < 0) then write (errmsg, '(a,1x,i0)') 'nlakeconn MUST BE >= 0 for lake ', n call store_error(errmsg) end if - + ! nconn = nconn + ival this%nlakeconn(n) = ival - + ! ! -- get aux data do iaux = 1, this%naux call this%parser%GetString(caux(iaux)) end do - + ! ! -- set default bndName write (cno, '(i9.9)') n bndName = 'Lake'//cno - + ! ! -- lakename if (this%inamedbound /= 0) then call this%parser%GetStringCaps(bndNameTemp) @@ -648,7 +630,7 @@ subroutine lak_read_lakes(this) end if end if this%lakename(n) = bndName - + ! ! -- fill time series aware data ! -- fill aux data do jj = 1, this%naux @@ -660,7 +642,7 @@ subroutine lak_read_lakes(this) this%tsManager, this%iprpak, & this%auxname(jj)) end do - + ! nlak = nlak + 1 end do ! @@ -675,7 +657,7 @@ subroutine lak_read_lakes(this) call store_error(errmsg) end if end do - + ! write (this%iout, '(1x,a)') 'END OF '//trim(adjustl(this%text))// & ' PACKAGEDATA' else @@ -690,7 +672,7 @@ subroutine lak_read_lakes(this) ! -- set MAXBOUND this%MAXBOUND = nconn write (this%iout, '(//4x,a,i7)') 'MAXBOUND = ', this%maxbound - + ! ! -- set idxlakeconn this%idxlakeconn(1) = 1 do n = 1, this%nlakes @@ -705,17 +687,13 @@ subroutine lak_read_lakes(this) ! -- deallocate local storage for nboundchk deallocate (nboundchk) ! - ! -- return + ! -- Return return end subroutine lak_read_lakes + !> @brief Read the lake connections for this package + !< subroutine lak_read_lake_connections(this) -! ****************************************************************************** -! lak_read_lake_connections -- Read the lake connections for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH, LENVARNAME use SimModule, only: store_error, count_errors ! -- dummy @@ -723,19 +701,17 @@ subroutine lak_read_lake_connections(this) ! -- local character(len=LINELENGTH) :: keyword, cellid integer(I4B) :: ierr, ival - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock + logical(LGP) :: is_lake_bed real(DP) :: rval integer(I4B) :: j, n integer(I4B) :: nn integer(I4B) :: ipos, ipos0 integer(I4B) :: icellid, icellid0 - real(DP) :: top, bot + real(DP) :: top + real(DP) :: bot integer(I4B), dimension(:), pointer, contiguous :: nboundchk character(len=LENVARNAME) :: ctypenm - - ! -- format - ! - ! -- code ! ! -- allocate local storage allocate (nboundchk(this%MAXBOUND)) @@ -749,7 +725,6 @@ subroutine lak_read_lake_connections(this) ! ! -- parse connectiondata block if detected if (isfound) then - ! -- allocate connection data using memory manager call mem_allocate(this%imap, this%MAXBOUND, 'IMAP', this%memoryPath) call mem_allocate(this%cellid, this%MAXBOUND, 'CELLID', this%memoryPath) @@ -768,7 +743,7 @@ subroutine lak_read_lake_connections(this) call mem_allocate(this%satcond, this%MAXBOUND, 'SATCOND', this%memoryPath) call mem_allocate(this%simcond, this%MAXBOUND, 'SIMCOND', this%memoryPath) call mem_allocate(this%simlakgw, this%MAXBOUND, 'SIMLAKGW', this%memoryPath) - + ! ! -- process the lake connection data write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & ' LAKE_CONNECTIONS' @@ -776,13 +751,13 @@ subroutine lak_read_lake_connections(this) call this%parser%GetNextLine(endOfBlock) if (endOfBlock) exit n = this%parser%GetInteger() - + ! if (n < 1 .or. n > this%nlakes) then write (errmsg, '(a,1x,i0)') 'lakeno MUST BE > 0 and <= ', this%nlakes call store_error(errmsg) cycle end if - + ! ! -- read connection number ival = this%parser%GetInteger() if (ival < 1 .or. ival > this%nlakeconn(n)) then @@ -791,17 +766,17 @@ subroutine lak_read_lake_connections(this) call store_error(errmsg) cycle end if - + ! j = ival ipos = this%idxlakeconn(n) + ival - 1 - + ! ! -- set imap this%imap(ipos) = n - + ! ! ! -- increment nboundchk nboundchk(ipos) = nboundchk(ipos) + 1 - + ! ! -- read gwfnodes from the line call this%parser%GetCellid(this%dis%ndim, cellid) nn = this%dis%noder_from_cellid(cellid, & @@ -813,11 +788,11 @@ subroutine lak_read_lake_connections(this) 'INVALID cellid FOR LAKE ', n, 'connection', j call store_error(errmsg) end if - + ! ! -- set gwf cellid for connection this%cellid(ipos) = nn this%nodesontop(ipos) = nn - + ! ! -- read ictype call this%parser%GetStringCaps(keyword) select case (keyword) @@ -836,28 +811,47 @@ subroutine lak_read_lake_connections(this) call store_error(errmsg) end select write (ctypenm, '(a16)') keyword - + ! ! -- bed leakance - !this%bedleak(ipos) = this%parser%GetDouble() + !this%bedleak(ipos) = this%parser%GetDouble() !TODO: use this when NONE keyword deprecated call this%parser%GetStringCaps(keyword) select case (keyword) case ('NONE') - this%bedleak(ipos) = -DONE + is_lake_bed = .FALSE. + this%bedleak(ipos) = DNODATA + ! + ! -- create warning message + write (warnmsg, '(2(a,1x,i0,1x),a,1pe7.1,a)') & + 'BEDLEAK for connection', j, 'in lake', n, 'is specified to '// & + 'be NONE. Lake connections where the lake-GWF connection '// & + 'conductance is solely a function of aquifer properties '// & + 'in the connected GWF cell should be specified with a '// & + 'DNODATA (', DNODATA, ') value.' + ! + ! -- create deprecation warning + call deprecation_warning('CONNECTIONDATA', 'bedleak=NONE', '6.5.0', & + warnmsg, this%parser%GetUnit()) case default - read (keyword, *) this%bedleak(ipos) + read (keyword, *) rval + if (is_close(rval, DNODATA)) then + is_lake_bed = .FALSE. + else + is_lake_bed = .TRUE. + end if + this%bedleak(ipos) = rval end select - - if (keyword /= 'NONE' .and. this%bedleak(ipos) < dzero) then + ! + if (is_lake_bed .and. this%bedleak(ipos) < DZERO) then write (errmsg, '(a,1x,i0,1x,a)') 'bedleak FOR LAKE ', n, 'MUST BE >= 0' call store_error(errmsg) end if - + ! ! -- belev this%belev(ipos) = this%parser%GetDouble() - + ! ! -- telev this%telev(ipos) = this%parser%GetDouble() - + ! ! -- connection length rval = this%parser%GetDouble() if (rval <= DZERO) then @@ -873,7 +867,7 @@ subroutine lak_read_lake_connections(this) end if end if this%connlength(ipos) = rval - + ! ! -- connection width rval = this%parser%GetDouble() if (rval < dzero) then @@ -1009,17 +1003,13 @@ subroutine lak_read_lake_connections(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine lak_read_lake_connections + !> @brief Read the lake tables for this package + !< subroutine lak_read_tables(this) -! ****************************************************************************** -! lak_read_tables -- Read the lake tables for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors ! -- dummy @@ -1029,16 +1019,11 @@ subroutine lak_read_tables(this) character(len=LINELENGTH) :: line character(len=LINELENGTH) :: keyword integer(I4B) :: ierr - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock integer(I4B) :: n integer(I4B) :: iconn integer(I4B) :: ntabs integer(I4B), dimension(:), pointer, contiguous :: nboundchk -! ------------------------------------------------------------------------------ - - ! -- format - ! - ! -- code ! ! -- skip of no outlets if (this%ntables < 1) return @@ -1066,17 +1051,17 @@ subroutine lak_read_tables(this) call this%parser%GetNextLine(endOfBlock) if (endOfBlock) exit n = this%parser%GetInteger() - + ! if (n < 1 .or. n > this%nlakes) then write (errmsg, '(a,1x,i0)') 'lakeno MUST BE > 0 and <= ', this%nlakes call store_error(errmsg) cycle readtable end if - + ! ! -- increment ntab and nboundchk ntabs = ntabs + 1 nboundchk(n) = nboundchk(n) + 1 - + ! ! -- read FILE keyword call this%parser%GetStringCaps(keyword) select case (keyword) @@ -1097,7 +1082,7 @@ subroutine lak_read_tables(this) cycle readtable end select end do readtable - + ! write (this%iout, '(1x,a)') & 'END OF '//trim(adjustl(this%text))//' LAKE_TABLES' ! @@ -1144,18 +1129,14 @@ subroutine lak_read_tables(this) end do deallocate (laketables) ! - ! -- return + ! -- Return return end subroutine lak_read_tables + !> @brief Copy the laketables structure data into flattened vectors that are + !! stored in the memory manager + !< subroutine laktables_to_vectors(this, laketables) -! ****************************************************************************** -! laktables_to_vectors -- Copy the laketables structure data into flattened -! vectors that are stored in the memory manager -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(LakType), intent(inout) :: this type(LakTabType), intent(in), dimension(:), contiguous :: laketables integer(I4B) :: n @@ -1163,7 +1144,6 @@ subroutine laktables_to_vectors(this, laketables) integer(I4B) :: j integer(I4B) :: ipos integer(I4B) :: iconn -! ------------------------------------------------------------------------------ ! ! -- allocate index array for lak tables call mem_allocate(this%ialaktab, this%nlakes + 1, 'IALAKTAB', this%memoryPath) @@ -1201,17 +1181,13 @@ subroutine laktables_to_vectors(this, laketables) end do end do ! - ! -- return + ! -- Return return end subroutine laktables_to_vectors + !> @brief Read the lake table for this package + !< subroutine lak_read_table(this, ilak, filename, laketable) -! ****************************************************************************** -! lak_read_table -- Read the lake table for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use InputOutputModule, only: openfile use SimModule, only: store_error, count_errors @@ -1223,7 +1199,7 @@ subroutine lak_read_table(this, ilak, filename, laketable) ! -- local character(len=LINELENGTH) :: keyword integer(I4B) :: ierr - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock integer(I4B) :: iu integer(I4B) :: n integer(I4B) :: ipos @@ -1239,11 +1215,6 @@ subroutine lak_read_table(this, ilak, filename, laketable) ! -- formats character(len=*), parameter :: fmttaberr = & &'(a,1x,i0,1x,a,1x,g15.6,1x,a,1x,i0,1x,a,1x,i0,1x,a,1x,g15.6,1x,a)' -! ------------------------------------------------------------------------------ - - ! -- format - ! - ! -- code ! ! -- initialize locals n = 0 @@ -1288,7 +1259,7 @@ subroutine lak_read_table(this, ilak, filename, laketable) write (errmsg, '(a,1x,i0)') 'LAKE TABLE NCOL MUST BE >= ', jmin call store_error(errmsg) end if - + ! case default write (errmsg, '(a,a)') & 'UNKNOWN '//trim(this%text)//' DIMENSIONS KEYWORD: ', trim(keyword) @@ -1328,13 +1299,13 @@ subroutine lak_read_table(this, ilak, filename, laketable) if (this%ictype(ipos) == 2 .or. this%ictype(ipos) == 3) then allocate (laketable%tabwarea(n)) end if - + ! ! -- get table block call parser%GetBlock('TABLE', isfound, ierr, supportOpenClose=.true.) ! ! -- parse well_connections block if detected if (isfound) then - + ! ! -- process the table data if (this%iprpak /= 0) then write (this%iout, '(/1x,a)') & @@ -1356,7 +1327,7 @@ subroutine lak_read_table(this, ilak, filename, laketable) laketable%tabwarea(ipos) = parser%GetDouble() end if end do readtabledata - + ! if (this%iprpak /= 0) then write (this%iout, '(1x,a)') & 'END OF '//trim(adjustl(this%text))//' TABLE' @@ -1446,17 +1417,13 @@ subroutine lak_read_table(this, ilak, filename, laketable) ! Close the table file and clear other parser members call parser%Clear() ! - ! -- return + ! -- Return return end subroutine lak_read_table + !> @brief Read the lake outlets for this package + !< subroutine lak_read_outlets(this) -! ****************************************************************************** -! lak_read_outlets -- Read the lake outlets for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors use TimeSeriesManagerModule, only: read_value_or_time_series_adv @@ -1467,16 +1434,11 @@ subroutine lak_read_outlets(this) character(len=LENBOUNDNAME) :: bndName character(len=9) :: citem integer(I4B) :: ierr, ival - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock integer(I4B) :: n integer(I4B) :: jj integer(I4B), dimension(:), pointer, contiguous :: nboundchk real(DP), pointer :: bndElem => null() - ! - ! -- format - ! - ! -- code -! ------------------------------------------------------------------------------ ! ! -- get well_connections block call this%parser%GetBlock('OUTLETS', isfound, ierr, & @@ -1513,7 +1475,7 @@ subroutine lak_read_outlets(this) do n = 1, this%noutlets this%outrate(n) = DZERO end do - + ! ! -- process the lake connection data write (this%iout, '(/1x,a)') & 'PROCESSING '//trim(adjustl(this%text))//' OUTLETS' @@ -1541,7 +1503,7 @@ subroutine lak_read_outlets(this) cycle readoutlet end if this%lakein(n) = ival - + ! ! -- read outlet lakeout ival = this%parser%GetInteger() if (ival < 0 .or. ival > this%nlakes) then @@ -1551,7 +1513,7 @@ subroutine lak_read_outlets(this) cycle readoutlet end if this%lakeout(n) = ival - + ! ! -- read ictype call this%parser%GetStringCaps(keyword) select case (keyword) @@ -1567,11 +1529,11 @@ subroutine lak_read_outlets(this) call store_error(errmsg) cycle readoutlet end select - + ! ! -- build bndname for outlet write (citem, '(i9.9)') n bndName = 'OUTLET'//citem - + ! ! -- set a few variables for timeseries aware variables jj = 1 ! @@ -1627,7 +1589,7 @@ subroutine lak_read_outlets(this) 'SPECIFIED OR IS SPECIFIED TO BE 0.' call store_error(errmsg) end if - + ! else if (this%noutlets > 0) then call store_error('REQUIRED OUTLETS BLOCK NOT FOUND.') @@ -1640,17 +1602,13 @@ subroutine lak_read_outlets(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine lak_read_outlets + !> @brief Read the dimensions for this package + !< subroutine lak_read_dimensions(this) -! ****************************************************************************** -! pak1read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors ! -- dummy @@ -1658,9 +1616,7 @@ subroutine lak_read_dimensions(this) ! -- local character(len=LINELENGTH) :: keyword integer(I4B) :: ierr - logical :: isfound, endOfBlock - ! -- format -! ------------------------------------------------------------------------------ + logical(LGP) :: isfound, endOfBlock ! ! -- initialize dimensions to -1 this%nlakes = -1 @@ -1699,7 +1655,7 @@ subroutine lak_read_dimensions(this) else call store_error('REQUIRED DIMENSIONS BLOCK NOT FOUND.') end if - + ! if (this%nlakes < 0) then write (errmsg, '(a)') & 'NLAKES WAS NOT SPECIFIED OR WAS SPECIFIED INCORRECTLY.' @@ -1733,17 +1689,13 @@ subroutine lak_read_dimensions(this) ! -- setup the stage table object call this%lak_setup_tableobj() ! - ! -- return + ! -- Return return end subroutine lak_read_dimensions + !> @brief Read the initial parameters for this package + !< subroutine lak_read_initial_attr(this) -! ****************************************************************************** -! pak1read_dimensions -- Read the initial parameters for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use MemoryHelperModule, only: create_mem_path use SimModule, only: store_error, count_errors @@ -1780,8 +1732,6 @@ subroutine lak_read_initial_attr(this) data ctype(1)/'HORIZONTAL'/ data ctype(2)/'EMBEDDEDH '/ data ctype(3)/'EMBEDDEDV '/ - ! -- format -! ------------------------------------------------------------------------------ ! ! -- initialize xnewpak and set stage do n = 1, this%nlakes @@ -1827,7 +1777,7 @@ subroutine lak_read_initial_attr(this) ! -- allocate temporary storage allocate (clb(this%MAXBOUND)) allocate (caq(this%MAXBOUND)) - + ! ! -- calculate saturated conductance for each connection do n = 1, this%nlakes do j = this%idxlakeconn(n), this%idxlakeconn(n + 1) - 1 @@ -1882,10 +1832,10 @@ subroutine lak_read_initial_attr(this) end if length = this%connlength(j) end if - if (this%bedleak(j) < DZERO) then - clb(j) = -DONE + if (is_close(this%bedleak(j), DNODATA)) then + clb(j) = DNODATA else if (this%bedleak(j) > DZERO) then - clb(j) = done / this%bedleak(j) + clb(j) = DONE / this%bedleak(j) else clb(j) = DZERO end if @@ -1894,7 +1844,7 @@ subroutine lak_read_initial_attr(this) else caq(j) = DZERO end if - if (this%bedleak(j) < DZERO) then + if (is_close(this%bedleak(j), DNODATA)) then this%satcond(j) = area / caq(j) else if (clb(j) * caq(j) > DZERO) then this%satcond(j) = area / (clb(j) + caq(j)) @@ -1929,7 +1879,7 @@ subroutine lak_read_initial_attr(this) nn = this%cellid(j) area = this%warea(j) c1 = DZERO - if (clb(j) < DZERO) then + if (is_close(clb(j), DNODATA)) then cbedleak = ' NONE ' cbedcond = ' NONE ' else if (clb(j) > DZERO) then @@ -1961,7 +1911,7 @@ subroutine lak_read_initial_attr(this) write (this%iout, '(1x,a)') & 'IF EMBEDDED CONNECTION, CONDUCTANCES ARE PER & &UNIT EXCHANGE AREA (1/T).' - + ! ! write(this%iout,*) n, idx, nodestr, this%sarea(j), this%warea(j) ! ! -- calculate stage, surface area, wetted area, volume relation @@ -1982,7 +1932,7 @@ subroutine lak_read_initial_attr(this) s = s + dx end do write (this%iout, "(1x,70('-'))") - + ! write (this%iout, '(//1x,a,1x,i10)') 'STAGE/VOLUME RELATION FOR LAKE ', n write (this%iout, '(/1x,4(a14))') ' ', ' ', & & ' CALCULATED', ' STAGE' @@ -2010,12 +1960,14 @@ subroutine lak_read_initial_attr(this) deallocate (clb) deallocate (caq) ! - ! -- return + ! -- Return return end subroutine lak_read_initial_attr -! -- simple subroutine for linear interpolation of two vectors -! function assumes x data is sorted in ascending order + !> @brief Perform linear interpolation of two vectors. + !! + !! Function assumes x data is sorted in ascending order + !< subroutine lak_linear_interpolation(this, n, x, y, z, v) ! -- dummy class(LakType), intent(inout) :: this @@ -2057,17 +2009,14 @@ subroutine lak_linear_interpolation(this, n, x, y, z, v) end if end do end if - ! return + ! + ! -- Return return end subroutine lak_linear_interpolation + !> @brief Calculate the surface area of a lake at a given stage + !< subroutine lak_calculate_sarea(this, ilak, stage, sarea) -! ****************************************************************************** -! lak_calculate_sarea -- Calculate the surface area of a lake at a given stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2081,8 +2030,7 @@ subroutine lak_calculate_sarea(this, ilak, stage, sarea) real(DP) :: botl real(DP) :: sat real(DP) :: sa - ! -- formats -! ------------------------------------------------------------------------------ + ! sarea = DZERO i = this%ntabrow(ilak) if (i > 0) then @@ -2107,17 +2055,13 @@ subroutine lak_calculate_sarea(this, ilak, stage, sarea) end do end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_sarea + !> @brief Calculate the wetted area of a lake at a given stage. + !< subroutine lak_calculate_warea(this, ilak, stage, warea, hin) -! ****************************************************************************** -! lak_calculate_warea -- Calculate the wetted area of a lake at a given stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2129,8 +2073,7 @@ subroutine lak_calculate_warea(this, ilak, stage, warea, hin) integer(I4B) :: igwfnode real(DP) :: head real(DP) :: wa - ! -- formats -! ------------------------------------------------------------------------------ + ! warea = DZERO do i = this%idxlakeconn(ilak), this%idxlakeconn(ilak + 1) - 1 if (present(hin)) then @@ -2143,18 +2086,13 @@ subroutine lak_calculate_warea(this, ilak, stage, warea, hin) warea = warea + wa end do ! - ! -- return + ! -- Return return end subroutine lak_calculate_warea + !> @brief Calculate the wetted area of a lake connection at a given stage + !< subroutine lak_calculate_conn_warea(this, ilak, iconn, stage, head, wa) -! ****************************************************************************** -! lak_calculate_conn_warea -- Calculate the wetted area of a lake connection -! at a given stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2171,8 +2109,7 @@ subroutine lak_calculate_conn_warea(this, ilak, iconn, stage, head, wa) real(DP) :: botl real(DP) :: vv real(DP) :: sat - ! -- formats -! ------------------------------------------------------------------------------ + ! wa = DZERO topl = this%telev(iconn) botl = this%belev(iconn) @@ -2203,17 +2140,13 @@ subroutine lak_calculate_conn_warea(this, ilak, iconn, stage, head, wa) wa = sat * this%warea(iconn) end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_conn_warea + !> @brief Calculate the volume of a lake at a given stage + !< subroutine lak_calculate_vol(this, ilak, stage, volume) -! ****************************************************************************** -! lak_calculate_vol -- Calculate the volume of a lake at a given stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2229,8 +2162,7 @@ subroutine lak_calculate_vol(this, ilak, stage, volume) real(DP) :: sa real(DP) :: v real(DP) :: sat - ! -- formats -! ------------------------------------------------------------------------------ + ! volume = DZERO i = this%ntabrow(ilak) if (i > 0) then @@ -2264,18 +2196,13 @@ subroutine lak_calculate_vol(this, ilak, stage, volume) end do end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_vol + !> @brief Calculate the total conductance for a lake at a provided stage + !< subroutine lak_calculate_conductance(this, ilak, stage, conductance) -! ****************************************************************************** -! lak_calculate_conductance -- Calculate the total conductance for a lake at a -! provided stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2284,28 +2211,22 @@ subroutine lak_calculate_conductance(this, ilak, stage, conductance) ! -- local integer(I4B) :: i real(DP) :: c - ! -- formats -! ------------------------------------------------------------------------------ + ! conductance = DZERO do i = this%idxlakeconn(ilak), this%idxlakeconn(ilak + 1) - 1 call this%lak_calculate_conn_conductance(ilak, i, stage, stage, c) conductance = conductance + c end do ! - ! -- return + ! -- Return return end subroutine lak_calculate_conductance + !> @brief Calculate the controlling lake stage or groundwater head used to + !! calculate the conductance for a lake connection from a provided stage and + !! groundwater head + !< subroutine lak_calculate_cond_head(this, iconn, stage, head, vv) -! ****************************************************************************** -! lak_calculate_conn_head -- Calculate the controlling lake stage or groundwater -! head used to calculate the conductance for a lake -! connection from a provided stage and groundwater -! head. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: iconn @@ -2317,8 +2238,7 @@ subroutine lak_calculate_cond_head(this, iconn, stage, head, vv) real(DP) :: hh real(DP) :: topl real(DP) :: botl - ! -- formats -! ------------------------------------------------------------------------------ + ! topl = this%telev(iconn) botl = this%belev(iconn) ss = min(stage, topl) @@ -2331,19 +2251,14 @@ subroutine lak_calculate_cond_head(this, iconn, stage, head, vv) vv = DHALF * (ss + hh) end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_cond_head + !> @brief Calculate the conductance for a lake connection at a provided stage + !! and groundwater head + !< subroutine lak_calculate_conn_conductance(this, ilak, iconn, stage, head, cond) -! ****************************************************************************** -! lak_calculate_conn_conductance -- Calculate the conductance for a lake -! connection at a provided stage -! and groundwater head. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2361,8 +2276,7 @@ subroutine lak_calculate_conn_conductance(this, ilak, iconn, stage, head, cond) real(DP) :: sat real(DP) :: wa real(DP) :: vscratio - ! -- formats -! ------------------------------------------------------------------------------ + ! cond = DZERO vscratio = DONE topl = this%telev(iconn) @@ -2407,18 +2321,13 @@ subroutine lak_calculate_conn_conductance(this, ilak, iconn, stage, head, cond) end if cond = sat * this%satcond(iconn) * vscratio ! - ! -- return + ! -- Return return end subroutine lak_calculate_conn_conductance + !> @brief Calculate the total groundwater-lake flow at a provided stage + !< subroutine lak_calculate_exchange(this, ilak, stage, totflow) -! ****************************************************************************** -! lak_calculate_exchange -- Calculate the total groundwater-lake flow at a -! provided stage. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2429,8 +2338,7 @@ subroutine lak_calculate_exchange(this, ilak, stage, totflow) integer(I4B) :: igwfnode real(DP) :: flow real(DP) :: hgwf - ! -- formats -! ------------------------------------------------------------------------------ + ! totflow = DZERO do j = this%idxlakeconn(ilak), this%idxlakeconn(ilak + 1) - 1 igwfnode = this%cellid(j) @@ -2439,19 +2347,15 @@ subroutine lak_calculate_exchange(this, ilak, stage, totflow) totflow = totflow + flow end do ! - ! -- return + ! -- Return return end subroutine lak_calculate_exchange + !> @brief Calculate the groundwater-lake flow at a provided stage and + !! groundwater head + !< subroutine lak_calculate_conn_exchange(this, ilak, iconn, stage, head, flow, & gwfhcof, gwfrhs) -! ****************************************************************************** -! lak_calculate_conn_exchange -- Calculate the groundwater-lake flow at a -! provided stage and groundwater head. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2468,8 +2372,7 @@ subroutine lak_calculate_conn_exchange(this, ilak, iconn, stage, head, flow, & real(DP) :: hh real(DP) :: gwfhcof0 real(DP) :: gwfrhs0 - ! -- formats -! ------------------------------------------------------------------------------ + ! flow = DZERO call this%lak_calculate_conn_conductance(ilak, iconn, stage, head, cond) botl = this%belev(iconn) @@ -2510,19 +2413,15 @@ subroutine lak_calculate_conn_exchange(this, ilak, iconn, stage, head, flow, & if (present(gwfhcof)) gwfhcof = gwfhcof0 if (present(gwfrhs)) gwfrhs = gwfrhs0 ! - ! -- return + ! -- Return return end subroutine lak_calculate_conn_exchange + !> @brief Calculate the groundwater-lake flow at a provided stage and + !! groundwater head + !< subroutine lak_estimate_conn_exchange(this, iflag, ilak, iconn, idry, stage, & head, flow, source, gwfhcof, gwfrhs) -! ****************************************************************************** -! lak_estimate_conn_exchange -- Calculate the groundwater-lake flow at a -! provided stage and groundwater head. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: iflag @@ -2537,8 +2436,7 @@ subroutine lak_estimate_conn_exchange(this, iflag, ilak, iconn, idry, stage, & real(DP), intent(inout), optional :: gwfrhs ! -- local real(DP) :: gwfhcof0, gwfrhs0 - ! -- formats -! ------------------------------------------------------------------------------ + ! flow = DZERO idry = 0 call this%lak_calculate_conn_exchange(ilak, iconn, stage, head, flow, & @@ -2561,18 +2459,14 @@ subroutine lak_estimate_conn_exchange(this, iflag, ilak, iconn, idry, stage, & if (present(gwfhcof)) gwfhcof = gwfhcof0 if (present(gwfrhs)) gwfrhs = gwfrhs0 ! - ! -- return + ! -- Return return end subroutine lak_estimate_conn_exchange + !> @brief Calculate the storage change in a lake based on provided stages + !! and a passed delt + !< subroutine lak_calculate_storagechange(this, ilak, stage, stage0, delt, dvr) -! ****************************************************************************** -! lak_calculate_storagechange -- Calculate the storage change in a lake based on -! provided stages and a passed delt. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2583,8 +2477,7 @@ subroutine lak_calculate_storagechange(this, ilak, stage, stage0, delt, dvr) ! -- local real(DP) :: v real(DP) :: v0 - ! -- formats -! ------------------------------------------------------------------------------ + ! dvr = DZERO if (this%gwfiss /= 1) then call this%lak_calculate_vol(ilak, stage, v) @@ -2592,17 +2485,13 @@ subroutine lak_calculate_storagechange(this, ilak, stage, stage0, delt, dvr) dvr = (v0 - v) / delt end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_storagechange + !> @brief Calculate the rainfall for a lake + !< subroutine lak_calculate_rainfall(this, ilak, stage, ra) -! ****************************************************************************** -! lak_calculate_rainfall -- Calculate the rainfall for a lake . -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2611,8 +2500,7 @@ subroutine lak_calculate_rainfall(this, ilak, stage, ra) ! -- local integer(I4B) :: iconn real(DP) :: sa - ! -- formats -! ------------------------------------------------------------------------------ + ! ! -- rainfall iconn = this%idxlakeconn(ilak) if (this%ictype(iconn) == 2 .or. this%ictype(iconn) == 3) then @@ -2622,64 +2510,47 @@ subroutine lak_calculate_rainfall(this, ilak, stage, ra) end if ra = this%rainfall(ilak) * sa ! - ! -- return + ! -- Return return end subroutine lak_calculate_rainfall + !> @brief Calculate runoff to a lake + !< subroutine lak_calculate_runoff(this, ilak, ro) -! ****************************************************************************** -! lak_calculate_runoff -- Calculate runoff to a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: ro - ! -- formats -! ------------------------------------------------------------------------------ + ! ! -- runoff ro = this%runoff(ilak) ! - ! -- return + ! -- Return return end subroutine lak_calculate_runoff + !> @brief Calculate specified inflow to a lake + !< subroutine lak_calculate_inflow(this, ilak, qin) -! ****************************************************************************** -! lak_calculate_inflow -- Calculate specified inflow to a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: qin - ! -- formats -! ------------------------------------------------------------------------------ + ! ! -- inflow to lake qin = this%inflow(ilak) ! - ! -- return + ! -- Return return end subroutine lak_calculate_inflow + !> @brief Calculate the external flow terms to a lake + !< subroutine lak_calculate_external(this, ilak, ex) -! ****************************************************************************** -! lak_calculate_external -- Calculate the external flow terms to a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: ex - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- If mover is active, add receiver water to rhs and ! store available water (as positive value) @@ -2688,26 +2559,19 @@ subroutine lak_calculate_external(this, ilak, ex) ex = this%pakmvrobj%get_qfrommvr(ilak) end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_external + !> @brief Calculate the withdrawal from a lake subject to an available volume + !< subroutine lak_calculate_withdrawal(this, ilak, avail, wr) -! ****************************************************************************** -! lak_calculate_withdrawal -- Calculate the withdrawal from a lake subject to -! an available volume. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: avail real(DP), intent(inout) :: wr - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ + ! ! -- withdrawals - limit to sum of inflows and available volume wr = this%withdrawal(ilak) if (wr > avail) then @@ -2719,18 +2583,14 @@ subroutine lak_calculate_withdrawal(this, ilak, avail, wr) end if avail = avail + wr ! - ! -- return + ! -- Return return end subroutine lak_calculate_withdrawal + !> @brief Calculate the evaporation from a lake at a provided stage subject + !! to an available volume + !< subroutine lak_calculate_evaporation(this, ilak, stage, avail, ev) -! ****************************************************************************** -! lak_calculate_evaporation -- Calculate the evaporation from a lake at a -! provided stage subject to an available volume. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2739,13 +2599,12 @@ subroutine lak_calculate_evaporation(this, ilak, stage, avail, ev) real(DP), intent(inout) :: ev ! -- local real(DP) :: sa - ! -- formats -! ------------------------------------------------------------------------------ + ! ! -- evaporation - limit to sum of inflows and available volume call this%lak_calculate_sarea(ilak, stage, sa) ev = sa * this%evaporation(ilak) if (ev > avail) then - if (is_same(avail, DPREC)) then + if (is_close(avail, DPREC)) then ev = DZERO else ev = -avail @@ -2755,25 +2614,19 @@ subroutine lak_calculate_evaporation(this, ilak, stage, avail, ev) end if avail = avail + ev ! - ! -- return + ! -- Return return end subroutine lak_calculate_evaporation + !> @brief Calculate the outlet inflow to a lake + !< subroutine lak_calculate_outlet_inflow(this, ilak, outinf) -! ****************************************************************************** -! lak_calculate_outlet_inflow -- Calculate the outlet inflow to a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outinf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ ! outinf = DZERO do n = 1, this%noutlets @@ -2785,17 +2638,13 @@ subroutine lak_calculate_outlet_inflow(this, ilak, outinf) end if end do ! - ! -- return + ! -- Return return end subroutine lak_calculate_outlet_inflow + !> @brief Calculate the outlet outflow from a lake + !< subroutine lak_calculate_outlet_outflow(this, ilak, stage, avail, outoutf) -! ****************************************************************************** -! lak_calculate_outlet_outflow -- Calculate the outlet outflow from a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -2809,8 +2658,6 @@ subroutine lak_calculate_outlet_outflow(this, ilak, stage, avail, outoutf) real(DP) :: c real(DP) :: gsm real(DP) :: rate - ! -- formats -! ------------------------------------------------------------------------------ ! outoutf = DZERO do n = 1, this%noutlets @@ -2852,25 +2699,20 @@ subroutine lak_calculate_outlet_outflow(this, ilak, stage, avail, outoutf) end if end do ! - ! -- return + ! -- Return return end subroutine lak_calculate_outlet_outflow + !> @brief Get the outlet inflow to a lake from another lake + !< subroutine lak_get_internal_inlet(this, ilak, outinf) -! ****************************************************************************** -! lak_get_internal_inlet -- Get the outlet inflow to a lake from another lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outinf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outinf = DZERO do n = 1, this%noutlets if (this%lakeout(n) == ilak) then @@ -2881,25 +2723,20 @@ subroutine lak_get_internal_inlet(this, ilak, outinf) end if end do ! - ! -- return + ! -- Return return end subroutine lak_get_internal_inlet + !> @brief Get the outlet from a lake to another lake + !< subroutine lak_get_internal_outlet(this, ilak, outoutf) -! ****************************************************************************** -! lak_get_internal_outlet -- Get the outlet from a lake to another lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outoutf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outoutf = DZERO do n = 1, this%noutlets if (this%lakein(n) == ilak) then @@ -2908,26 +2745,20 @@ subroutine lak_get_internal_outlet(this, ilak, outoutf) end if end do ! - ! -- return + ! -- Return return end subroutine lak_get_internal_outlet + !> @brief Get the outlet outflow from a lake to an external boundary + !< subroutine lak_get_external_outlet(this, ilak, outoutf) -! ****************************************************************************** -! lak_get_external_outlet -- Get the outlet outflow from a lake to an external -! boundary. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outoutf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outoutf = DZERO do n = 1, this%noutlets if (this%lakein(n) == ilak) then @@ -2936,26 +2767,20 @@ subroutine lak_get_external_outlet(this, ilak, outoutf) end if end do ! - ! -- return + ! -- Return return end subroutine lak_get_external_outlet + !> @brief Get the mover outflow from a lake to an external boundary + !< subroutine lak_get_external_mover(this, ilak, outoutf) -! ****************************************************************************** -! lak_get_external_mover -- Get the mover outflow from a lake to an external -! boundary. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outoutf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outoutf = DZERO if (this%imover == 1) then do n = 1, this%noutlets @@ -2966,25 +2791,20 @@ subroutine lak_get_external_mover(this, ilak, outoutf) end do end if ! - ! -- return + ! -- Return return end subroutine lak_get_external_mover + !> @brief Get the mover outflow from a lake to another lake + !< subroutine lak_get_internal_mover(this, ilak, outoutf) -! ****************************************************************************** -! lak_get_internal_mover -- Get the mover outflow from a lake to another lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outoutf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outoutf = DZERO if (this%imover == 1) then do n = 1, this%noutlets @@ -2995,25 +2815,20 @@ subroutine lak_get_internal_mover(this, ilak, outoutf) end do end if ! - ! -- return + ! -- Return return end subroutine lak_get_internal_mover + !> @brief Get the outlet to mover from a lake + !< subroutine lak_get_outlet_tomover(this, ilak, outoutf) -! ****************************************************************************** -! lak_get_outlet_tomover -- Get the outlet to mover from a lake. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak real(DP), intent(inout) :: outoutf ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ + ! outoutf = DZERO if (this%imover == 1) then do n = 1, this%noutlets @@ -3023,17 +2838,13 @@ subroutine lak_get_outlet_tomover(this, ilak, outoutf) end do end if ! - ! -- return + ! -- Return return end subroutine lak_get_outlet_tomover + !> @brief Determine the stage from a provided volume + !< subroutine lak_vol2stage(this, ilak, vol, stage) -! ****************************************************************************** -! lak_vol2stage-- Determine the stage from a provided volume. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak @@ -3049,8 +2860,7 @@ subroutine lak_vol2stage(this, ilak, vol, stage) real(DP) :: en0, en1 real(DP) :: ds, ds0 real(DP) :: denom - ! -- formats -! ------------------------------------------------------------------------------ + ! s0 = this%lakebot(ilak) call this%lak_calculate_vol(ilak, s0, v0) s1 = this%laketop(ilak) @@ -3113,15 +2923,13 @@ subroutine lak_vol2stage(this, ilak, vol, stage) end if end if ! - ! -- return + ! -- Return return end subroutine lak_vol2stage + !> @brief Determine if a valid lake or outlet number has been specified function lak_check_valid(this, itemno) result(ierr) -! ****************************************************************************** -! lak_check_valid -- Determine if a valid lake or outlet number has been -! specified. -! ****************************************************************************** + ! -- modules use SimModule, only: store_error ! -- return integer(I4B) :: ierr @@ -3130,8 +2938,7 @@ function lak_check_valid(this, itemno) result(ierr) integer(I4B), intent(in) :: itemno ! -- local integer(I4B) :: ival - ! -- formats -! ------------------------------------------------------------------------------ + ! ierr = 0 ival = abs(itemno) if (itemno > 0) then @@ -3151,16 +2958,15 @@ function lak_check_valid(this, itemno) result(ierr) ierr = 1 end if end if + ! + ! -- Return + return end function lak_check_valid + !> @brief Set a stress period attribute for lakweslls(itemno) using keywords + !< subroutine lak_set_stressperiod(this, itemno) -! ****************************************************************************** -! lak_set_stressperiod -- Set a stress period attribute for lakweslls(itemno) -! using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use TimeSeriesManagerModule, only: read_value_or_time_series_adv use SimModule, only: store_error ! -- dummy @@ -3174,8 +2980,6 @@ subroutine lak_set_stressperiod(this, itemno) integer(I4B) :: ii integer(I4B) :: jj real(DP), pointer :: bndElem => null() - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- read line call this%parser%GetStringCaps(keyword) @@ -3372,28 +3176,23 @@ subroutine lak_set_stressperiod(this, itemno) trim(keyword)//'.' end select ! - ! -- return + ! -- Return 999 return end subroutine lak_set_stressperiod + !> @brief Issue a parameter error for lakweslls(ilak) + !! + !! Read itmp and new boundaries if itmp > 0 + !< subroutine lak_set_attribute_error(this, ilak, keyword, msg) -! ****************************************************************************** -! lak_set_attribute_error -- Issue a parameter error for lakweslls(ilak) -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use SimModule, only: store_error ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: ilak character(len=*), intent(in) :: keyword character(len=*), intent(in) :: msg - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ + ! if (len(msg) == 0) then write (errmsg, '(a,1x,a,1x,i0,1x,a)') & keyword, ' for LAKE', ilak, 'has already been set.' @@ -3401,19 +3200,16 @@ subroutine lak_set_attribute_error(this, ilak, keyword, msg) write (errmsg, '(a,1x,a,1x,i0,1x,a)') keyword, ' for LAKE', ilak, msg end if call store_error(errmsg) - ! -- return + ! -- Return return end subroutine lak_set_attribute_error + !> @brief Set options specific to LakType + !! + !! lak_options overrides BndType%bnd_options + !< subroutine lak_options(this, option, found) -! ****************************************************************************** -! lak_options -- set options specific to LakType -! -! lak_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: MAXCHARLEN, DZERO, MNORMAL use OpenSpecModule, only: access, form use SimModule, only: store_error @@ -3421,7 +3217,7 @@ subroutine lak_options(this, option, found) ! -- dummy class(LakType), intent(inout) :: this character(len=*), intent(inout) :: option - logical, intent(inout) :: found + logical(LGP), intent(inout) :: found ! -- local character(len=MAXCHARLEN) :: fname, keyword real(DP) :: r @@ -3441,7 +3237,6 @@ subroutine lak_options(this, option, found) &"(4x, 'MAXIMUM LAK ITERATION VALUE (',i0,') SPECIFIED.')" character(len=*), parameter :: fmtdmaxchg = & &"(4x, 'MAXIMUM STAGE CHANGE VALUE (',g0,') SPECIFIED.')" -! ------------------------------------------------------------------------------ ! found = .true. select case (option) @@ -3564,24 +3359,17 @@ subroutine lak_options(this, option, found) found = .false. end select ! - ! -- return + ! -- Return return end subroutine lak_options + !> @brief Allocate and Read + !! + !! Create new LAK package and point bndobj to the new package + !< subroutine lak_ar(this) - ! ****************************************************************************** - ! lak_ar -- Allocate and Read - ! Subroutine: (1) create new-style package - ! (2) point bndobj to the new package - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this - ! -- local - ! -- format - ! ------------------------------------------------------------------------------ ! call this%obs%obs_ar() ! @@ -3597,19 +3385,16 @@ subroutine lak_ar(this) call this%pakmvrobj%ar(this%noutlets, this%nlakes, this%memoryPath) end if ! - ! -- return + ! -- Return return end subroutine lak_ar + !> @brief Read and Prepare + !! + !! Read itmp and read new boundaries if itmp > 0 + !< subroutine lak_rp(this) -! ****************************************************************************** -! lak_rp -- Read and Prepare -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: LINELENGTH use TdisModule, only: kper, nper use SimModule, only: store_error, count_errors @@ -3619,8 +3404,8 @@ subroutine lak_rp(this) character(len=LINELENGTH) :: title character(len=LINELENGTH) :: line character(len=LINELENGTH) :: text - logical :: isfound - logical :: endOfBlock + logical(LGP) :: isfound + logical(LGP) :: endOfBlock integer(I4B) :: ierr integer(I4B) :: node integer(I4B) :: n @@ -3631,7 +3416,6 @@ subroutine lak_rp(this) &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" character(len=*), parameter :: fmtlsp = & &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" -! ------------------------------------------------------------------------------ ! ! -- set nbound to maxbound this%nbound = this%maxbound @@ -3707,7 +3491,7 @@ subroutine lak_rp(this) call this%inputtab%line_to_columns(line) end if end do stressperiod - + ! if (this%iprpak /= 0) then call this%inputtab%finalize_table() end if @@ -3740,17 +3524,13 @@ subroutine lak_rp(this) end do end if ! - ! -- return + ! -- Return return end subroutine lak_rp + !> @brief Add package connection to matrix + !< subroutine lak_ad(this) -! ****************************************************************************** -! lak_ad -- Add package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: iFailedStepRetry ! -- dummy @@ -3759,7 +3539,6 @@ subroutine lak_ad(this) integer(I4B) :: n integer(I4B) :: j integer(I4B) :: iaux -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -3815,30 +3594,23 @@ subroutine lak_ad(this) ! "current" value. call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine lak_ad - subroutine lak_cf(this, reset_mover) - ! ****************************************************************************** - ! lak_cf -- Formulate the HCOF and RHS terms - ! Subroutine: (1) skip if no lakes - ! (2) calculate hcof and rhs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no lakes, otherwise calculate hcof and rhs + !< + subroutine lak_cf(this) ! -- dummy class(LakType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: j, n integer(I4B) :: igwfnode real(DP) :: hlak, blak - logical :: lrm - ! ------------------------------------------------------------------------------ - !! - !! -- Calculate lak conductance and update package RHS and HCOF + ! + ! -- Calculate lak conductance and update package RHS and HCOF !call this%lak_cfupdate() ! ! -- save groundwater seepage for lake solution @@ -3852,13 +3624,6 @@ subroutine lak_cf(this, reset_mover) call this%lak_calculate_exchange(n, this%s0(n), this%qgwf0(n)) end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- find highest active cell do n = 1, this%nlakes do j = this%idxlakeconn(n), this%idxlakeconn(n + 1) - 1 @@ -3911,7 +3676,7 @@ subroutine lak_cf(this, reset_mover) this%ibound(igwfnode) = 1 end if end do - + ! end do ! ! -- Store the lake stage and cond in bound array for other @@ -3922,13 +3687,9 @@ subroutine lak_cf(this, reset_mover) return end subroutine lak_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine lak_fc(this, rhs, ia, idxglo, matrix_sln) - ! ************************************************************************** - ! lak_fc -- Copy rhs and hcof into solution rhs and amat - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(LakType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -3939,7 +3700,6 @@ subroutine lak_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B) :: j, n integer(I4B) :: igwfnode integer(I4B) :: ipossymd -! -------------------------------------------------------------------------- ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -3960,17 +3720,13 @@ subroutine lak_fc(this, rhs, ia, idxglo, matrix_sln) end do end do ! - ! -- return + ! -- Return return end subroutine lak_fc + !> @brief Fill newton terms + !< subroutine lak_fn(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! lak_fn -- Fill newton terms -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(LakType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -3993,7 +3749,7 @@ subroutine lak_fn(this, rhs, ia, idxglo, matrix_sln) real(DP) :: q1 real(DP) :: rterm real(DP) :: drterm -! -------------------------------------------------------------------------- + ! do n = 1, this%nlakes if (this%iboundpak(n) == 0) cycle hlak = this%xnewpak(n) @@ -4025,19 +3781,15 @@ subroutine lak_fn(this, rhs, ia, idxglo, matrix_sln) end if end do end do - ! - ! -- return + ! -- Return return end subroutine lak_fn + !> @brief Final convergence check for package + !< subroutine lak_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) -! ************************************************************************** -! lak_cc -- Final convergence check for package -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: totim, kstp, kper, delt ! -- dummy class(LakType), intent(inout) :: this @@ -4086,8 +3838,6 @@ subroutine lak_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) real(DP) :: dqoutmax real(DP) :: dqfrommvr real(DP) :: dqfrommvrmax - ! format -! -------------------------------------------------------------------------- ! ! -- initialize local variables icheck = this%iconvchk @@ -4331,17 +4081,13 @@ subroutine lak_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) end if end if ! - ! -- return + ! -- Return return end subroutine lak_cc + !> @brief Calculate flows + !< subroutine lak_cq(this, x, flowja, iadv) -! ****************************************************************************** -! lak_cq -- Calculate flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -4356,7 +4102,6 @@ subroutine lak_cq(this, x, flowja, iadv) integer(I4B) :: j, n real(DP) :: hlak real(DP) :: v0, v1 -! ------------------------------------------------------------------------------ ! call this%lak_solve(update=.false.) ! @@ -4440,10 +4185,12 @@ subroutine lak_cq(this, x, flowja, iadv) ! -- fill the budget object call this%lak_fill_budobj() ! - ! -- return + ! -- Return return end subroutine lak_cq + !> @brief Output LAK package flow terms + !< subroutine lak_ot_package_flows(this, icbcfl, ibudfl) use TdisModule, only: kstp, kper, delt, pertim, totim class(LakType) :: this @@ -4466,9 +4213,13 @@ subroutine lak_ot_package_flows(this, icbcfl, ibudfl) if (ibudfl /= 0 .and. this%iprflow /= 0) then call this%budobj%write_flowtable(this%dis, kstp, kper) end if - + ! + ! -- Return + return end subroutine lak_ot_package_flows + !> @brief Write flows to binary file and/or print flows to budget + !< subroutine lak_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) class(LakType) :: this integer(I4B), intent(in) :: icbcfl @@ -4478,8 +4229,13 @@ subroutine lak_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) ! ! -- write the flows from the budobj call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap) + ! + ! -- Return + return end subroutine lak_ot_model_flows + !> @brief Save LAK-calculated values to binary file + !< subroutine lak_ot_dv(this, idvsave, idvprint) use TdisModule, only: kstp, kper, pertim, totim use ConstantsModule, only: DHNOFLO, DHDRY @@ -4495,7 +4251,6 @@ subroutine lak_ot_dv(this, idvsave, idvprint) real(DP) :: sa real(DP) :: wa ! - ! ! -- set unit number for binary dependent variable output ibinun = 0 if (this%istageout /= 0) then @@ -4541,9 +4296,13 @@ subroutine lak_ot_dv(this, idvsave, idvprint) call this%stagetab%add_term(v) end do end if - + ! + ! -- Return + return end subroutine lak_ot_dv + !> @brief Write LAK budget to listing file + !< subroutine lak_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! -- module use TdisModule, only: totim @@ -4556,23 +4315,17 @@ subroutine lak_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim) ! + ! -- Return return end subroutine lak_ot_bdsummary + !> @brief Deallocate objects + !< subroutine lak_da(this) - ! ************************************************************************** - ! lak_da -- Deallocate objects - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(LakType) :: this - ! -- local - ! -- format - ! -------------------------------------------------------------------------- ! ! -- arrays deallocate (this%lakename) @@ -4622,9 +4375,11 @@ subroutine lak_da(this) ! ! -- package csv table if (this%ipakcsv > 0) then - call this%pakcsvtab%table_da() - deallocate (this%pakcsvtab) - nullify (this%pakcsvtab) + if (associated(this%pakcsvtab)) then + call this%pakcsvtab%table_da() + deallocate (this%pakcsvtab) + nullify (this%pakcsvtab) + end if end if ! ! -- scalars @@ -4730,16 +4485,12 @@ subroutine lak_da(this) return end subroutine lak_da + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules class(LakType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -4758,26 +4509,21 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel + !> @brief Set pointers to model arrays and variables so that a package has + !! access to these things + !< subroutine lak_set_pointers(this, neq, ibound, xnew, xold, flowja) -! ****************************************************************************** -! set_pointers -- Set pointers to model arrays and variables so that a package -! has access to these things. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(LakType) :: this integer(I4B), pointer :: neq integer(I4B), dimension(:), pointer, contiguous :: ibound real(DP), dimension(:), pointer, contiguous :: xnew real(DP), dimension(:), pointer, contiguous :: xold real(DP), dimension(:), pointer, contiguous :: flowja - ! -- local -! ------------------------------------------------------------------------------ ! ! -- call base BndType set_pointers call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja) @@ -4795,40 +4541,33 @@ subroutine lak_set_pointers(this, neq, ibound, xnew, xold, flowja) ! this%xnewpak(n) = DEP20 !end do ! - ! -- return + ! -- Return + return end subroutine lak_set_pointers - ! - ! -- Procedures related to observations (type-bound) + !> @brief Procedures related to observations (type-bound) + !! + !! Return true because LAK package supports observations. Overrides + !! BndType%bnd_obs_supported() + !< logical function lak_obs_supported(this) - ! ****************************************************************************** - ! lak_obs_supported - ! -- Return true because LAK package supports observations. - ! -- Overrides BndType%bnd_obs_supported() - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ - ! ------------------------------------------------------------------------------ + ! -- dummy class(LakType) :: this + ! lak_obs_supported = .true. + ! + ! -- Return return end function lak_obs_supported + !> @brief Store observation type supported by LAK package. Overrides + !! BndType%bnd_df_obs + !< subroutine lak_df_obs(this) - ! ****************************************************************************** - ! lak_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by LAK package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ ! -- dummy class(LakType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for stage observation type. @@ -4925,18 +4664,14 @@ subroutine lak_df_obs(this) call this%obs%StoreObsType('conductance', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => lak_process_obsID ! + ! -- Return return end subroutine lak_df_obs + !> @brief Calculate observations this time step and call ObsType%SaveOneSimval + !! for each LakType observation. + !< subroutine lak_bd_obs(this) - ! ************************************************************************** - ! lak_bd_obs - ! -- Calculate observations this time step and call - ! ObsType%SaveOneSimval for each LakType observation. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(LakType) :: this ! -- local @@ -4950,7 +4685,6 @@ subroutine lak_bd_obs(this) real(DP) :: v real(DP) :: v2 type(ObserveType), pointer :: obsrv => null() - !--------------------------------------------------------------------------- ! ! Write simulated values for all LAK observations if (this%obs%npakobs > 0) then @@ -5089,9 +4823,15 @@ subroutine lak_bd_obs(this) end if end if ! + ! -- Return return end subroutine lak_bd_obs + !> @brief Process each observation + !! + !! Only done the first stress period since boundaries are fixed for the + !! simulation + !< subroutine lak_rp_obs(this) use TdisModule, only: kper ! -- dummy @@ -5103,9 +4843,8 @@ subroutine lak_rp_obs(this) integer(I4B) :: nn2 integer(I4B) :: jj character(len=LENBOUNDNAME) :: bname - logical :: jfound + logical(LGP) :: jfound class(ObserveType), pointer :: obsrv => null() - ! -------------------------------------------------------------------------- ! -- formats 10 format('Boundary "', a, '" for observation "', a, & '" is invalid in package "', a, '"') @@ -5237,14 +4976,18 @@ subroutine lak_rp_obs(this) end if end if ! + ! -- Return return end subroutine lak_rp_obs ! ! -- Procedures related to observations (NOT type-bound) + + !> @brief This procedure is pointed to by ObsDataType%ProcesssIdPtr. It + !! processes the ID string of an observation definition for LAK package + !! observations. + !< subroutine lak_process_obsID(obsrv, dis, inunitobs, iout) - ! -- This procedure is pointed to by ObsDataType%ProcesssIdPtr. It processes - ! the ID string of an observation definition for LAK package observations. ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -5255,7 +4998,6 @@ subroutine lak_process_obsID(obsrv, dis, inunitobs, iout) integer(I4B) :: icol, istart, istop character(len=LINELENGTH) :: strng character(len=LENBOUNDNAME) :: bndname - ! formats ! strng = obsrv%IDstring ! -- Extract lake number from strng and store it. @@ -5290,19 +5032,17 @@ subroutine lak_process_obsID(obsrv, dis, inunitobs, iout) ! -- store lake number (NodeNumber) obsrv%NodeNumber = nn1 ! + ! -- Return return end subroutine lak_process_obsID ! ! -- private LAK methods ! + + !> @brief Accumulate constant head terms for budget + !< subroutine lak_accumulate_chterm(this, ilak, rrate, chratin, chratout) - ! ************************************************************************** - ! lak_accumulate_chterm -- Accumulate constant head terms for budget. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(LakType) :: this integer(I4B), intent(in) :: ilak @@ -5311,7 +5051,7 @@ subroutine lak_accumulate_chterm(this, ilak, rrate, chratin, chratout) real(DP), intent(inout) :: chratout ! -- locals real(DP) :: q - ! format + ! ! code if (this%iboundpak(ilak) < 0) then q = -rrate @@ -5328,21 +5068,19 @@ subroutine lak_accumulate_chterm(this, ilak, rrate, chratin, chratout) chratin = chratin + q end if end if - ! -- return + ! + ! -- Return return end subroutine lak_accumulate_chterm + !> @brief Update LAK satcond and package rhs and hcof + !< subroutine lak_cfupdate(this) - ! ****************************************************************************** - ! lak_cfupdate -- Update LAK satcond and package rhs and hcof - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ + ! -- dummy class(LakType), intent(inout) :: this + ! -- local integer(I4B) :: j, n, node real(DP) :: hlak, head, clak, blak - ! ------------------------------------------------------------------------------ ! ! -- Return if no lak lakes if (this%nbound .eq. 0) return @@ -5380,18 +5118,14 @@ subroutine lak_cfupdate(this) return end subroutine lak_cfupdate + !> @brief Store the lake head and connection conductance in the bound array + !< subroutine lak_bound_update(this) - ! ****************************************************************************** - ! lak_bound_update -- store the lake head and connection conductance in the - ! bound array - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ + ! -- dummy class(LakType), intent(inout) :: this + ! -- local integer(I4B) :: j, n, node real(DP) :: hlak, head, clak - ! ------------------------------------------------------------------------------ ! ! -- Return if no lak lakes if (this%nbound == 0) return @@ -5412,19 +5146,16 @@ subroutine lak_bound_update(this) return end subroutine lak_bound_update + !> @brief Solve for lake stage + !< subroutine lak_solve(this, update) - ! ************************************************************************** - ! lak_solve -- Solve for lake stage - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: delt - logical, intent(in), optional :: update ! -- dummy class(LakType), intent(inout) :: this + logical(LGP), intent(in), optional :: update ! -- local - logical :: lupdate + logical(LGP) :: lupdate integer(I4B) :: i integer(I4B) :: j integer(I4B) :: n @@ -5465,7 +5196,6 @@ subroutine lak_solve(this, update) real(DP) :: ts real(DP) :: area real(DP) :: qtolfact -! -------------------------------------------------------------------------- ! ! -- set lupdate if (present(update)) then @@ -5526,10 +5256,10 @@ subroutine lak_solve(this, update) call this%lak_calculate_outlet_inflow(n, outinf) this%flwin(n) = this%flwin(n) + outinf end do - + ! iicnvg = 0 maxiter = this%maxlakit - + ! ! -- outer loop converge: do iter = 1, maxiter ncnv = 0 @@ -5538,7 +5268,7 @@ subroutine lak_solve(this, update) end do if (iter == maxiter) ncnv = 0 if (ncnv == 0) iicnvg = 1 - + ! ! -- initialize variables do n = 1, this%nlakes this%evap(n) = DZERO @@ -5558,7 +5288,7 @@ subroutine lak_solve(this, update) this%flwiter1(n) = DEP20 !1.D+10 end if end do - + ! estseep: do i = 1, 2 lakseep: do n = 1, this%nlakes ! -- skip inactive lakes @@ -5602,11 +5332,11 @@ subroutine lak_solve(this, update) end if end if end if - + ! end do calcconnseep end do lakseep end do estseep - + ! laklevel: do n = 1, this%nlakes ibflg = 0 hlak = this%xnewpak(n) @@ -5656,7 +5386,6 @@ subroutine lak_solve(this, update) call this%lak_calculate_external(n, ex) this%flwin(n) = this%surfin(n) + ro + qinf + ex + & max(v0, v1) / delt - ! ! -- compute new lake stage using Newton's method resid = this%precip(n) + this%evap(n) + this%withr(n) + ro + & @@ -5769,9 +5498,9 @@ subroutine lak_solve(this, update) this%dh0(n) = dh end if end do laklevel - + ! if (iicnvg == 1) exit converge - + ! end do converge ! ! -- Mover terms: store outflow after diversion loss @@ -5783,14 +5512,13 @@ subroutine lak_solve(this, update) end do end if ! - ! -- return + ! -- Return return end subroutine lak_solve !> @ brief Lake package bisection method - !! - !! Use bisection method to find lake stage that reduces the residual - !! + !! + !! Use bisection method to find lake stage that reduces the residual !< subroutine lak_bisection(this, n, ibflg, hlak, temporary_stage, dh, residual) ! -- dummy @@ -5836,19 +5564,16 @@ subroutine lak_bisection(this, n, ibflg, hlak, temporary_stage, dh, residual) end do dh = hlak - temporary_stage ! - ! -- return + ! -- Return return end subroutine lak_bisection + !> @brief Calculate the available volumetric rate for a lake given a passed + !! stage + !< subroutine lak_calculate_available(this, n, hlak, avail, & ra, ro, qinf, ex, headp) - ! ************************************************************************** - ! lak_calculate_available -- Calculate the available volumetric rate for - ! a lake given a passed stage - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: delt ! -- dummy class(LakType), intent(inout) :: this @@ -5868,7 +5593,6 @@ subroutine lak_calculate_available(this, n, hlak, avail, & real(DP) :: head real(DP) :: qlakgw real(DP) :: v0 - ! code ! ! -- set hp if (present(headp)) then @@ -5909,18 +5633,14 @@ subroutine lak_calculate_available(this, n, hlak, avail, & call this%lak_calculate_vol(n, this%xoldpak(n), v0) avail = avail + v0 / delt ! - ! -- return + ! -- Return return end subroutine lak_calculate_available + !> @brief Calculate the residual for a lake given a passed stage + !< subroutine lak_calculate_residual(this, n, hlak, resid, headp) - ! ************************************************************************** - ! lak_calculate_residual -- Calculate the residual for a lake given a - ! passed stage - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: delt ! -- dummy class(LakType), intent(inout) :: this @@ -5949,8 +5669,6 @@ subroutine lak_calculate_residual(this, n, hlak, resid, headp) real(DP) :: v0 real(DP) :: v1 ! - ! -- code - ! ! -- set hp if (present(headp)) then hp = headp @@ -6000,17 +5718,13 @@ subroutine lak_calculate_residual(this, n, hlak, resid, headp) resid = resid + (v0 - v1) / delt end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_residual + !> @brief Set up the budget object that stores all the lake flows + !< subroutine lak_setup_budobj(this) -! ****************************************************************************** -! lak_setup_budobj -- Set up the budget object that stores all the lake flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -6024,7 +5738,6 @@ subroutine lak_setup_budobj(this) real(DP) :: q character(len=LENBUDTXT) :: text character(len=LENBUDTXT), dimension(1) :: auxtxt -! ------------------------------------------------------------------------------ ! ! -- Determine the number of lake budget terms. These are fixed for ! the simulation and cannot change @@ -6260,18 +5973,13 @@ subroutine lak_setup_budobj(this) call this%budobj%flowtable_df(this%iout) end if ! - ! -- return + ! -- Return return end subroutine lak_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine lak_fill_budobj(this) -! ****************************************************************************** -! lak_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(LakType) :: this ! -- local @@ -6289,8 +5997,6 @@ subroutine lak_fill_budobj(this) real(DP) :: v, v1 real(DP) :: q real(DP) :: lkstg, gwhead, wa - ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 @@ -6318,7 +6024,7 @@ subroutine lak_fill_budobj(this) end if end do end if - + ! ! -- GWF (LEAKAGE) idx = idx + 1 call this%budobj%budterm(idx)%reset(this%maxbound) @@ -6340,7 +6046,7 @@ subroutine lak_fill_budobj(this) call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc) end do end do - + ! ! -- RAIN idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6348,7 +6054,7 @@ subroutine lak_fill_budobj(this) q = this%precip(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- EVAPORATION idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6356,7 +6062,7 @@ subroutine lak_fill_budobj(this) q = this%evap(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- RUNOFF idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6364,7 +6070,7 @@ subroutine lak_fill_budobj(this) q = this%runoff(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- INFLOW idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6372,7 +6078,7 @@ subroutine lak_fill_budobj(this) q = this%inflow(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- WITHDRAWAL idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6380,7 +6086,7 @@ subroutine lak_fill_budobj(this) q = this%withr(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- EXTERNAL OUTFLOW idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6391,7 +6097,7 @@ subroutine lak_fill_budobj(this) q = q + v call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- STORAGE idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6401,7 +6107,7 @@ subroutine lak_fill_budobj(this) this%qauxcbc(1) = v1 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc) end do - + ! ! -- CONSTANT FLOW idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6409,10 +6115,10 @@ subroutine lak_fill_budobj(this) q = this%chterm(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- MOVER if (this%imover == 1) then - + ! ! -- FROM MOVER idx = idx + 1 call this%budobj%budterm(idx)%reset(this%nlakes) @@ -6420,7 +6126,7 @@ subroutine lak_fill_budobj(this) q = this%pakmvrobj%get_qfrommvr(n) call this%budobj%budterm(idx)%update_term(n, n, q) end do - + ! ! -- TO MOVER idx = idx + 1 call this%budobj%budterm(idx)%reset(this%noutlets) @@ -6432,9 +6138,9 @@ subroutine lak_fill_budobj(this) end if call this%budobj%budterm(idx)%update_term(n1, n1, q) end do - + ! end if - + ! ! -- AUXILIARY VARIABLES naux = this%naux if (naux > 0) then @@ -6455,20 +6161,16 @@ subroutine lak_fill_budobj(this) ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return end subroutine lak_fill_budobj + !> @brief Set up the table object that is used to write the lak stage data + !! + !! The terms listed here must correspond in number and order to the ones + !! written to the stage table in the lak_ot method + !< subroutine lak_setup_tableobj(this) -! ****************************************************************************** -! lak_setup_tableobj -- Set up the table object that is used to write the lak -! stage data. The terms listed here must correspond in -! number and order to the ones written to the stage table -! in the lak_ot method. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, LENBUDTXT ! -- dummy @@ -6477,7 +6179,6 @@ subroutine lak_setup_tableobj(this) integer(I4B) :: nterms character(len=LINELENGTH) :: title character(len=LINELENGTH) :: text -! ------------------------------------------------------------------------------ ! ! -- setup stage table if (this%iprhed > 0) then @@ -6527,23 +6228,17 @@ subroutine lak_setup_tableobj(this) call this%stagetab%initialize_column(text, 12, alignment=TABCENTER) end if ! - ! -- return + ! -- Return return end subroutine lak_setup_tableobj + !> @brief Activate addition of density terms + !< subroutine lak_activate_density(this) -! ****************************************************************************** -! lak_activate_density -- Activate addition of density terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this ! -- local integer(I4B) :: i, j - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Set idense and reallocate denseterms to be of size MAXBOUND this%idense = 1 @@ -6557,14 +6252,13 @@ subroutine lak_activate_density(this) write (this%iout, '(/1x,a)') 'DENSITY TERMS HAVE BEEN ACTIVATED FOR LAKE & &PACKAGE: '//trim(adjustl(this%packName)) ! - ! -- return + ! -- Return return end subroutine lak_activate_density !> @brief Activate viscosity terms - !! - !! Method to activate addition of viscosity terms for a LAK package reach. - !! + !! + !! Method to activate addition of viscosity terms for a LAK package reach. !< subroutine lak_activate_viscosity(this) ! -- modules @@ -6587,36 +6281,30 @@ subroutine lak_activate_viscosity(this) write (this%iout, '(/1x,a)') 'VISCOSITY HAS BEEN ACTIVATED FOR LAK & &PACKAGE: '//trim(adjustl(this%packName)) ! - ! -- return + ! -- Return return end subroutine lak_activate_viscosity + !> @brief Calculate the groundwater-lake density exchange terms + !! + !! Arguments are as follows: + !! iconn : lak-gwf connection number + !! stage : lake stage + !! head : gwf head + !! cond : conductance + !! botl : bottom elevation of this connection + !! flow : calculated flow, updated here with density terms + !! gwfhcof : gwf head coefficient, updated here with density terms + !! gwfrhs : gwf right-hand-side value, updated here with density terms + !! + !! Member variable used here + !! denseterms : shape (3, MAXBOUND), filled by buoyancy package + !! col 1 is relative density of lake (denselak / denseref) + !! col 2 is relative density of gwf cell (densegwf / denseref) + !! col 3 is elevation of gwf cell + !< subroutine lak_calculate_density_exchange(this, iconn, stage, head, cond, & botl, flow, gwfhcof, gwfrhs) -! ****************************************************************************** -! lak_calculate_density_exchange -- Calculate the groundwater-lake density -! exchange terms. -! -! -- Arguments are as follows: -! iconn : lak-gwf connection number -! stage : lake stage -! head : gwf head -! cond : conductance -! botl : bottom elevation of this connection -! flow : calculated flow, updated here with density terms -! gwfhcof : gwf head coefficient, updated here with density terms -! gwfrhs : gwf right-hand-side value, updated here with density terms -! -! -- Member variable used here -! denseterms : shape (3, MAXBOUND), filled by buoyancy package -! col 1 is relative density of lake (denselak / denseref) -! col 2 is relative density of gwf cell (densegwf / denseref) -! col 3 is elevation of gwf cell -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(LakType), intent(inout) :: this integer(I4B), intent(in) :: iconn @@ -6639,10 +6327,8 @@ subroutine lak_calculate_density_exchange(this, iconn, stage, head, cond, & real(DP) :: elevavg real(DP) :: d1 real(DP) :: d2 - logical :: stage_below_bot - logical :: head_below_bot - ! -- formats -! ------------------------------------------------------------------------------ + logical(LGP) :: stage_below_bot + logical(LGP) :: head_below_bot ! ! -- Set lak density to lak density or gwf density if (stage >= botl) then @@ -6708,7 +6394,7 @@ subroutine lak_calculate_density_exchange(this, iconn, stage, head, cond, & end if end if ! - ! -- return + ! -- Return return end subroutine lak_calculate_density_exchange diff --git a/src/Model/GroundWaterFlow/gwf3maw8.f90 b/src/Model/GroundWaterFlow/gwf3maw8.f90 index 59c79e205c6..df40289b0d3 100644 --- a/src/Model/GroundWaterFlow/gwf3maw8.f90 +++ b/src/Model/GroundWaterFlow/gwf3maw8.f90 @@ -18,7 +18,8 @@ module MawModule use TableModule, only: TableType, table_cr use ObserveModule, only: ObserveType use ObsModule, only: ObsType - use InputOutputModule, only: get_node, URWORD, extract_idnum_or_bndname, & + use GeomUtilModule, only: get_node + use InputOutputModule, only: URWORD, extract_idnum_or_bndname, & GetUnit, openfile use BaseDisModule, only: DisBaseType use SimModule, only: count_errors, store_error, store_error_unit, & @@ -163,7 +164,9 @@ module MawModule real(DP), dimension(:, :), pointer, contiguous :: viscratios => null() !< viscosity ratios (1: maw vsc ratio; 2: gwf vsc ratio) ! ! -- type bound procedures + contains + procedure :: maw_allocate_scalars procedure :: maw_allocate_well_conn_arrays procedure :: maw_allocate_arrays @@ -223,15 +226,12 @@ module MawModule contains +!> @brief Create a New Multi-Aquifer Well (MAW) Package +!! +!! After creating the package object point bndobj to the new package +!< subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! maw_create -- Create a New Multi-Aquifer Well Package -! Subroutine: (1) create new-style package -! (2) point bndobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id integer(I4B), intent(in) :: ibcnum @@ -240,7 +240,6 @@ subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname type(MawType), pointer :: mawobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (mawobj) @@ -255,7 +254,7 @@ subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id @@ -265,22 +264,17 @@ subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%isadvpak = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine maw_create + !> @brief Allocate scalar members + !< subroutine maw_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(MawType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_scalars() @@ -326,17 +320,13 @@ subroutine maw_allocate_scalars(this) this%idense = 0 this%ivsc = 0 ! - ! -- return + ! -- Return return end subroutine maw_allocate_scalars + !> @brief Allocate well arrays + !< subroutine maw_allocate_well_conn_arrays(this) -! ****************************************************************************** -! maw_allocate_arrays -- allocate well arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -345,7 +335,6 @@ subroutine maw_allocate_well_conn_arrays(this) integer(I4B) :: j integer(I4B) :: n integer(I4B) :: jj -! ------------------------------------------------------------------------------ ! ! -- allocate character array for budget text call mem_allocate(this%cmawbudget, LENBUDTXT, this%bditems, 'CMAWBUDGET', & @@ -531,39 +520,29 @@ subroutine maw_allocate_well_conn_arrays(this) ! -- allocate viscratios to size 0 call mem_allocate(this%viscratios, 2, 0, 'VISCRATIOS', this%memoryPath) ! - ! -- return + ! -- Return return end subroutine maw_allocate_well_conn_arrays + !> @brief Allocate arrays + !< subroutine maw_allocate_arrays(this) -! ****************************************************************************** -! maw_allocate_arrays -- allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(MawType), intent(inout) :: this ! -- local - !integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_arrays() ! - ! -- return + ! -- Return return end subroutine maw_allocate_arrays + !> @brief Read the packagedata for this package + !< subroutine maw_read_wells(this) -! ****************************************************************************** -! maw_read_wells -- Read the packagedata for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy @@ -601,9 +580,6 @@ subroutine maw_read_wells(this) character(len=*), parameter :: fmthdbot = & "('well head (', G0, ') must be greater than or equal to the & &BOTTOM_ELEVATION (', G0, ').')" -! ------------------------------------------------------------------------------ - ! - ! -- code ! ! -- allocate and initialize temporary variables allocate (strttext(this%nmawwells)) @@ -815,17 +791,13 @@ subroutine maw_read_wells(this) deallocate (radius) deallocate (bottom) ! - ! -- return + ! -- Return return end subroutine maw_read_wells + !> @brief Read the dimensions for this package + !< subroutine maw_read_well_connections(this) -! ****************************************************************************** -! pak1read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH ! -- dummy class(MawType), intent(inout) :: this @@ -852,11 +824,6 @@ subroutine maw_read_well_connections(this) real(DP) :: botw integer(I4B), dimension(:), pointer, contiguous :: nboundchk integer(I4B), dimension(:), pointer, contiguous :: iachk - -! ------------------------------------------------------------------------------ - ! -- format - ! - ! -- code ! ! -- initialize counters ireset_scrntop = 0 @@ -1072,17 +1039,13 @@ subroutine maw_read_well_connections(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine maw_read_well_connections + !> @brief Read the dimensions for this package + !< subroutine maw_read_dimensions(this) -! ****************************************************************************** -! pak1read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH ! -- dummy class(MawType), intent(inout) :: this @@ -1091,7 +1054,6 @@ subroutine maw_read_dimensions(this) integer(I4B) :: ierr logical :: isfound, endOfBlock ! -- format -! ------------------------------------------------------------------------------ ! ! -- initialize dimensions to -1 this%nmawwells = -1 @@ -1153,17 +1115,13 @@ subroutine maw_read_dimensions(this) ! -- setup the head table object call this%maw_setup_tableobj() ! - ! -- return + ! -- Return return end subroutine maw_read_dimensions + !> @brief Read the initial parameters for this package + !< subroutine maw_read_initial_attr(this) -! ****************************************************************************** -! maw_read_initial_attr -- Read the initial parameters for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use MemoryManagerModule, only: mem_setptr @@ -1204,7 +1162,6 @@ subroutine maw_read_initial_attr(this) &/1X,2(A10,1X),A20,7(A10,1X))" character(len=*), parameter :: fmtwellcd = & &"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))" -! ------------------------------------------------------------------------------ ! ! -- initialize xnewpak do n = 1, this%nmawwells @@ -1388,18 +1345,13 @@ subroutine maw_read_initial_attr(this) call store_error_unit(this%inunit) end if ! - ! -- return + ! -- Return return end subroutine maw_read_initial_attr + !> @brief Set a stress period attribute for mawweslls(imaw) using keywords + !< subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning) -! ****************************************************************************** -! maw_set_stressperiod -- Set a stress period attribute for mawweslls(imaw) -! using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy @@ -1420,7 +1372,6 @@ subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning) ! -- formats character(len=*), parameter :: fmthdbot = & &"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')" -! ------------------------------------------------------------------------------ ! ! -- read remainder of variables on the line call this%parser%GetStringCaps(keyword) @@ -1529,19 +1480,13 @@ subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning) end select ! - ! -- return + ! -- Return return end subroutine maw_set_stressperiod + !> @brief Issue a parameter error for mawweslls(imaw) + !< subroutine maw_set_attribute_error(this, imaw, keyword, msg) -! ****************************************************************************** -! maw_set_attribute_error -- Issue a parameter error for mawweslls(imaw) -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SimModule, only: store_error ! -- dummy class(MawType), intent(inout) :: this @@ -1550,7 +1495,7 @@ subroutine maw_set_attribute_error(this, imaw, keyword, msg) character(len=*), intent(in) :: msg ! -- local ! -- formats -! ------------------------------------------------------------------------------ + ! if (len(msg) == 0) then write (errmsg, '(a,1x,a,1x,i0,1x,a)') & keyword, ' for MAW well', imaw, 'has already been set.' @@ -1560,19 +1505,13 @@ subroutine maw_set_attribute_error(this, imaw, keyword, msg) end if call store_error(errmsg) ! - ! -- return + ! -- Return return end subroutine maw_set_attribute_error + !> @brief Issue parameter errors for mawwells(imaw) + !< subroutine maw_check_attributes(this) -! ****************************************************************************** -! maw_check_attributes -- Issue parameter errors for mawwells(imaw) -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SimModule, only: store_error ! -- dummy class(MawType), intent(inout) :: this @@ -1583,7 +1522,7 @@ subroutine maw_check_attributes(this) integer(I4B) :: j integer(I4B) :: jpos ! -- formats -! ------------------------------------------------------------------------------ + ! idx = 1 do n = 1, this%nmawwells if (this%ngwfnodes(n) < 1) then @@ -1639,17 +1578,13 @@ subroutine maw_check_attributes(this) end do ! -- reset check_attr this%check_attr = 0 - ! -- return + ! -- Return return end subroutine maw_check_attributes + !> @brief Add package connection to matrix + !< subroutine maw_ac(this, moffset, sparse) -! ****************************************************************************** -! bnd_ac -- Add package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SparseModule, only: sparsematrix ! -- dummy class(MawType), intent(inout) :: this @@ -1662,8 +1597,6 @@ subroutine maw_ac(this, moffset, sparse) integer(I4B) :: jglo integer(I4B) :: nglo ! -- format -! ------------------------------------------------------------------------------ - ! ! ! -- Add package rows to sparse do n = 1, this%nmawwells @@ -1678,17 +1611,13 @@ subroutine maw_ac(this, moffset, sparse) end do ! - ! -- return + ! -- Return return end subroutine maw_ac + !> @brief Map package connection to matrix + !< subroutine maw_mc(this, moffset, matrix_sln) -! ****************************************************************************** -! bnd_ac -- map package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SparseModule, only: sparsematrix use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -1703,7 +1632,6 @@ subroutine maw_mc(this, moffset, matrix_sln) integer(I4B) :: jglo integer(I4B) :: ipos ! -- format -! ------------------------------------------------------------------------------ ! ! -- allocate connection mapping vectors call mem_allocate(this%idxlocnode, this%nmawwells, 'IDXLOCNODE', & @@ -1744,18 +1672,15 @@ subroutine maw_mc(this, moffset, matrix_sln) end do end do ! - ! -- return + ! -- Return return end subroutine maw_mc + !> @brief Set options specific to MawType. + !! + !! Overrides BndType%bnd_options + !< subroutine maw_read_options(this, option, found) -! ****************************************************************************** -! maw_read_options -- set options specific to MawType. -! Overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: MAXCHARLEN, DZERO, MNORMAL use OpenSpecModule, only: access, form use InputOutputModule, only: urword, getunit, openfile @@ -1775,7 +1700,6 @@ subroutine maw_read_options(this, option, found) character(len=*), parameter :: fmtmawbin = & "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, & &'OPENED ON UNIT: ', I0)" -! ------------------------------------------------------------------------------ ! ! -- Check for 'FLOWING_WELLS' and set this%iflowingwells found = .true. @@ -1869,24 +1793,19 @@ subroutine maw_read_options(this, option, found) found = .false. end select ! - ! -- return + ! -- Return return end subroutine maw_read_options + !> @brief Allocate and Read + !! + !! Create new MAW package and point bndobj to the new package + !< subroutine maw_ar(this) - ! ****************************************************************************** - ! maw_ar -- Allocate and Read - ! Subroutine: (1) create new-style package - ! (2) point bndobj to the new package - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ ! -- dummy class(MawType), intent(inout) :: this ! -- local ! -- format - ! ------------------------------------------------------------------------------ ! call this%obs%obs_ar() ! @@ -1907,19 +1826,15 @@ subroutine maw_ar(this) call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath) end if ! - ! -- return + ! -- Return return end subroutine maw_ar + !> @brief Read and Prepare + !! + !! Read itmp and new boundaries if itmp > 0 + !< subroutine maw_rp(this) -! ****************************************************************************** -! maw_rp -- Read and Prepare -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use TdisModule, only: kper, nper ! -- dummy @@ -1946,7 +1861,6 @@ subroutine maw_rp(this) &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" character(len=*), parameter :: fmtlsp = & &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" -! ------------------------------------------------------------------------------ ! ! -- initialize counters iheadlimit_warning = 0 @@ -2201,17 +2115,13 @@ subroutine maw_rp(this) end do end do ! - ! -- return + ! -- Return return end subroutine maw_rp + !> @brief Add package connection to matrix + !< subroutine maw_ad(this) -! ****************************************************************************** -! maw_ad -- Add package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TdisModule, only: kper, kstp ! -- dummy class(MawType) :: this @@ -2220,7 +2130,6 @@ subroutine maw_ad(this) integer(I4B) :: j integer(I4B) :: jj integer(I4B) :: ibnd -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -2275,47 +2184,29 @@ subroutine maw_ad(this) ! "current" value. call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine maw_ad - subroutine maw_cf(this, reset_mover) - ! ****************************************************************************** - ! maw_cf -- Formulate the HCOF and RHS terms - ! Subroutine: (1) skip if no multi-aquifer wells - ! (2) calculate hcof and rhs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no multi-aquifer wells, otherwise, calculate hcof and rhs + !< + subroutine maw_cf(this) ! -- dummy class(MawType) :: this - logical, intent(in), optional :: reset_mover ! -- local - logical :: lrm - ! ------------------------------------------------------------------------------ ! ! -- Calculate maw conductance and update package RHS and HCOF call this%maw_cfupdate() ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Return return end subroutine maw_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! maw_fc -- Copy rhs and hcof into solution rhs and amat -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -2350,7 +2241,6 @@ subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rate real(DP) :: ratefw real(DP) :: flow -! -------------------------------------------------------------------------- ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -2465,18 +2355,13 @@ subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln) end do end do ! - ! -- return + ! -- Return return end subroutine maw_fc + !> @brief Fill newton terms + !< subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! maw_fn -- Fill newton terms -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- - !use TdisModule, only:delt ! -- dummy class(MawType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -2514,7 +2399,6 @@ subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln) real(DP) :: flow real(DP) :: term2 real(DP) :: rhsterm -! -------------------------------------------------------------------------- ! ! -- Calculate Newton-Raphson corrections idx = 1 @@ -2636,19 +2520,14 @@ subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln) end do end do ! - ! -- return + ! -- Return return end subroutine maw_fn + !> @brief Calculate under-relaxation of groundwater flow model MAW Package heads + !! for current outer iteration using the well bottom + !< subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax) -! ****************************************************************************** -! maw_nur -- under-relaxation -! Subroutine: (1) Under-relaxation of Groundwater Flow Model MAW Package Heads -! for current outer iteration using the well bottom -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(MawType), intent(inout) :: this integer(I4B), intent(in) :: neqpak @@ -2663,8 +2542,6 @@ subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax) real(DP) :: botw real(DP) :: xx real(DP) :: dxx -! ------------------------------------------------------------------------------ - ! ! -- Newton-Raphson under-relaxation do n = 1, this%nmawwells @@ -2690,13 +2567,9 @@ subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax) return end subroutine maw_nur + !> @brief Calculate flows + !< subroutine maw_cq(this, x, flowja, iadv) -! ************************************************************************** -! maw_cq -- Calculate flows -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- modules use TdisModule, only: delt use ConstantsModule, only: LENBOUNDNAME @@ -2716,7 +2589,6 @@ subroutine maw_cq(this, x, flowja, iadv) real(DP) :: cfw ! -- for observations ! -- formats -! ------------------------------------------------------------------------------ ! ! -- recalculate package HCOF and RHS terms with latest groundwater and ! maw heads prior to calling base budget functionality @@ -2811,11 +2683,14 @@ subroutine maw_cq(this, x, flowja, iadv) ! -- fill the budget object call this%maw_fill_budobj() ! - ! -- return + ! -- Return return end subroutine maw_cq + !> @brief Write flows to binary file and/or print flows to budget + !< subroutine maw_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) + ! -- dummy class(MawType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl @@ -2826,6 +2701,8 @@ subroutine maw_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap) end subroutine maw_ot_model_flows + !> @brief Output MAW package flow terms. + !< subroutine maw_ot_package_flows(this, icbcfl, ibudfl) use TdisModule, only: kstp, kper, delt, pertim, totim class(MawType) :: this @@ -2848,9 +2725,13 @@ subroutine maw_ot_package_flows(this, icbcfl, ibudfl) if (ibudfl /= 0 .and. this%iprflow /= 0) then call this%budobj%write_flowtable(this%dis, kstp, kper) end if - + ! + ! -- Return + return end subroutine maw_ot_package_flows + !> @brief Save maw-calculated values to binary file + !< subroutine maw_ot_dv(this, idvsave, idvprint) use TdisModule, only: kstp, kper, pertim, totim use ConstantsModule, only: DHNOFLO, DHDRY @@ -2902,9 +2783,13 @@ subroutine maw_ot_dv(this, idvsave, idvprint) call this%headtab%add_term(this%xnewpak(n)) end do end if - + ! + ! -- Return + return end subroutine maw_ot_dv + !> @brief Write MAW budget to listing file + !< subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! -- module use TdisModule, only: totim @@ -2917,24 +2802,18 @@ subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim) ! - ! -- return + ! -- Return return end subroutine maw_ot_bdsummary + !> @brief Deallocate memory + !< subroutine maw_da(this) -! ****************************************************************************** -! maw_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(MawType) :: this ! -- local - !integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- budobj call this%budobj%budgetobject_da() @@ -3042,20 +2921,15 @@ subroutine maw_da(this) ! -- call standard BndType deallocate call this%BndType%bnd_da() ! - ! -- return + ! -- Return return end subroutine maw_da + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ class(MawType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -3074,18 +2948,14 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel + !> @brief Set pointers to model arrays and variables so that a package has + !! has access to these things. + !< subroutine maw_set_pointers(this, neq, ibound, xnew, xold, flowja) -! ****************************************************************************** -! set_pointers -- Set pointers to model arrays and variables so that a package -! has access to these things. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_checkin ! -- dummy @@ -3098,7 +2968,6 @@ subroutine maw_set_pointers(this, neq, ibound, xnew, xold, flowja) ! -- local integer(I4B) :: n integer(I4B) :: istart, iend -! ------------------------------------------------------------------------------ ! ! -- call base BndType set_pointers call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja) @@ -3119,40 +2988,34 @@ subroutine maw_set_pointers(this, neq, ibound, xnew, xold, flowja) this%xnewpak(n) = DEP20 end do ! - ! -- return + ! -- Return + return end subroutine maw_set_pointers - ! ! -- Procedures related to observations (type-bound) + + !> @brief Return true because MAW package supports observations + !! + !! Overrides BndType%bnd_obs_supported() + !< logical function maw_obs_supported(this) - ! ****************************************************************************** - ! maw_obs_supported - ! -- Return true because MAW package supports observations. - ! -- Overrides BndType%bnd_obs_supported() - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ class(MawType) :: this - ! ------------------------------------------------------------------------------ + ! maw_obs_supported = .true. + ! + ! -- Return return end function maw_obs_supported + !> @brief Store observation type supported by MAW package + !! + !! Overrides BndType%bnd_df_obs + !< subroutine maw_df_obs(this) - ! ****************************************************************************** - ! maw_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by MAW package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ ! -- dummy class(MawType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for head observation type. @@ -3209,18 +3072,14 @@ subroutine maw_df_obs(this) call this%obs%StoreObsType('fw-conductance', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsID ! + ! -- Return return end subroutine maw_df_obs + !> @brief Calculate observations this time step and call + !! ObsType%SaveOneSimval for each MawType observation. + !< subroutine maw_bd_obs(this) - ! ************************************************************************** - ! maw_bd_obs - ! -- Calculate observations this time step and call - ! ObsType%SaveOneSimval for each MawType observation. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(MawType) :: this ! -- local @@ -3235,7 +3094,6 @@ subroutine maw_bd_obs(this) real(DP) :: v real(DP) :: qfact type(ObserveType), pointer :: obsrv => null() - !--------------------------------------------------------------------------- ! ! Calculate, save, and write simulated values for all MAW observations if (this%obs%npakobs > 0) then @@ -3351,10 +3209,15 @@ subroutine maw_bd_obs(this) call this%maw_redflow_csv_write() end if ! - ! -- return + ! -- Return return end subroutine maw_bd_obs + !> @brief Process each observation + !! + !! Only done the first stress period since boundaries are fixed for the + !! simulation + !< subroutine maw_rp_obs(this) use TdisModule, only: kper ! -- dummy @@ -3369,14 +3232,10 @@ subroutine maw_rp_obs(this) character(len=LENBOUNDNAME) :: bname logical :: jfound class(ObserveType), pointer :: obsrv => null() - ! -------------------------------------------------------------------------- ! -- formats 10 format('Boundary "', a, '" for observation "', a, & '" is invalid in package "', a, '"') ! - ! -- process each package observation - ! only done the first stress period since boundaries are fixed - ! for the simulation if (kper == 1) then do i = 1, this%obs%npakobs obsrv => this%obs%pakobs(i)%obsrv @@ -3479,15 +3338,18 @@ subroutine maw_rp_obs(this) end if end if ! - ! -- return + ! -- Return return end subroutine maw_rp_obs ! ! -- Procedures related to observations (NOT type-bound) + + !> @brief This procedure is pointed to by ObsDataType%ProcesssIdPtr. It + !! processes the ID string of an observation definition for MAW package + !! observations. + !< subroutine maw_process_obsID(obsrv, dis, inunitobs, iout) - ! -- This procedure is pointed to by ObsDataType%ProcesssIdPtr. It processes - ! the ID string of an observation definition for MAW package observations. ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -3533,14 +3395,15 @@ subroutine maw_process_obsID(obsrv, dis, inunitobs, iout) ! -- store multi-aquifer well number (NodeNumber) obsrv%NodeNumber = nn1 ! - ! -- return + ! -- Return return end subroutine maw_process_obsID ! ! -- private MAW methods - ! + !> @brief Initialize the auto flow reduce csv output file + !< subroutine maw_redflow_csv_init(this, fname) ! -- dummy variables class(MawType), intent(inout) :: this !< MawType object @@ -3557,10 +3420,13 @@ subroutine maw_redflow_csv_init(this, fname) this%ioutredflowcsv write (this%ioutredflowcsv, '(a)') & 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction' + ! + ! -- Return return end subroutine maw_redflow_csv_init !> @brief MAW reduced flows only when & where they occur + !< subroutine maw_redflow_csv_write(this) ! -- modules use TdisModule, only: totim, kstp, kper @@ -3584,8 +3450,14 @@ subroutine maw_redflow_csv_write(this) totim, kper, kstp, n, this%rate(n), this%ratesim(n), v end if end do + ! + ! -- Return + return end subroutine maw_redflow_csv_write + !> @brief Calculate the appropriate saturated conductance to use based on + !! aquifer and multi-aquifer well characteristics + !< subroutine maw_calculate_satcond(this, i, j, node) ! -- dummy class(MawType), intent(inout) :: this @@ -3624,7 +3496,6 @@ subroutine maw_calculate_satcond(this, i, j, node) real(DP) :: yx4 real(DP) :: xy4 ! -- formats - ! ------------------------------------------------------------------------------ ! ! -- initialize conductance variables iTcontrastErr = 0 @@ -3748,10 +3619,12 @@ subroutine maw_calculate_satcond(this, i, j, node) ! -- set saturated conductance this%satcond(jpos) = c ! - ! -- return + ! -- Return return end subroutine maw_calculate_satcond + !> @brief Calculate the saturation between the aquifer maw well_head + !< subroutine maw_calculate_saturation(this, n, j, node, sat) ! -- dummy class(MawType), intent(inout) :: this @@ -3766,7 +3639,6 @@ subroutine maw_calculate_saturation(this, n, j, node, sat) real(DP) :: topw real(DP) :: botw ! -- formats - ! ------------------------------------------------------------------------------ ! ! -- initialize saturation sat = DZERO @@ -3809,31 +3681,24 @@ subroutine maw_calculate_saturation(this, n, j, node, sat) sat = DONE end if ! - ! -- return + ! -- Return return end subroutine maw_calculate_saturation + !> @brief Calculate matrix terms for a multi-aquifer well connection. Terms + !! for fc and fn methods are calculated based on whether term2 is passed + !! Arguments are as follows: + !! n : maw well number + !! j : connection number for well n + !! icflow : flag indicating that flow should be corrected + !! cmaw : maw-gwf conducance + !! cterm : correction term for flow to dry cell + !! term : xxx + !! flow : calculated flow for this connection, positive into well + !! term2 : xxx + !< subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, & flow, term2) -! ****************************************************************************** -! maw_calculate_conn_terms-- Calculate matrix terms for a multi-aquifer well -! connection. Terms for fc and fn methods are -! calculated based on whether term2 is passed -! -! -- Arguments are as follows: -! n : maw well number -! j : connection number for well n -! icflow : flag indicating that flow should be corrected -! cmaw : maw-gwf conducance -! cterm : correction term for flow to dry cell -! term : xxx -! flow : calculated flow for this connection, positive into well -! term2 : xxx -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(MawType) :: this integer(I4B), intent(in) :: n @@ -3861,7 +3726,6 @@ subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, & real(DP) :: drterm real(DP) :: dhbarterm real(DP) :: vscratio -! ------------------------------------------------------------------------------ ! ! -- initialize terms cterm = DZERO @@ -3973,19 +3837,14 @@ subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, & call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, & bmaw, flow, term, cterm) end if - ! - ! -- return + ! -- Return return end subroutine maw_calculate_conn_terms + !> @brief Calculate well pumping rate based on constraints + !< subroutine maw_calculate_wellq(this, n, hmaw, q) -! ************************************************************************** -! maw_calculate_wellq-- Calculate well pumping rate based on constraints -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(MawType) :: this integer(I4B), intent(in) :: n @@ -3998,7 +3857,6 @@ subroutine maw_calculate_wellq(this, n, hmaw, q) real(DP) :: rate real(DP) :: weight real(DP) :: dq -! -------------------------------------------------------------------------- ! ! -- Initialize q q = DZERO @@ -4148,17 +4006,13 @@ subroutine maw_calculate_wellq(this, n, hmaw, q) end if end if ! - ! -- return + ! -- Return return end subroutine maw_calculate_wellq + !> @brief Calculate groundwater inflow to a maw well + !< subroutine maw_calculate_qpot(this, n, qnet) -! ****************************************************************************** -! maw_calculate_qpot -- Calculate groundwater inflow to a maw well -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TdisModule, only: delt ! -- dummy class(MawType), intent(inout) :: this @@ -4181,7 +4035,6 @@ subroutine maw_calculate_qpot(this, n, qnet) real(DP) :: hv real(DP) :: vscratio ! -- format -! ------------------------------------------------------------------------------ ! ! -- initialize qnet and htmp qnet = DZERO @@ -4242,17 +4095,13 @@ subroutine maw_calculate_qpot(this, n, qnet) qnet = qnet + cmaw * (hgwf - hv) end do ! - ! -- return + ! -- Return return end subroutine maw_calculate_qpot + !> @brief Update MAW satcond and package rhs and hcof + !< subroutine maw_cfupdate(this) - ! ****************************************************************************** - ! maw_cfupdate -- Update MAW satcond and package rhs and hcof - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ class(MawType) :: this ! -- dummy ! -- local @@ -4266,7 +4115,6 @@ subroutine maw_cfupdate(this) real(DP) :: hmaw real(DP) :: cterm real(DP) :: term -! ------------------------------------------------------------------------------ ! ! -- Return if no maw wells if (this%nbound .eq. 0) return @@ -4309,15 +4157,11 @@ subroutine maw_cfupdate(this) return end subroutine maw_cfupdate + !> @brief Set up the budget object that stores all the maw flows + !! The terms listed here must correspond in number and order to the ones + !! listed in the maw_fill_budobj routine. + !< subroutine maw_setup_budobj(this) -! ****************************************************************************** -! maw_setup_budobj -- Set up the budget object that stores all the maw flows -! The terms listed here must correspond in number and order to the ones -! listed in the maw_fill_budobj routine. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -4330,7 +4174,6 @@ subroutine maw_setup_budobj(this) integer(I4B) :: idx character(len=LENBUDTXT) :: text character(len=LENBUDTXT), dimension(1) :: auxtxt -! ------------------------------------------------------------------------------ ! ! -- Determine the number of maw budget terms. These are fixed for ! the simulation and cannot change. @@ -4474,7 +4317,7 @@ subroutine maw_setup_budobj(this) maxlist, .false., .false., & naux) ! - ! -- + ! -- flowing-well flow to mover if (this%iflowingwells > 0) then ! ! -- @@ -4492,7 +4335,7 @@ subroutine maw_setup_budobj(this) end if end if ! - ! -- + ! -- auxiliary variable naux = this%naux if (naux > 0) then ! @@ -4514,19 +4357,16 @@ subroutine maw_setup_budobj(this) call this%budobj%flowtable_df(this%iout) end if ! - ! -- return + ! -- Return return end subroutine maw_setup_budobj + !> @brief Copy flow terms into this%budobj + !! + !! terms include a combination of the following: + !! gwf rate [flowing_well] [storage] constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux] + !< subroutine maw_fill_budobj(this) -! ****************************************************************************** -! maw_fill_budobj -- copy flow terms into this%budobj -! -! gwf rate [flowing_well] [storage] constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux] -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(MawType) :: this @@ -4547,7 +4387,6 @@ subroutine maw_fill_budobj(this) real(DP) :: b real(DP) :: v ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 @@ -4732,20 +4571,16 @@ subroutine maw_fill_budobj(this) ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return end subroutine maw_fill_budobj + !> @brief Set up the table object that is used to write the maw head data + !! + !! The terms listed here must correspond in number and order to the ones + !! written to the head table in the maw_ot method. + !< subroutine maw_setup_tableobj(this) -! ****************************************************************************** -! maw_setup_tableobj -- Set up the table object that is used to write the maw -! head data. The terms listed here must correspond in -! number and order to the ones written to the head table -! in the maw_ot method. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, LENBUDTXT ! -- dummy @@ -4754,7 +4589,6 @@ subroutine maw_setup_tableobj(this) integer(I4B) :: nterms character(len=LINELENGTH) :: title character(len=LINELENGTH) :: text -! ------------------------------------------------------------------------------ ! ! -- setup well head table if (this%iprhed > 0) then @@ -4787,17 +4621,13 @@ subroutine maw_setup_tableobj(this) call this%headtab%initialize_column(text, 12, alignment=TABCENTER) end if ! - ! -- return + ! -- Return return end subroutine maw_setup_tableobj + !> @brief Get position of value in connection data + !< function get_jpos(this, n, j) result(jpos) -! ****************************************************************************** -! get_jpos -- position of value in connection data. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return variable integer(I4B) :: jpos ! -- dummy @@ -4805,22 +4635,17 @@ function get_jpos(this, n, j) result(jpos) integer(I4B), intent(in) :: n integer(I4B), intent(in) :: j ! -- local -! ------------------------------------------------------------------------------ ! ! -- set jpos jpos = this%iaconn(n) + j - 1 ! - ! -- return + ! -- Return return end function get_jpos + !> @brief Get the gwfnode for connection + !< function get_gwfnode(this, n, j) result(igwfnode) -! ****************************************************************************** -! get_gwfnode -- get the gwfnode for connection. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return variable integer(I4B) :: igwfnode ! -- dummy @@ -4829,29 +4654,23 @@ function get_gwfnode(this, n, j) result(igwfnode) integer(I4B), intent(in) :: j ! -- local integer(I4B) :: jpos -! ------------------------------------------------------------------------------ ! ! -- set jpos jpos = this%get_jpos(n, j) igwfnode = this%gwfnodes(jpos) ! - ! -- return + ! -- Return return end function get_gwfnode + !> @brief Activate density terms + !< subroutine maw_activate_density(this) -! ****************************************************************************** -! maw_activate_density -- Activate addition of density terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(MawType), intent(inout) :: this ! -- local integer(I4B) :: i, j ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Set idense and reallocate denseterms to be of size MAXBOUND this%idense = 1 @@ -4865,14 +4684,13 @@ subroutine maw_activate_density(this) write (this%iout, '(/1x,a)') 'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW & &PACKAGE: '//trim(adjustl(this%packName)) ! - ! -- return + ! -- Return return end subroutine maw_activate_density !> @brief Activate viscosity terms - !! - !! Method to activate addition of viscosity terms for a MAW package reach. - !! + !! + !! Method to activate addition of viscosity terms for a MAW package reach. !< subroutine maw_activate_viscosity(this) ! -- modules @@ -4895,40 +4713,34 @@ subroutine maw_activate_viscosity(this) write (this%iout, '(/1x,a)') 'VISCOSITY HAS BEEN ACTIVATED FOR MAW & &PACKAGE: '//trim(adjustl(this%packName)) ! - ! -- return + ! -- Return return end subroutine maw_activate_viscosity + !> @brief Calculate the groundwater-maw density exchnage terms + !! + !! Arguments are as follows: + !! iconn : maw-gwf connection number + !! hmaw : maw head + !! hgwf : gwf head + !! cond : conductance + !! bmaw : bottom elevation of this connection + !! flow : calculated flow, updated here with density terms, + into maw + !! hcofterm : head coefficient term + !! rhsterm : right-hand-side value, updated here with density terms + !! + !! Member variable used here + !! denseterms : shape (3, MAXBOUND), filled by buoyancy package + !! col 1 is relative density of maw (densemaw / denseref) + !! col 2 is relative density of gwf cell (densegwf / denseref) + !! col 3 is elevation of gwf cell + !! + !! Upon return, amat and rhs for maw row should be updated as: + !! amat(idiag) = amat(idiag) - hcofterm + !! rhs(n) = rhs(n) + rhsterm + !< subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, & bmaw, flow, hcofterm, rhsterm) -! ****************************************************************************** -! maw_calculate_density_exchange -- Calculate the groundwater-maw density -! exchange terms. -! -! -- Arguments are as follows: -! iconn : maw-gwf connection number -! hmaw : maw head -! hgwf : gwf head -! cond : conductance -! bmaw : bottom elevation of this connection -! flow : calculated flow, updated here with density terms, + into maw -! hcofterm : head coefficient term -! rhsterm : right-hand-side value, updated here with density terms -! -! -- Member variable used here -! denseterms : shape (3, MAXBOUND), filled by buoyancy package -! col 1 is relative density of maw (densemaw / denseref) -! col 2 is relative density of gwf cell (densegwf / denseref) -! col 3 is elevation of gwf cell -! -! -- Upon return, amat and rhs for maw row should be updated as: -! amat(idiag) = amat(idiag) - hcofterm -! rhs(n) = rhs(n) + rhsterm -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(MawType), intent(inout) :: this integer(I4B), intent(in) :: iconn @@ -4947,7 +4759,6 @@ subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, & real(DP) :: rdenseavg real(DP) :: elevavg ! -- formats -! ------------------------------------------------------------------------------ ! ! -- assign relative density terms, return if zero which means not avail yet rdensemaw = this%denseterms(1, iconn) @@ -4988,7 +4799,7 @@ subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, & ! -- Flow should be zero so do nothing end if ! - ! -- return + ! -- Return return end subroutine maw_calculate_density_exchange diff --git a/src/Model/GroundWaterFlow/gwf3mvr8.f90 b/src/Model/GroundWaterFlow/gwf3mvr8.f90 index 842a13dd1b0..5488b31e0e9 100644 --- a/src/Model/GroundWaterFlow/gwf3mvr8.f90 +++ b/src/Model/GroundWaterFlow/gwf3mvr8.f90 @@ -113,7 +113,7 @@ module GwfMvrModule use NumericalPackageModule, only: NumericalPackageType use BlockParserModule, only: BlockParserType use GwfMvrPeriodDataModule, only: GwfMvrPeriodDataType - use PackageMoverModule, only: PackageMoverType + use PackageMoverModule, only: PackageMoverType, set_packagemover_pointer use BaseDisModule, only: DisBaseType use InputOutputModule, only: urword use TableModule, only: TableType, table_cr @@ -145,7 +145,9 @@ module GwfMvrModule ! ! -- table objects type(TableType), pointer :: outputtab => null() + contains + procedure :: mvr_init procedure :: mvr_ar procedure :: mvr_rp procedure :: mvr_ad @@ -163,23 +165,21 @@ module GwfMvrModule procedure :: read_packages procedure :: check_packages procedure :: assign_packagemovers + procedure :: initialize_movers + procedure :: fill_budobj procedure :: allocate_scalars procedure :: allocate_arrays procedure, private :: mvr_setup_budobj - procedure, private :: mvr_fill_budobj procedure, private :: mvr_setup_outputtab procedure, private :: mvr_print_outputtab + end type GwfMvrType contains + !> @brief Create a new mvr object + !< subroutine mvr_cr(mvrobj, name_parent, inunit, iout, dis, iexgmvr) -! ****************************************************************************** -! mvr_cr -- Create a new mvr object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(GwfMvrType), pointer :: mvrobj character(len=*), intent(in) :: name_parent @@ -187,55 +187,62 @@ subroutine mvr_cr(mvrobj, name_parent, inunit, iout, dis, iexgmvr) integer(I4B), intent(in) :: iout class(DisBaseType), pointer, intent(in) :: dis integer(I4B), optional :: iexgmvr -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (mvrobj) ! + ! -- Init + call mvrobj%mvr_init(name_parent, inunit, iout, dis, iexgmvr) + ! + ! -- Return + return + end subroutine mvr_cr + + subroutine mvr_init(this, name_parent, inunit, iout, dis, iexgmvr) + class(GwfMvrType) :: this + character(len=*), intent(in) :: name_parent + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + class(DisBaseType), pointer, intent(in) :: dis + integer(I4B), optional :: iexgmvr + ! ! -- create name and memory paths. name_parent will either be model name or the ! exchange name. - call mvrobj%set_names(1, name_parent, 'MVR', 'MVR') + call this%set_names(1, name_parent, 'MVR', 'MVR') ! ! -- Allocate scalars - call mvrobj%allocate_scalars() + call this%allocate_scalars() ! ! -- Set pointer to dis - mvrobj%dis => dis + this%dis => dis ! ! -- Set variables - mvrobj%inunit = inunit - mvrobj%iout = iout + this%inunit = inunit + this%iout = iout ! ! -- Set iexgmvr - if (present(iexgmvr)) mvrobj%iexgmvr = iexgmvr + if (present(iexgmvr)) this%iexgmvr = iexgmvr ! ! -- Create the budget object if (inunit > 0) then - call budget_cr(mvrobj%budget, mvrobj%memoryPath) + call budget_cr(this%budget, this%memoryPath) ! ! -- Initialize block parser - call mvrobj%parser%Initialize(mvrobj%inunit, mvrobj%iout) + call this%parser%Initialize(this%inunit, this%iout) end if ! ! -- instantiate the budget object - call budgetobject_cr(mvrobj%budobj, 'WATER MOVER') + call budgetobject_cr(this%budobj, 'WATER MOVER') ! ! -- Return return - end subroutine mvr_cr + end subroutine mvr_init + !> @brief Allocate and read water mover information + !< subroutine mvr_ar(this) -! ****************************************************************************** -! mvr_ar -- Allocate and read water mover information -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfMvrType) :: this - ! -- locals -! ------------------------------------------------------------------------------ ! ! -- Print a message identifying the water mover package. write (this%iout, 1) this%inunit @@ -267,15 +274,11 @@ subroutine mvr_ar(this) return end subroutine mvr_ar + !> @brief Read and Prepare + !! + !! Read itmp and read new boundaries if itmp > 0 + !< subroutine mvr_rp(this) -! ****************************************************************************** -! mvr_rp -- Read and Prepare -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use TdisModule, only: kper, nper @@ -297,7 +300,6 @@ subroutine mvr_rp(this) character(len=*), parameter :: fmtnbd = & "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, & &') IS GREATER THAN MAXIMUM(',I6,')')" -! ------------------------------------------------------------------------------ ! ! -- Set ionper to the stress period number for which a new block of data ! will be read. @@ -351,15 +353,10 @@ subroutine mvr_rp(this) call this%gwfmvrperioddata%read_from_parser(this%parser, nlist, mname) ! ! -- Process the input data into the individual mover objects + call this%initialize_movers(nlist) + ! + ! -- assign the pointers do i = 1, nlist - call this%mvr(i)%set_values(this%gwfmvrperioddata%mname1(i), & - this%gwfmvrperioddata%pname1(i), & - this%gwfmvrperioddata%id1(i), & - this%gwfmvrperioddata%mname2(i), & - this%gwfmvrperioddata%pname2(i), & - this%gwfmvrperioddata%id2(i), & - this%gwfmvrperioddata%imvrtype(i), & - this%gwfmvrperioddata%value(i)) call this%mvr(i)%prepare(this%parser%iuactive, & this%pckMemPaths, & this%pakmovers) @@ -374,16 +371,16 @@ subroutine mvr_rp(this) ! ! -- Check to make sure all providers and receivers are properly stored do i = 1, this%nmvr - ipos = ifind(this%pckMemPaths, this%mvr(i)%pckNameSrc) + ipos = ifind(this%pckMemPaths, this%mvr(i)%mem_path_src) if (ipos < 1) then write (errmsg, '(a,a,a)') 'Provider ', & - trim(this%mvr(i)%pckNameSrc), ' not listed in packages block.' + trim(this%mvr(i)%mem_path_src), ' not listed in packages block.' call store_error(errmsg) end if - ipos = ifind(this%pckMemPaths, this%mvr(i)%pckNameTgt) + ipos = ifind(this%pckMemPaths, this%mvr(i)%mem_path_tgt) if (ipos < 1) then write (errmsg, '(a,a,a)') 'Receiver ', & - trim(this%mvr(i)%pckNameTgt), ' not listed in packages block.' + trim(this%mvr(i)%mem_path_tgt), ' not listed in packages block.' call store_error(errmsg) end if end do @@ -398,8 +395,8 @@ subroutine mvr_rp(this) ! ! -- do i = 1, this%nmvr - ii = ifind(this%pckMemPaths, this%mvr(i)%pckNameSrc) - jj = ifind(this%pckMemPaths, this%mvr(i)%pckNameTgt) + ii = ifind(this%pckMemPaths, this%mvr(i)%mem_path_src) + jj = ifind(this%pckMemPaths, this%mvr(i)%mem_path_tgt) ipos = (ii - 1) * this%maxpackages + jj this%ientries(ipos) = this%ientries(ipos) + 1 end do @@ -408,23 +405,34 @@ subroutine mvr_rp(this) ! end if ! - ! -- return + ! -- Return return end subroutine mvr_rp + subroutine initialize_movers(this, nr_active_movers) + class(GwfMvrType) :: this + integer(I4B) :: nr_active_movers + ! local + integer(I4B) :: i + + do i = 1, nr_active_movers + call this%mvr(i)%set_values(this%gwfmvrperioddata%mname1(i), & + this%gwfmvrperioddata%pname1(i), & + this%gwfmvrperioddata%id1(i), & + this%gwfmvrperioddata%mname2(i), & + this%gwfmvrperioddata%pname2(i), & + this%gwfmvrperioddata%id2(i), & + this%gwfmvrperioddata%imvrtype(i), & + this%gwfmvrperioddata%value(i)) + end do + + end subroutine initialize_movers + subroutine mvr_ad(this) -! ****************************************************************************** -! mvr_ad -- Advance mover -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfMvrType) :: this ! -- locals integer(I4B) :: i -! ------------------------------------------------------------------------------ ! do i = 1, this%nmvr call this%mvr(i)%advance() @@ -434,35 +442,23 @@ subroutine mvr_ad(this) return end subroutine mvr_ad + !> @brief Calculate qfrommvr as a function of qtomvr + !< subroutine mvr_fc(this) -! ****************************************************************************** -! mvr_fc -- Calculate qfrommvr as a function of qtomvr -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy class(GwfMvrType) :: this - ! -- locals + ! local integer(I4B) :: i -! ------------------------------------------------------------------------------ - ! + do i = 1, this%nmvr - call this%mvr(i)%fc() + call this%mvr(i)%update_provider() + call this%mvr(i)%update_receiver() end do - ! - ! -- Return - return + end subroutine mvr_fc + !> @brief Extra convergence check for mover + !< subroutine mvr_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) -! ****************************************************************************** -! mvr_cc -- extra convergence check for mover -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfMvrType) :: this integer(I4B), intent(in) :: innertot @@ -472,12 +468,10 @@ subroutine mvr_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) character(len=LENPAKLOC), intent(inout) :: cpak integer(I4B), intent(inout) :: ipak real(DP), intent(inout) :: dpak - ! -- local ! -- formats character(len=*), parameter :: fmtmvrcnvg = & "(/,1x,'MOVER PACKAGE REQUIRES AT LEAST TWO OUTER ITERATIONS. CONVERGE & &FLAG HAS BEEN RESET TO FALSE.')" -! ------------------------------------------------------------------------------ ! ! -- If there are active movers, then at least 2 outers required if (this%nmvr > 0) then @@ -488,38 +482,40 @@ subroutine mvr_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) end if end if ! - ! -- return + ! -- Return return end subroutine mvr_cc + !> @brief Fill the mover budget object + !< subroutine mvr_bd(this) -! ****************************************************************************** -! mvr_bd -- fill the mover budget object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfMvrType) :: this ! -- locals + integer(I4B) :: i, mapped_id + class(PackageMoverType), pointer :: pkg_mvr ! -- formats ! ------------------------------------------------------------------------------ + ! + ! -- set the feature maps + allocate (pkg_mvr) + do i = 1, this%nmvr + call set_packagemover_pointer(pkg_mvr, this%mvr(i)%mem_path_src) + mapped_id = pkg_mvr%iprmap(this%mvr(i)%iRchNrSrc) + this%mvr(i)%iRchNrSrcMapped = mapped_id + end do + deallocate (pkg_mvr) ! ! -- fill the budget object - call this%mvr_fill_budobj() + call this%fill_budobj() ! ! -- Return return end subroutine mvr_bd + !> @brief Write mover terms + !< subroutine mvr_bdsav(this, icbcfl, ibudfl, isuppress_output) -! ****************************************************************************** -! mvr_bd -- Write mover terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper, delt, pertim, totim ! -- dummy @@ -532,7 +528,6 @@ subroutine mvr_bdsav(this, icbcfl, ibudfl, isuppress_output) ! -- formats character(len=*), parameter :: fmttkk = & "(1X,/1X,A,' PERIOD ',I0,' STEP ',I0)" -! ------------------------------------------------------------------------------ ! ! -- Print the mover flow table if (ibudfl /= 0 .and. this%iprflow /= 0 .and. isuppress_output == 0) then @@ -555,13 +550,9 @@ subroutine mvr_bdsav(this, icbcfl, ibudfl, isuppress_output) return end subroutine mvr_bdsav + !> @brief Write mover terms + !< subroutine mvr_ot_saveflow(this, icbcfl, ibudfl) -! ****************************************************************************** -! mvr_bd -- Write mover terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper, delt, pertim, totim ! -- dummy @@ -570,7 +561,6 @@ subroutine mvr_ot_saveflow(this, icbcfl, ibudfl) integer(I4B), intent(in) :: ibudfl ! -- locals integer(I4B) :: ibinun -! ------------------------------------------------------------------------------ ! ! -- Save the mover flows from the budobj to a mover binary file ibinun = 0 @@ -587,20 +577,13 @@ subroutine mvr_ot_saveflow(this, icbcfl, ibudfl) return end subroutine mvr_ot_saveflow + !> @brief Print mover flow table + !< subroutine mvr_ot_printflow(this, icbcfl, ibudfl) -! ****************************************************************************** -! mvr_ot_printflow -- Print mover flow table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfMvrType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl - ! -- locals -! ------------------------------------------------------------------------------ ! ! -- Print the mover flow table if (ibudfl /= 0 .and. this%iprflow /= 0) then @@ -611,13 +594,9 @@ subroutine mvr_ot_printflow(this, icbcfl, ibudfl) return end subroutine mvr_ot_printflow + !> @brief Write mover budget to listing file + !< subroutine mvr_ot_bdsummary(this, ibudfl) -! ****************************************************************************** -! mvr_ot -- Write mover budget to listing file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper, delt, totim use ArrayHandlersModule, only: ifind, expandarray @@ -628,7 +607,6 @@ subroutine mvr_ot_bdsummary(this, ibudfl) character(len=LENMEMPATH) :: pckMemPath integer(I4B) :: i, j real(DP), allocatable, dimension(:) :: ratin, ratout -! ------------------------------------------------------------------------------ ! ! -- Allocate and initialize ratin/ratout allocate (ratin(this%maxpackages), ratout(this%maxpackages)) @@ -640,10 +618,10 @@ subroutine mvr_ot_bdsummary(this, ibudfl) ! -- Accumulate the rates do i = 1, this%nmvr do j = 1, this%maxpackages - if (this%pckMemPaths(j) == this%mvr(i)%pckNameSrc) then + if (this%pckMemPaths(j) == this%mvr(i)%mem_path_src) then ratin(j) = ratin(j) + this%mvr(i)%qpactual end if - if (this%pckMemPaths(j) == this%mvr(i)%pckNameTgt) then + if (this%pckMemPaths(j) == this%mvr(i)%mem_path_tgt) then ratout(j) = ratout(j) + this%mvr(i)%qpactual end if end do @@ -681,20 +659,14 @@ subroutine mvr_ot_bdsummary(this, ibudfl) return end subroutine mvr_ot_bdsummary + !> @brief Deallocate + !< subroutine mvr_da(this) -! ****************************************************************************** -! mvr_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwfMvrType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Arrays if (this%inunit > 0) then @@ -743,13 +715,9 @@ subroutine mvr_da(this) return end subroutine mvr_da + !> @brief Read options specified in the input options block + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, DZERO, DONE use OpenSpecModule, only: access, form @@ -766,7 +734,6 @@ subroutine read_options(this) character(len=*), parameter :: fmtmvrbin = & "(4x, 'MVR ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON & &UNIT: ', I0)" -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, & @@ -838,13 +805,9 @@ subroutine read_options(this) return end subroutine read_options + !> @brief Check MODELNAMES option set correctly + !< subroutine check_options(this) -! ****************************************************************************** -! check_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, store_error_unit @@ -852,8 +815,6 @@ subroutine check_options(this) class(GwfMvrType) :: this ! -- local character(len=LINELENGTH) :: errmsg - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Check if not exchange mover but model names are specified if (this%iexgmvr == 0 .and. this%imodelnames == 1) then @@ -877,13 +838,9 @@ subroutine check_options(this) return end subroutine check_options + !> @brief Read the dimensions for this package + !< subroutine read_dimensions(this) -! ****************************************************************************** -! read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -895,8 +852,6 @@ subroutine read_dimensions(this) logical :: isfound, endOfBlock integer(I4B) :: i integer(I4B) :: j - ! -- format -! ------------------------------------------------------------------------------ ! ! -- get dimensions block call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -951,17 +906,13 @@ subroutine read_dimensions(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine read_dimensions + !> @brief Read the packages that will be managed by this mover + !< subroutine read_packages(this) -! ****************************************************************************** -! read_packages -- Read the packages that will be managed by this mover -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use MemoryHelperModule, only: create_mem_path @@ -973,8 +924,6 @@ subroutine read_packages(this) integer(I4B) :: lloc, ierr integer(I4B) :: npak logical :: isfound, endOfBlock - ! -- format -! ------------------------------------------------------------------------------ ! ! -- get packages block call this%parser%GetBlock('PACKAGES', isfound, ierr, & @@ -998,9 +947,8 @@ subroutine read_packages(this) this%pckMemPaths(npak) = create_mem_path(this%name_model, word1) word = word1 else - this%pckMemPaths(npak) = trim(word1) call this%parser%GetStringCaps(word2) - this%pckMemPaths(npak) = create_mem_path(this%pckMemPaths(npak), word2) + this%pckMemPaths(npak) = create_mem_path(word1, word2) word = word2 end if this%paknames(npak) = trim(word) @@ -1022,17 +970,13 @@ subroutine read_packages(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine read_packages + !> @brief Check to make sure packages have mover activated + !< subroutine check_packages(this) -! ****************************************************************************** -! check_packages -- check to make sure packages have mover activated -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use MemoryManagerModule, only: mem_setptr @@ -1043,8 +987,6 @@ subroutine check_packages(this) character(len=LINELENGTH) :: errmsg integer(I4B) :: i integer(I4B), pointer :: imover_ptr - ! -- format -! ------------------------------------------------------------------------------ ! ! -- Check to make sure mover is activated for each package do i = 1, size(this%pckMemPaths) @@ -1064,25 +1006,19 @@ subroutine check_packages(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine check_packages + !> @brief Assign pointer to each package's packagemover object + !< subroutine assign_packagemovers(this) -! ****************************************************************************** -! assign_packagemovers -- assign pointer to each package's packagemover object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use PackageMoverModule, only: set_packagemover_pointer ! -- dummy class(GwfMvrType), intent(inout) :: this ! -- local integer(I4B) :: i - ! -- format -! ------------------------------------------------------------------------------ ! ! -- Assign the package mover pointer if it hasn't been assigned yet do i = 1, size(this%pckMemPaths) @@ -1092,24 +1028,18 @@ subroutine assign_packagemovers(this) end if end do ! - ! -- return + ! -- Return return end subroutine assign_packagemovers + !> @brief Allocate package scalars + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwfMvrType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -1141,13 +1071,9 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate package arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use ConstantsModule, only: DZERO @@ -1156,7 +1082,6 @@ subroutine allocate_arrays(this) class(GwfMvrType) :: this ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- Allocate allocate (this%mvr(this%maxmvr)) @@ -1188,13 +1113,9 @@ subroutine allocate_arrays(this) return end subroutine allocate_arrays + !> @brief Set up the budget object that stores all the mvr flows + !< subroutine mvr_setup_budobj(this) -! ****************************************************************************** -! mvr_setup_budobj -- Set up the budget object that stores all the mvr flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT use MemoryHelperModule, only: split_mem_path @@ -1211,7 +1132,6 @@ subroutine mvr_setup_budobj(this) integer(I4B) :: maxlist integer(I4B) :: idx character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! ! -- Determine the number of mover budget terms. These are fixed for ! the simulation and cannot change. A separate term is required @@ -1253,11 +1173,11 @@ subroutine mvr_setup_budobj(this) end do end do ! - ! -- return + ! -- Return return end subroutine mvr_setup_budobj - subroutine mvr_fill_budobj(this) + subroutine fill_budobj(this) ! ****************************************************************************** ! mvr_fill_budobj -- copy flow terms into this%budobj ! ****************************************************************************** @@ -1283,8 +1203,6 @@ subroutine mvr_fill_budobj(this) character(len=LENPACKAGENAME) :: packagename1, packagename2 character(len=LENMEMPATH) :: pckMemPathsDummy real(DP) :: q - ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 @@ -1321,15 +1239,14 @@ subroutine mvr_fill_budobj(this) ! ! -- pname1 is provider, pname2 is receiver ! flow is always negative because it is coming from provider - if (this%pckMemPaths(i) == this%mvr(n)%pckNameSrc) then - if (this%pckMemPaths(j) == this%mvr(n)%pckNameTgt) then + if (this%pckMemPaths(i) == this%mvr(n)%mem_path_src) then + if (this%pckMemPaths(j) == this%mvr(n)%mem_path_tgt) then ! ! -- set q to qpactual q = -this%mvr(n)%qpactual ! - ! -- map from irch1 to feature (needed for lake to map outlet to lake number) - n1 = this%mvr(n)%iRchNrSrc - n1 = this%pakmovers(i)%iprmap(n1) + ! -- use mapped index (needed for lake to map outlet to lake number) + n1 = this%mvr(n)%iRchNrSrcMapped ! ! -- set receiver id to irch2 n2 = this%mvr(n)%iRchNrTgt @@ -1345,17 +1262,13 @@ subroutine mvr_fill_budobj(this) ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return - end subroutine mvr_fill_budobj + end subroutine fill_budobj + !> @brief Set up output table + !< subroutine mvr_setup_outputtab(this) -! ****************************************************************************** -! mvr_setup_outputtab -- set up output table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfMvrType), intent(inout) :: this ! -- local @@ -1363,7 +1276,6 @@ subroutine mvr_setup_outputtab(this) character(len=LINELENGTH) :: text integer(I4B) :: ntabcol integer(I4B) :: ilen -! ------------------------------------------------------------------------------ ! ! -- allocate and initialize the output table if (this%iprflow /= 0) then @@ -1393,20 +1305,16 @@ subroutine mvr_setup_outputtab(this) call this%outputtab%initialize_column(text, ilen) text = 'RECEIVER ID' call this%outputtab%initialize_column(text, 10) - + ! end if ! - ! -- return + ! -- Return return end subroutine mvr_setup_outputtab + !> @brief Set up output table + !< subroutine mvr_print_outputtab(this) -! ****************************************************************************** -! mvr_setup_outputtab -- set up output table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use TdisModule, only: kstp, kper ! -- dummy @@ -1414,7 +1322,6 @@ subroutine mvr_print_outputtab(this) ! -- local character(len=LINELENGTH) :: title integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- set table kstp and kper call this%outputtab%set_kstpkper(kstp, kper) @@ -1426,15 +1333,15 @@ subroutine mvr_print_outputtab(this) call this%outputtab%set_maxbound(this%nmvr) do i = 1, this%nmvr call this%outputtab%add_term(i) - call this%outputtab%add_term(this%mvr(i)%pckNameSrc) + call this%outputtab%add_term(this%mvr(i)%mem_path_src) call this%outputtab%add_term(this%mvr(i)%iRchNrSrc) call this%outputtab%add_term(this%mvr(i)%qavailable) call this%outputtab%add_term(this%mvr(i)%qpactual) - call this%outputtab%add_term(this%mvr(i)%pckNameTgt) + call this%outputtab%add_term(this%mvr(i)%mem_path_tgt) call this%outputtab%add_term(this%mvr(i)%iRchNrTgt) end do ! - ! -- return + ! -- Return return end subroutine mvr_print_outputtab diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90 index fd60dd91cc2..e02a183b87c 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8.f90 @@ -1,5 +1,6 @@ module GwfNpfModule use KindModule, only: DP, I4B + use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO, DEM9, DEM8, DEM7, DEM6, DEM2, & DHALF, DP9, DONE, DTWO, & DLNLOW, DLNHIGH, & @@ -102,8 +103,9 @@ module GwfNpfModule integer(I4B), pointer :: kchangeper => null() ! last stress period in which any node K (or K22, or K33) values were changed (0 if unchanged from start of simulation) integer(I4B), pointer :: kchangestp => null() ! last time step in which any node K (or K22, or K33) values were changed (0 if unchanged from start of simulation) integer(I4B), dimension(:), pointer, contiguous :: nodekchange => null() ! grid array of flags indicating for each node whether its K (or K22, or K33) value changed (1) at (kchangeper, kchangestp) or not (0) - ! + contains + procedure :: npf_df procedure :: npf_ac procedure :: npf_mc @@ -143,18 +145,15 @@ module GwfNpfModule procedure, public :: increase_edge_count procedure, public :: set_edge_properties procedure, public :: calcSatThickness + end type contains + !> @brief Create a new NPF object. Pass a inunit value of 0 if npf data will + !! initialized from memory + !< subroutine npf_cr(npfobj, name_model, input_mempath, inunit, iout) -! ****************************************************************************** -! npf_cr -- Create a new NPF object. Pass a inunit value of 0 if npf data will -! initialized from memory -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use KindModule, only: LGP use MemoryManagerExtModule, only: mem_set_value @@ -164,32 +163,24 @@ subroutine npf_cr(npfobj, name_model, input_mempath, inunit, iout) character(len=*), intent(in) :: input_mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout - ! -- locals - logical(LGP) :: found_fname ! -- formats character(len=*), parameter :: fmtheader = & "(1x, /1x, 'NPF -- NODE PROPERTY FLOW PACKAGE, VERSION 1, 3/30/2015', & &' INPUT READ FROM MEMPATH: ', A, /)" -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (npfobj) ! ! -- create name and memory path - call npfobj%set_names(1, name_model, 'NPF', 'NPF') + call npfobj%set_names(1, name_model, 'NPF', 'NPF', input_mempath) ! ! -- Allocate scalars call npfobj%allocate_scalars() ! ! -- Set variables - npfobj%input_mempath = input_mempath npfobj%inunit = inunit npfobj%iout = iout ! - ! -- set name of input file - call mem_set_value(npfobj%input_fname, 'INPUT_FNAME', npfobj%input_mempath, & - found_fname) - ! ! -- check if npf is enabled if (inunit > 0) then ! @@ -201,7 +192,7 @@ subroutine npf_cr(npfobj, name_model, input_mempath, inunit, iout) return end subroutine npf_cr - !> @brief define the NPF package instance + !> @brief Define the NPF package instance !! !! This is a hybrid routine: it either reads the options for this package !! from the input file, or the optional argument @param npf_options @@ -209,12 +200,6 @@ end subroutine npf_cr !! xt3d_df is called, when enabled. !< subroutine npf_df(this, dis, xt3d, ingnc, invsc, npf_options) -! ****************************************************************************** -! npf_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error use Xt3dModule, only: xt3d_cr @@ -225,9 +210,6 @@ subroutine npf_df(this, dis, xt3d, ingnc, invsc, npf_options) integer(I4B), intent(in) :: ingnc !< ghostnodes enabled? (>0 means yes) integer(I4B), intent(in) :: invsc !< viscosity enabled? (>0 means yes) type(GwfNpfOptionsType), optional, intent(in) :: npf_options !< the optional options, for when not constructing from file - ! -- local - ! -- data -! ------------------------------------------------------------------------------ ! ! -- Set a pointer to dis this%dis => dis @@ -252,7 +234,7 @@ subroutine npf_df(this, dis, xt3d, ingnc, invsc, npf_options) ! -- allocate arrays call this%allocate_arrays(this%dis%nodes, this%dis%njas) end if - + ! call this%check_options() ! ! -- Save pointer to xt3d object @@ -271,21 +253,15 @@ subroutine npf_df(this, dis, xt3d, ingnc, invsc, npf_options) return end subroutine npf_df + !> @brief Add connections for extended neighbors to the sparse matrix + !< subroutine npf_ac(this, moffset, sparse) -! ****************************************************************************** -! npf_ac -- Add connections for extended neighbors to the sparse matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix ! -- dummy class(GwfNpftype) :: this integer(I4B), intent(in) :: moffset type(sparsematrix), intent(inout) :: sparse - ! -- local -! ------------------------------------------------------------------------------ ! ! -- Add extended neighbors (neighbors of neighbors) if (this%ixt3d /= 0) call this%xt3d%xt3d_ac(moffset, sparse) @@ -294,20 +270,13 @@ subroutine npf_ac(this, moffset, sparse) return end subroutine npf_ac + !> @brief Map connections and construct iax, jax, and idxglox + !< subroutine npf_mc(this, moffset, matrix_sln) -! ****************************************************************************** -! npf_mc -- Map connections and construct iax, jax, and idxglox -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpftype) :: this integer(I4B), intent(in) :: moffset class(MatrixBaseType), pointer :: matrix_sln - ! -- local -! ------------------------------------------------------------------------------ ! if (this%ixt3d /= 0) call this%xt3d%xt3d_mc(moffset, matrix_sln) ! @@ -315,18 +284,12 @@ subroutine npf_mc(this, moffset, matrix_sln) return end subroutine npf_mc - !> @brief allocate and read this NPF instance + !> @brief Allocate and read this NPF instance !! !! Allocate remaining package arrays, preprocess the input data and !! call *_ar on xt3d, when active. !< subroutine npf_ar(this, ic, vsc, ibound, hnew) -! ****************************************************************************** -! npf_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_reallocate ! -- dummy @@ -337,9 +300,6 @@ subroutine npf_ar(this, ic, vsc, ibound, hnew) real(DP), dimension(:), pointer, contiguous, intent(inout) :: hnew !< pointer to model head array ! -- local integer(I4B) :: n - ! -- formats - ! -- data -! ------------------------------------------------------------------------------ ! ! -- Store pointers to arguments that were passed in this%ic => ic @@ -361,7 +321,6 @@ subroutine npf_ar(this, ic, vsc, ibound, hnew) if (this%invsc /= 0) then this%vsc => vsc end if - ! ! -- allocate arrays to store original user input in case TVK/VSC modify them if (this%invsc > 0) then @@ -403,10 +362,10 @@ end subroutine npf_ar !> @brief Read and prepare method for package !! !! Read and prepare NPF stress period data. - !! !< subroutine npf_rp(this) implicit none + ! -- dummy class(GwfNpfType) :: this ! ! -- TVK @@ -414,27 +373,27 @@ subroutine npf_rp(this) call this%tvk%rp() end if ! + ! -- Return return end subroutine npf_rp + !> @brief Advance + !! + !! Sets hold (head old) to bot whenever a wettable cell is dry + !< subroutine npf_ad(this, nodes, hold, hnew, irestore) -! ****************************************************************************** -! npf_ad -- Advance -! Subroutine (1) Sets hold to bot whenever a wettable cell is dry -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use TdisModule, only: kper, kstp ! implicit none + ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: nodes real(DP), dimension(nodes), intent(inout) :: hold real(DP), dimension(nodes), intent(inout) :: hnew integer(I4B), intent(in) :: irestore + ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- loop through all cells and set hold=bot if wettable cell is dry if (this%irewet > 0) then @@ -487,13 +446,9 @@ subroutine npf_ad(this, nodes, hold, hnew, irestore) return end subroutine npf_ad + !> @brief Routines associated fill coefficients + !< subroutine npf_cf(this, kiter, nodes, hnew) -! ****************************************************************************** -! npf_cf -- Formulate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this integer(I4B) :: kiter @@ -502,7 +457,6 @@ subroutine npf_cf(this, kiter, nodes, hnew) ! -- local integer(I4B) :: n real(DP) :: satn -! ------------------------------------------------------------------------------ ! ! -- Perform wetting and drying if (this%inewton /= 1) then @@ -525,13 +479,9 @@ subroutine npf_cf(this, kiter, nodes, hnew) return end subroutine npf_cf + !> @brief Formulate coefficients + !< subroutine npf_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! npf_fc -- Formulate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE ! -- dummy @@ -546,7 +496,6 @@ subroutine npf_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) integer(I4B) :: isymcon, idiagm real(DP) :: hyn, hym real(DP) :: cond -! ------------------------------------------------------------------------------ ! ! -- Calculate conductance and put into amat ! @@ -639,13 +588,9 @@ subroutine npf_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) return end subroutine npf_fc + !> @brief Fill newton terms + !< subroutine npf_fn(this, kiter, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! npf_fn -- Fill newton terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this integer(I4B) :: kiter @@ -670,10 +615,8 @@ subroutine npf_fn(this, kiter, matrix_sln, idxglo, rhs, hnew) real(DP) :: botup real(DP) :: topdn real(DP) :: botdn -! ------------------------------------------------------------------------------ ! ! -- add newton terms to solution matrix - ! nodes = this%dis%nodes nja = this%dis%con%nja if (this%ixt3d /= 0) then @@ -784,16 +727,12 @@ subroutine npf_fn(this, kiter, matrix_sln, idxglo, rhs, hnew) return end subroutine npf_fn + !> @brief Under-relaxation + !! + !! Under-relaxation of Groundwater Flow Model Heads for current outer + !! iteration using the cell bottoms at the bottom of the model + !< subroutine npf_nur(this, neqmod, x, xtemp, dx, inewtonur, dxmax, locmax) -! ****************************************************************************** -! bnd_nur -- under-relaxation -! Subroutine: (1) Under-relaxation of Groundwater Flow Model Heads for current -! outer iteration using the cell bottoms at the bottom of the -! model -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: neqmod @@ -808,8 +747,6 @@ subroutine npf_nur(this, neqmod, x, xtemp, dx, inewtonur, dxmax, locmax) real(DP) :: botm real(DP) :: xx real(DP) :: dxx -! ------------------------------------------------------------------------------ - ! ! -- Newton-Raphson under-relaxation do n = 1, this%dis%nodes @@ -832,17 +769,13 @@ subroutine npf_nur(this, neqmod, x, xtemp, dx, inewtonur, dxmax, locmax) end if end do ! - ! -- return + ! -- Return return end subroutine npf_nur + !> @brief Calculate flowja + !< subroutine npf_cq(this, hnew, flowja) -! ****************************************************************************** -! npf_cq -- Calculate flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this real(DP), intent(inout), dimension(:) :: hnew @@ -850,7 +783,6 @@ subroutine npf_cq(this, hnew, flowja) ! -- local integer(I4B) :: n, ipos, m real(DP) :: qnm -! ------------------------------------------------------------------------------ ! ! -- Calculate the flow across each cell face and store in flowja ! @@ -874,19 +806,14 @@ subroutine npf_cq(this, hnew, flowja) return end subroutine npf_cq + !> @brief Fractional cell saturation + !< subroutine sgwf_npf_thksat(this, n, hn, thksat) -! ****************************************************************************** -! sgwf_npf_thksat -- Fractional cell saturation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: n real(DP), intent(in) :: hn real(DP), intent(inout) :: thksat -! ------------------------------------------------------------------------------ ! ! -- Standard Formulation if (hn >= this%dis%top(n)) then @@ -906,13 +833,9 @@ subroutine sgwf_npf_thksat(this, n, hn, thksat) return end subroutine sgwf_npf_thksat + !> @brief Flow between two cells + !< subroutine sgwf_npf_qcalc(this, n, m, hn, hm, icon, qnm) -! ****************************************************************************** -! sgwf_npf_qcalc -- Flow between two cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: n @@ -926,7 +849,6 @@ subroutine sgwf_npf_qcalc(this, n, m, hn, hm, icon, qnm) real(DP) :: condnm real(DP) :: hntemp, hmtemp integer(I4B) :: ihc -! ------------------------------------------------------------------------------ ! ! -- Initialize ihc = this%dis%con%ihc(this%dis%con%jas(icon)) @@ -986,13 +908,9 @@ subroutine sgwf_npf_qcalc(this, n, m, hn, hm, icon, qnm) return end subroutine sgwf_npf_qcalc + !> @brief Record flowja and calculate specific discharge if requested + !< subroutine npf_save_model_flows(this, flowja, icbcfl, icbcun) -! ****************************************************************************** -! npf_save_model_flows -- Record flowja and calculate specific discharge if requested -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfNpfType) :: this real(DP), dimension(:), intent(in) :: flowja @@ -1000,9 +918,6 @@ subroutine npf_save_model_flows(this, flowja, icbcfl, icbcun) integer(I4B), intent(in) :: icbcun ! -- local integer(I4B) :: ibinun - !data - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Set unit number for binary output if (this%ipakcb < 0) then @@ -1033,13 +948,9 @@ subroutine npf_save_model_flows(this, flowja, icbcfl, icbcun) return end subroutine npf_save_model_flows + !> @brief Print budget + !< subroutine npf_print_model_flows(this, ibudfl, flowja) -! ****************************************************************************** -! npf_ot -- Budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kper, kstp use ConstantsModule, only: LENBIGLINE @@ -1055,7 +966,6 @@ subroutine npf_print_model_flows(this, ibudfl, flowja) ! -- formats character(len=*), parameter :: fmtiprflow = & &"(/,4x,'CALCULATED INTERCELL FLOW FOR PERIOD ', i0, ' STEP ', i0)" -! ------------------------------------------------------------------------------ ! ! -- Write flowja to list file if requested if (ibudfl /= 0 .and. this%iprflow > 0) then @@ -1080,19 +990,14 @@ subroutine npf_print_model_flows(this, ibudfl, flowja) return end subroutine npf_print_model_flows + !> @brief Deallocate variables + !< subroutine npf_da(this) -! ****************************************************************************** -! npf_da -- Deallocate variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerExtModule, only: memorylist_remove use SimVariablesModule, only: idm_context ! -- dummy class(GwfNpftype) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate input memory call memorylist_remove(this%name_model, 'NPF', idm_context) @@ -1182,14 +1087,12 @@ end subroutine npf_da !! !! Allocate and initialize scalars for the VSC package. The base model !! allocate scalars method is also called. - !! !< subroutine allocate_scalars(this) ! -- modules use MemoryHelperModule, only: create_mem_path ! -- dummy class(GwfNpftype) :: this -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -1284,14 +1187,12 @@ end subroutine allocate_scalars !> @ brief Store backup copy of hydraulic conductivity when the VSC !! package is activate !! - !! The K arrays (K11, etc.) get multiplied by the viscosity ratio - !! so that subsequent uses of K already take into account the effect - !! of viscosity. Thus the original user-specified K array values are - !! lost unless they are backed up in k11input, for example. In a new - !! stress period/time step, the values in k11input are multiplied by - !! the viscosity ratio, not k11 since it contains viscosity-adjusted - !! hydraulic conductivity values. - !! + !! The K arrays (K11, etc.) get multiplied by the viscosity ratio so that + !! subsequent uses of K already take into account the effect of viscosity. + !! Thus the original user-specified K array values are lost unless they are + !! backed up in k11input, for example. In a new stress period/time step, + !! the values in k11input are multiplied by the viscosity ratio, not k11 + !! since it contains viscosity-adjusted hydraulic conductivity values. !< subroutine store_original_k_arrays(this, ncells, njas) ! -- modules @@ -1302,7 +1203,6 @@ subroutine store_original_k_arrays(this, ncells, njas) integer(I4B), intent(in) :: njas ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- Retain copy of user-specified K arrays do n = 1, ncells @@ -1315,21 +1215,15 @@ subroutine store_original_k_arrays(this, ncells, njas) return end subroutine store_original_k_arrays + !> @brief Allocate npf arrays + !< subroutine allocate_arrays(this, ncells, njas) -! ****************************************************************************** -! allocate_arrays -- Allocate npf arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpftype) :: this integer(I4B), intent(in) :: ncells integer(I4B), intent(in) :: njas ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! call mem_allocate(this%ithickstartflag, ncells, 'ITHICKSTARTFLAG', & this%memoryPath) @@ -1379,17 +1273,13 @@ subroutine allocate_arrays(this, ncells, njas) ' WETDRY', ' ANGLE1', & ' ANGLE2', ' ANGLE3'] ! - ! -- return + ! -- Return return end subroutine allocate_arrays + !> @brief Log npf options sourced from the input mempath + !< subroutine log_options(this, found) -! ****************************************************************************** -! log_options -- log npf options sourced from the input mempath -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use KindModule, only: LGP use GwfNpfInputModule, only: GwfNpfParamFoundType @@ -1397,7 +1287,6 @@ subroutine log_options(this, found) class(GwfNpftype) :: this ! -- locals type(GwfNpfParamFoundType), intent(in) :: found -! ------------------------------------------------------------------------------ ! write (this%iout, '(1x,a)') 'Setting NPF Options' if (found%iprflow) & @@ -1464,19 +1353,21 @@ subroutine log_options(this, found) write (this%iout, '(4x,a,i5)') & 'Head rewet equation (IHDWET) has been set to: ', this%ihdwet write (this%iout, '(1x,a,/)') 'End Setting NPF Options' - + ! + ! -- Return + return end subroutine log_options + !> @brief Update simulation options from input mempath + !< subroutine source_options(this) -! ****************************************************************************** -! source_options -- update simulation options from input mempath -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules + use SimModule, only: store_error, store_error_filename + use MemoryManagerModule, only: mem_setptr, get_isize use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType use GwfNpfInputModule, only: GwfNpfParamFoundType + use SourceCommonModule, only: filein_fname ! -- dummy class(GwfNpftype) :: this ! -- locals @@ -1484,7 +1375,6 @@ subroutine source_options(this) &[character(len=LENVARNAME) :: 'LOGARITHMIC', 'AMT-LMK', 'AMT-HMK'] type(GwfNpfParamFoundType) :: found character(len=LINELENGTH) :: tvk6_filename -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow) @@ -1508,8 +1398,6 @@ subroutine source_options(this) found%ik22overk) call mem_set_value(this%ik33overk, 'IK33OVERK', this%input_mempath, & found%ik33overk) - call mem_set_value(tvk6_filename, 'TVK6_FILENAME', this%input_mempath, & - found%tvk6_filename) call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton) call mem_set_value(this%iusgnrhc, 'IUSGNRHC', this%input_mempath, & found%iusgnrhc) @@ -1531,19 +1419,19 @@ subroutine source_options(this) ! -- save specific discharge active if (found%isavspdis) this%icalcspdis = this%isavspdis ! - ! -- TVK6 subpackage file spec provided - if (found%tvk6_filename) then - this%intvk = GetUnit() - call openfile(this%intvk, this%iout, tvk6_filename, 'TVK') - call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout) - end if - ! ! -- no newton specified if (found%inewton) then this%inewton = 0 this%iasym = 0 end if ! + ! -- enforce 0 or 1 TVK6_FILENAME entries in option block + if (filein_fname(tvk6_filename, 'TVK6_FILENAME', this%input_mempath, & + this%input_fname)) then + call openfile(this%intvk, this%iout, tvk6_filename, 'TVK') + call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout) + end if + ! ! -- log options if (this%iout > 0) then call this%log_options(found) @@ -1553,10 +1441,13 @@ subroutine source_options(this) return end subroutine source_options + !> @brief Set options in the NPF object + !< subroutine set_options(this, options) + ! -- dummy class(GwfNpftype) :: this type(GwfNpfOptionsType), intent(in) :: options - + ! this%icellavg = options%icellavg this%ithickstrt = options%ithickstrt this%iperched = options%iperched @@ -1566,24 +1457,20 @@ subroutine set_options(this, options) this%wetfct = options%wetfct this%iwetit = options%iwetit this%ihdwet = options%ihdwet - + ! + ! -- Return + return end subroutine set_options + !> @brief Check for conflicting NPF options + !< subroutine check_options(this) -! ****************************************************************************** -! check_options -- Check for conflicting NPF options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error, count_errors, store_error_filename use ConstantsModule, only: LINELENGTH ! -- dummy class(GwfNpftype) :: this - ! -- local - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ + ! ! -- check if this%iusgnrhc has been enabled for a model that is not using ! the Newton-Raphson formulation if (this%iusgnrhc > 0 .and. this%inewton == 0) then @@ -1684,59 +1571,59 @@ end subroutine check_options !> @brief Write dimensions to list file !< subroutine log_griddata(this, found) + ! -- modules use GwfNpfInputModule, only: GwfNpfParamFoundType + ! -- dummy class(GwfNpfType) :: this type(GwfNpfParamFoundType), intent(in) :: found - + ! write (this%iout, '(1x,a)') 'Setting NPF Griddata' - + ! if (found%icelltype) then write (this%iout, '(4x,a)') 'ICELLTYPE set from input file' end if - + ! if (found%k) then write (this%iout, '(4x,a)') 'K set from input file' end if - + ! if (found%k33) then write (this%iout, '(4x,a)') 'K33 set from input file' else write (this%iout, '(4x,a)') 'K33 not provided. Setting K33 = K.' end if - + ! if (found%k22) then write (this%iout, '(4x,a)') 'K22 set from input file' else write (this%iout, '(4x,a)') 'K22 not provided. Setting K22 = K.' end if - + ! if (found%wetdry) then write (this%iout, '(4x,a)') 'WETDRY set from input file' end if - + ! if (found%angle1) then write (this%iout, '(4x,a)') 'ANGLE1 set from input file' end if - + ! if (found%angle2) then write (this%iout, '(4x,a)') 'ANGLE2 set from input file' end if - + ! if (found%angle3) then write (this%iout, '(4x,a)') 'ANGLE3 set from input file' end if - + ! write (this%iout, '(1x,a,/)') 'End Setting NPF Griddata' - + ! + ! -- Return + return end subroutine log_griddata + !> @brief Update simulation griddata from input mempath + !< subroutine source_griddata(this) -! ****************************************************************************** -! source_griddata -- update simulation griddata from input mempath -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: count_errors, store_error use MemoryManagerModule, only: mem_reallocate @@ -1749,8 +1636,6 @@ subroutine source_griddata(this) type(GwfNpfParamFoundType) :: found logical, dimension(2) :: afound integer(I4B), dimension(:), pointer, contiguous :: map - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set map to convert user input data into reduced data map => null() @@ -1828,13 +1713,10 @@ subroutine source_griddata(this) return end subroutine source_griddata + !> @brief Initialize and check NPF data + !< subroutine prepcheck(this) -! ****************************************************************************** -! prepcheck -- Initialize and check NPF data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: LINELENGTH, DPIO180 use SimModule, only: store_error, count_errors, store_error_filename ! -- dummy @@ -1848,7 +1730,6 @@ subroutine prepcheck(this) &"(1x, 'Hydraulic property ',a,' is <= 0 for cell ',a, ' ', 1pg15.6)" character(len=*), parameter :: fmtkerr2 = & &"(1x, '... ', i0,' additional errors not shown for ',a)" -! ------------------------------------------------------------------------------ ! ! -- initialize aname => this%aname @@ -1983,7 +1864,8 @@ subroutine prepcheck(this) if (count_errors() > 0) then call store_error_filename(this%input_fname) end if - + ! + ! -- Return return end subroutine prepcheck @@ -1998,10 +1880,12 @@ end subroutine prepcheck !! 5. If NEWTON under-relaxation, determine lower most node !< subroutine preprocess_input(this) + ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_filename + ! -- dummy class(GwfNpfType) :: this !< the instance of the NPF package - ! local + ! -- local integer(I4B) :: n, m, ii, nn real(DP) :: hyn, hym real(DP) :: satn, topn, botn @@ -2009,7 +1893,7 @@ subroutine preprocess_input(this) real(DP) :: minbot, botm logical :: finished character(len=LINELENGTH) :: cellstr, errmsg - ! format strings + ! -- format character(len=*), parameter :: fmtcnv = & "(1X,'CELL ', A, & &' ELIMINATED BECAUSE ALL HYDRAULIC CONDUCTIVITIES TO NODE ARE 0.')" @@ -2193,14 +2077,12 @@ subroutine preprocess_input(this) ! ! -- Return return - end subroutine preprocess_input !> @brief Calculate CONDSAT array entries for the given node !! !! Calculate saturated conductances for all connections of the given node, !! or optionally for the upper portion of the matrix only. - !! !< subroutine calc_condsat(this, node, upperOnly) ! -- dummy variables @@ -2290,6 +2172,7 @@ subroutine calc_condsat(this, node, upperOnly) this%condsat(jj) = csat end do ! + ! -- Return return end subroutine calc_condsat @@ -2304,7 +2187,7 @@ function calc_initial_sat(this, n) result(satn) ! -- dummy variables class(GwfNpfType) :: this integer(I4B), intent(in) :: n - ! -- return + ! -- Return real(DP) :: satn ! satn = DONE @@ -2315,13 +2198,9 @@ function calc_initial_sat(this, n) result(satn) return end function calc_initial_sat + !> @brief Perform wetting and drying + !< subroutine sgwf_npf_wetdry(this, kiter, hnew) -! ****************************************************************************** -! sgwf_npf_wetdry -- Perform wetting and drying -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper use SimModule, only: store_error, store_error_filename @@ -2351,7 +2230,7 @@ subroutine sgwf_npf_wetdry(this, kiter, hnew) &"(1X,/1X,'CONSTANT-HEAD CELL WENT DRY -- SIMULATION ABORTED')" character(len=*), parameter :: fmtni = & &"(1X,'CELLID=',a,' ITERATION=',I0,' TIME STEP=',I0,' STRESS PERIOD=',I0)" -! ------------------------------------------------------------------------------ + ! ! -- Initialize ncnvrt = 0 ihdcnv = 0 @@ -2394,7 +2273,6 @@ subroutine sgwf_npf_wetdry(this, kiter, hnew) thck = ttop - bbot ! ! -- If thck<0 print message, set hnew, and ibound -! if(thck<0) then if (thck <= DZERO) then call this%wdmsg(1, ncnvrt, nodcnvrt, acnvrt, ihdcnv, kiter, n) hnew(n) = this%hdry @@ -2424,18 +2302,14 @@ subroutine sgwf_npf_wetdry(this, kiter, hnew) return end subroutine sgwf_npf_wetdry + !> @brief Determine if a cell should rewet + !! + !! This method can be called from any external object that has a head that + !! can be used to rewet the GWF cell node. The ihc value is used to + !! determine if it is a vertical or horizontal connection, which can operate + !! differently depending on user settings. + !< subroutine rewet_check(this, kiter, node, hm, ibdm, ihc, hnew, irewet) -! ****************************************************************************** -! rewet_check -- Determine if a cell should rewet. This method can -! be called from any external object that has a head that can be used to -! rewet the GWF cell node. The ihc value is used to determine if it is a -! vertical or horizontal connection, which can operate differently depending -! on user settings. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: kiter @@ -2448,8 +2322,6 @@ subroutine rewet_check(this, kiter, node, hm, ibdm, ihc, hnew, irewet) ! -- local integer(I4B) :: itflg real(DP) :: wd, awd, turnon, bbot - ! -- formats -! ------------------------------------------------------------------------------ ! irewet = 0 ! @@ -2498,14 +2370,10 @@ subroutine rewet_check(this, kiter, node, hm, ibdm, ihc, hnew, irewet) return end subroutine rewet_check + !> @brief Print wet/dry message + !< subroutine sgwf_npf_wdmsg(this, icode, ncnvrt, nodcnvrt, acnvrt, ihdcnv, & kiter, n) -! ****************************************************************************** -! sgwf_npf_wdmsg -- Print wet/dry message -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper ! -- dummy @@ -2524,7 +2392,7 @@ subroutine sgwf_npf_wdmsg(this, icode, ncnvrt, nodcnvrt, acnvrt, ihdcnv, & "(1X,/1X,'CELL CONVERSIONS FOR ITER.=',I0, & &' STEP=',I0,' PERIOD=',I0,' (NODE or LRC)')" character(len=*), parameter :: fmtnode = "(1X,3X,5(A4, A20))" -! ------------------------------------------------------------------------------ + ! ! -- Keep track of cell conversions if (icode > 0) then ncnvrt = ncnvrt + 1 @@ -2550,22 +2418,17 @@ subroutine sgwf_npf_wdmsg(this, icode, ncnvrt, nodcnvrt, acnvrt, ihdcnv, & return end subroutine sgwf_npf_wdmsg + !> @brief Calculate the effective hydraulic conductivity for the n-m connection + !! + !! n is primary node node number + !! m is connected node (not used if vg is provided) + !! ihc is horizontal indicator (0 vertical, 1 horizontal, 2 vertically + !! staggered) + !! ipos_opt is position of connection in ja array + !! vg is the global unit vector that expresses the direction from which to + !! calculate an effective hydraulic conductivity. + !< function hy_eff(this, n, m, ihc, ipos, vg) result(hy) -! ****************************************************************************** -! hy_eff -- Calculate the effective hydraulic conductivity for the n-m -! connection. -! n is primary node node number -! m is connected node (not used if vg is provided) -! ihc is horizontal indicator (0 vertical, 1 horizontal, 2 vertically -! staggered) -! ipos_opt is position of connection in ja array -! vg is the global unit vector that expresses the direction from which to -! calculate an effective hydraulic conductivity. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return real(DP) :: hy ! -- dummy @@ -2580,8 +2443,6 @@ function hy_eff(this, n, m, ihc, ipos, vg) result(hy) real(DP) :: hy11, hy22, hy33 real(DP) :: ang1, ang2, ang3 real(DP) :: vg1, vg2, vg3 - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Initialize iipos = 0 @@ -2647,22 +2508,19 @@ function hy_eff(this, n, m, ihc, ipos, vg) result(hy) return end function hy_eff + !> @brief Horizontal conductance between two cells + !! + !! inwtup: if 1, then upstream-weight condsat, otherwise recalculate + !! + !! This function uses a weighted transmissivity in the harmonic mean + !! conductance calculations. This differs from the MODFLOW-NWT and + !! MODFLOW-USG conductance calculations for the Newton-Raphson formulation + !! which use a weighted hydraulic conductivity. + !< function hcond(ibdn, ibdm, ictn, ictm, inewton, inwtup, ihc, icellavg, iusg, & iupw, condsat, hn, hm, satn, satm, hkn, hkm, topn, topm, & botn, botm, cln, clm, fawidth, satomega, satminopt) & result(condnm) -! ****************************************************************************** -! hcond -- Horizontal conductance between two cells -! inwtup: if 1, then upstream-weight condsat, otherwise recalculate -! -! hcond function uses a weighted transmissivity in the harmonic mean -! conductance calculations. This differs from the MODFLOW-NWT and MODFLOW-USG -! conductance calculations for the Newton-Raphson formulation which use a -! weighted hydraulic conductivity. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: condnm ! -- dummy @@ -2704,7 +2562,7 @@ function hcond(ibdn, ibdm, ictn, ictm, inewton, inwtup, ihc, icellavg, iusg, & real(DP) :: top, bot real(DP) :: athk real(DP) :: afac -! ------------------------------------------------------------------------------ + ! if (present(satminopt)) then satmin = satminopt else @@ -2752,7 +2610,7 @@ function hcond(ibdn, ibdm, ictn, ictm, inewton, inwtup, ihc, icellavg, iusg, & sn = sQuadraticSaturation(topn, botn, hn, satomega, satmin) sm = sQuadraticSaturation(topm, botm, hm, satomega, satmin) end if - + ! if (hn > hm) then condnm = sn else @@ -2793,7 +2651,7 @@ function hcond(ibdn, ibdm, ictn, ictm, inewton, inwtup, ihc, icellavg, iusg, & thksatn = max(min(tpn, sill_top) - sill_bot, DZERO) thksatm = max(min(tpm, sill_top) - sill_bot, DZERO) end if - + ! athk = DONE if (iusg == 1) then if (ihc == 2) then @@ -2814,15 +2672,11 @@ function hcond(ibdn, ibdm, ictn, ictm, inewton, inwtup, ihc, icellavg, iusg, & return end function hcond + !> @brief Vertical conductance between two cells + !< function vcond(ibdn, ibdm, ictn, ictm, inewton, ivarcv, idewatcv, & condsat, hn, hm, vkn, vkm, satn, satm, topn, topm, botn, & botm, flowarea) result(condnm) -! ****************************************************************************** -! vcond -- Vertical conductance between two cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: condnm ! -- dummy @@ -2850,7 +2704,6 @@ function vcond(ibdn, ibdm, ictn, ictm, inewton, ivarcv, idewatcv, & real(DP) :: bovk1 real(DP) :: bovk2 real(DP) :: denom -! ------------------------------------------------------------------------------ ! ! -- If either n or m is inactive then conductance is zero if (ibdn == 0 .or. ibdm == 0) then @@ -2900,30 +2753,26 @@ function vcond(ibdn, ibdm, ictn, ictm, inewton, ivarcv, idewatcv, & return end function vcond + !> @brief Calculate the conductance between two cells + !! + !! k1 is hydraulic conductivity for cell 1 (in the direction of cell2) + !! k2 is hydraulic conductivity for cell 2 (in the direction of cell1) + !! thick1 is the saturated thickness for cell 1 + !! thick2 is the saturated thickness for cell 2 + !! cl1 is the distance from the center of cell1 to the shared face with cell2 + !! cl2 is the distance from the center of cell2 to the shared face with cell1 + !! h1 is the head for cell1 + !! h2 is the head for cell2 + !! width is the width perpendicular to flow + !! iavgmeth is the averaging method: + !! 0 is harmonic averaging + !! 1 is logarithmic averaging + !! 2 is arithmetic averaging of sat thickness and logarithmic averaging of + !! hydraulic conductivity + !! 3 is arithmetic averaging of sat thickness and harmonic averaging of + !! hydraulic conductivity + !< function condmean(k1, k2, thick1, thick2, cl1, cl2, width, iavgmeth) -! ****************************************************************************** -! condmean -- Calculate the conductance between two cells -! -! k1 is hydraulic conductivity for cell 1 (in the direction of cell2) -! k2 is hydraulic conductivity for cell 2 (in the direction of cell1) -! thick1 is the saturated thickness for cell 1 -! thick2 is the saturated thickness for cell 2 -! cl1 is the distance from the center of cell1 to the shared face with cell2 -! cl2 is the distance from the center of cell2 to the shared face with cell1 -! h1 is the head for cell1 -! h2 is the head for cell2 -! width is the width perpendicular to flow -! iavgmeth is the averaging method: -! 0 is harmonic averaging -! 1 is logarithmic averaging -! 2 is arithmetic averaging of sat thickness and logarithmic averaging of -! hydraulic conductivity -! 3 is arithmetic averaging of sat thickness and harmonic averaging of -! hydraulic conductivity -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: condmean ! -- dummy @@ -2939,7 +2788,6 @@ function condmean(k1, k2, thick1, thick2, cl1, cl2, width, iavgmeth) real(DP) :: t1 real(DP) :: t2 real(DP) :: tmean, kmean, denom -! ------------------------------------------------------------------------------ ! ! -- Initialize t1 = k1 * thick1 @@ -2990,14 +2838,11 @@ function condmean(k1, k2, thick1, thick2, cl1, cl2, width, iavgmeth) return end function condmean + !> @brief Calculate the the logarithmic mean of two double precision numbers + !! + !! Use an approximation if the ratio is near 1 + !< function logmean(d1, d2) -! ****************************************************************************** -! logmean -- Calculate the the logarithmic mean of two double precision -! numbers. Use an approximation if the ratio is near 1. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: logmean ! -- dummy @@ -3005,7 +2850,6 @@ function logmean(d1, d2) real(DP), intent(in) :: d2 ! -- local real(DP) :: drat -! ------------------------------------------------------------------------------ ! drat = d2 / d1 if (drat <= DLNLOW .or. drat >= DLNHIGH) then @@ -3018,31 +2862,28 @@ function logmean(d1, d2) return end function logmean + !> @brief Calculate the effective horizontal hydraulic conductivity from an + !! ellipse using a specified direction (unit vector vg1, vg2, vg3) + !! + !! k11 is the hydraulic conductivity of the major ellipse axis + !! k22 is the hydraulic conductivity of first minor axis + !! k33 is the hydraulic conductivity of the second minor axis + !! ang1 is the counter-clockwise rotation (radians) of the ellipse in + !! the (x, y) plane + !! ang2 is the rotation of the conductivity ellipsoid upward or + !! downward from the (x, y) plane + !! ang3 is the rotation of the conductivity ellipsoid about the major + !! axis + !! vg1, vg2, and vg3 are the components of a unit vector in model coordinates + !! in the direction of the connection between cell n and m + !!iavgmeth is the averaging method. If zero, then use harmonic averaging. + !! if one, then use arithmetic averaging. + !< function hyeff_calc(k11, k22, k33, ang1, ang2, ang3, vg1, vg2, vg3, & iavgmeth) result(hyeff) -! ****************************************************************************** -! hyeff_calc -- Calculate the effective horizontal hydraulic conductivity from -! an ellipse using a specified direction (unit vector vg1, vg2, vg3). -! k11 is the hydraulic conductivity of the major ellipse axis -! k22 is the hydraulic conductivity of first minor axis -! k33 is the hydraulic conductivity of the second minor axis -! ang1 is the counter-clockwise rotation (radians) of the ellipse in -! the (x, y) plane -! ang2 is the rotation of the conductivity ellipsoid upward or -! downward from the (x, y) plane -! ang3 is the rotation of the conductivity ellipsoid about the major -! axis -! vg1, vg2, and vg3 are the components of a unit vector in model coordinates -! in the direction of the connection between cell n and m -! iavgmeth is the averaging method. If zero, then use harmonic averaging. -! if one, then use arithmetic averaging. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE - ! -- result + ! -- return real(DP) :: hyeff ! -- dummy real(DP), intent(in) :: k11 @@ -3060,7 +2901,6 @@ function hyeff_calc(k11, k22, k33, ang1, ang2, ang3, vg1, vg2, vg3, & real(DP), dimension(3, 3) :: r real(DP) :: ve1, ve2, ve3 real(DP) :: denom, dnum, d1, d2, d3 -! ------------------------------------------------------------------------------ ! ! -- Sin and cos of angles s1 = sin(ang1) @@ -3124,14 +2964,9 @@ function hyeff_calc(k11, k22, k33, ang1, ang2, ang3, vg1, vg2, vg3, & return end function hyeff_calc + !> @brief Calculate the 3 conmponents of specific discharge at the cell center + !< subroutine calc_spdis(this, flowja) -! ****************************************************************************** -! calc_spdis -- Calculate the 3 conmponents of specific discharge -! at the cell center. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error ! -- dummy @@ -3181,7 +3016,6 @@ subroutine calc_spdis(this, flowja) real(DP), allocatable, dimension(:) :: bix real(DP), allocatable, dimension(:) :: biy logical :: nozee = .true. -! ------------------------------------------------------------------------------ ! ! -- Ensure dis has necessary information if (this%icalcspdis /= 0 .and. this%dis%con%ianglex == 0) then @@ -3423,18 +3257,13 @@ subroutine calc_spdis(this, flowja) deallocate (bix) deallocate (biy) ! - ! -- return + ! -- Return return end subroutine calc_spdis + !> @brief Save specific discharge in binary format to ibinun + !< subroutine sav_spdis(this, ibinun) -! ****************************************************************************** -! sav_spdis -- save specific discharge in binary format to ibinun -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: ibinun @@ -3443,7 +3272,6 @@ subroutine sav_spdis(this, ibinun) character(len=16), dimension(3) :: auxtxt integer(I4B) :: n integer(I4B) :: naux -! ------------------------------------------------------------------------------ ! ! -- Write the header text = ' DATA-SPDIS' @@ -3460,18 +3288,13 @@ subroutine sav_spdis(this, ibinun) this%spdis(:, n)) end do ! - ! -- return + ! -- Return return end subroutine sav_spdis + !> @brief Save saturation in binary format to ibinun + !< subroutine sav_sat(this, ibinun) -! ****************************************************************************** -! sav_sat -- save saturation in binary format to ibinun -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: ibinun @@ -3481,7 +3304,6 @@ subroutine sav_sat(this, ibinun) real(DP), dimension(1) :: a integer(I4B) :: n integer(I4B) :: naux -! ------------------------------------------------------------------------------ ! ! -- Write the header text = ' DATA-SAT' @@ -3498,41 +3320,30 @@ subroutine sav_sat(this, ibinun) call this%dis%record_mf6_list_entry(ibinun, n, n, DZERO, naux, a) end do ! - ! -- return + ! -- Return return end subroutine sav_sat + !> @brief Reserve space for nedges cells that have an edge on them. + !! + !! This must be called before the npf%allocate_arrays routine, which is + !! called from npf%ar. + !< subroutine increase_edge_count(this, nedges) -! ****************************************************************************** -! increase_edge_count -- reserve space for nedges cells that have an edge on them. -! This must be called before the npf%allocate_arrays routine, which is called -! from npf%ar. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: nedges - ! -- local -! ------------------------------------------------------------------------------ ! this%nedges = this%nedges + nedges ! - ! -- return + ! -- Return return end subroutine increase_edge_count + !> @brief Provide the npf package with edge properties + !< subroutine set_edge_properties(this, nodedge, ihcedge, q, area, nx, ny, & distance) -! ****************************************************************************** -! edge_count -- provide the npf package with edge properties. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwfNpfType) :: this integer(I4B), intent(in) :: nodedge @@ -3544,7 +3355,6 @@ subroutine set_edge_properties(this, nodedge, ihcedge, q, area, nx, ny, & real(DP), intent(in) :: distance ! -- local integer(I4B) :: lastedge -! ------------------------------------------------------------------------------ ! this%lastedge = this%lastedge + 1 lastedge = this%lastedge @@ -3560,19 +3370,21 @@ subroutine set_edge_properties(this, nodedge, ihcedge, q, area, nx, ny, & ! edge properties assignment loop, so need to reset lastedge to 0 if (this%lastedge == this%nedges) this%lastedge = 0 ! - ! -- return + ! -- Return return end subroutine set_edge_properties !> Calculate saturated thickness between cell n and m !< function calcSatThickness(this, n, m, ihc) result(satThickness) + ! -- dummy class(GwfNpfType) :: this !< this NPF instance integer(I4B) :: n !< node n integer(I4B) :: m !< node m integer(I4B) :: ihc !< 1 = horizonal connection, 0 for vertical + ! -- return real(DP) :: satThickness !< saturated thickness - + ! satThickness = thksatnm(this%ibound(n), & this%ibound(m), & this%icelltype(n), & @@ -3590,19 +3402,16 @@ function calcSatThickness(this, n, m, ihc) result(satThickness) this%dis%bot(m), & this%satomega, & this%satmin) - + ! + ! -- Return + return end function calcSatThickness + !> @brief Calculate saturated thickness at interface between two cells + !< function thksatnm(ibdn, ibdm, ictn, ictm, inwtup, ihc, iusg, & hn, hm, satn, satm, topn, topm, botn, botm, & satomega, satminopt) result(res) -! ****************************************************************************** -! thksatnm -- calculate saturated thickness at interface between two cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return real(DP) :: res ! -- dummy @@ -3633,7 +3442,7 @@ function thksatnm(ibdn, ibdm, ictn, ictm, inwtup, ihc, iusg, & real(DP) :: sill_top, sill_bot real(DP) :: tpn, tpm real(DP) :: top, bot -! ------------------------------------------------------------------------------ + ! if (present(satminopt)) then satmin = satminopt else diff --git a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 index 79fe5bee186..b4e7f4e7ac2 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfNpfInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -64,7 +65,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -80,7 +82,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -96,7 +99,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -112,7 +116,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -128,7 +133,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -144,7 +150,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -160,7 +167,8 @@ module GwfNpfInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -176,7 +184,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -192,7 +201,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -208,7 +218,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -224,7 +235,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -240,7 +252,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -256,7 +269,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -272,7 +286,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -288,7 +303,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -304,7 +320,8 @@ module GwfNpfInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -320,7 +337,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -336,7 +354,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -352,7 +371,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -368,7 +388,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -384,7 +405,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -400,7 +422,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -416,7 +439,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -432,7 +456,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -448,7 +473,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -464,7 +490,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -480,7 +507,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -496,7 +524,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -512,7 +541,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -528,7 +558,8 @@ module GwfNpfInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -544,7 +575,8 @@ module GwfNpfInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -560,7 +592,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -576,7 +609,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -592,7 +626,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -608,7 +643,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -624,7 +660,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -640,7 +677,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -700,7 +738,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterFlow/gwf3obs8.f90 b/src/Model/GroundWaterFlow/gwf3obs8.f90 index 15490abbcbf..e15ec7c8f57 100644 --- a/src/Model/GroundWaterFlow/gwf3obs8.f90 +++ b/src/Model/GroundWaterFlow/gwf3obs8.f90 @@ -18,7 +18,9 @@ module GwfObsModule type(GwfIcType), pointer, private :: ic => null() ! initial conditions real(DP), dimension(:), pointer, contiguous, private :: x => null() ! head real(DP), dimension(:), pointer, contiguous, private :: flowja => null() ! intercell flows + contains + ! -- Public procedures procedure, public :: gwf_obs_ar procedure, public :: obs_bd => gwf_obs_bd @@ -31,20 +33,14 @@ module GwfObsModule contains + !> @brief Create a new GwfObsType object + !! + !! Create oseration object, allocate pointers, initialize values + !< subroutine gwf_obs_cr(obs, inobs) -! ****************************************************************************** -! gwf_obs_cr -- Create a new GwfObsType object -! Subroutine: (1) creates object -! (2) allocates pointers -! (3) initializes values -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(GwfObsType), pointer, intent(out) :: obs integer(I4B), pointer, intent(in) :: inobs -! ------------------------------------------------------------------------------ ! allocate (obs) call obs%allocate_scalars() @@ -52,22 +48,18 @@ subroutine gwf_obs_cr(obs, inobs) obs%inputFilename = '' obs%inUnitObs => inobs ! + ! -- Return return end subroutine gwf_obs_cr + !> @brief Allocate and read + !< subroutine gwf_obs_ar(this, ic, x, flowja) -! ****************************************************************************** -! gwf_obs_ar -- allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfObsType), intent(inout) :: this type(GwfIcType), pointer, intent(in) :: ic real(DP), dimension(:), pointer, contiguous, intent(in) :: x real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja -! ------------------------------------------------------------------------------ ! ! Call ar method of parent class call this%obs_ar() @@ -75,16 +67,13 @@ subroutine gwf_obs_ar(this, ic, x, flowja) ! set pointers call this%set_pointers(ic, x, flowja) ! + ! -- Return return end subroutine gwf_obs_ar + !> @brief Define + !< subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis) -! ****************************************************************************** -! gwt_obs_df -- define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfObsType), intent(inout) :: this integer(I4B), intent(in) :: iout @@ -93,7 +82,6 @@ subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis) class(DisBaseType), pointer :: dis ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! Call overridden method of parent class call this%ObsType%obs_df(iout, pkgname, filtyp, dis) @@ -113,16 +101,13 @@ subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis) call this%StoreObsType('flow-ja-face', .true., indx) this%obsData(indx)%ProcessIdPtr => gwf_process_intercell_obs_id ! + ! -- Return return end subroutine gwf_obs_df + !> @brief Save obs + !< subroutine gwf_obs_bd(this) -! ****************************************************************************** -! gwf_obs_bd -- save obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfObsType), intent(inout) :: this ! -- local @@ -130,7 +115,6 @@ subroutine gwf_obs_bd(this) real(DP) :: v character(len=100) :: msg class(ObserveType), pointer :: obsrv => null() -! ------------------------------------------------------------------------------ ! call this%obs_bd_clear() ! @@ -160,49 +144,40 @@ subroutine gwf_obs_bd(this) end if end if ! + ! -- Return return end subroutine gwf_obs_bd + !> @brief Do GWF observations need any checking? If so, add checks here + !< subroutine gwf_obs_rp(this) -! ****************************************************************************** -! gwf_obs_rp -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(GwfObsType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! Do GWF observations need any checking? If so, add checks here + ! + ! -- Return return end subroutine gwf_obs_rp + !> @brief Deallocate memory + !< subroutine gwf_obs_da(this) -! ****************************************************************************** -! gwf_obs_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfObsType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! nullify (this%ic) nullify (this%x) nullify (this%flowja) call this%ObsType%obs_da() ! + ! -- Return return end subroutine gwf_obs_da + !> @brief Set pointers + !< subroutine set_pointers(this, ic, x, flowja) -! ****************************************************************************** -! set_pointers -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwfObsType), intent(inout) :: this type(GwfIcType), pointer, intent(in) :: ic @@ -213,18 +188,15 @@ subroutine set_pointers(this, ic, x, flowja) this%x => x this%flowja => flowja ! + ! -- Return return end subroutine set_pointers ! -- Procedures related to GWF observations (NOT type-bound) + !> @brief Calculate drawdown obseration when requested + !< subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout) -! ****************************************************************************** -! gwf_process_head_drawdown_obs_id -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -234,7 +206,6 @@ subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout) integer(I4B) :: nn1 integer(I4B) :: icol, istart, istop character(len=LINELENGTH) :: ermsg, strng -! ------------------------------------------------------------------------------ ! ! -- Initialize variables strng = obsrv%IDstring @@ -253,16 +224,13 @@ subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout) call store_error_unit(inunitobs) end if ! + ! -- Return return end subroutine gwf_process_head_drawdown_obs_id + !> @brief Process flow between two cells when requested + !< subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout) -! ****************************************************************************** -! gwf_process_intercell_obs_id -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -274,7 +242,6 @@ subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout) character(len=LINELENGTH) :: ermsg, strng ! formats 70 format('Error: No connection exists between cells identified in text: ', a) -! ------------------------------------------------------------------------------ ! ! -- Initialize variables strng = obsrv%IDstring @@ -315,6 +282,7 @@ subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout) call store_error_unit(inunitobs) end if ! + ! -- Return return end subroutine gwf_process_intercell_obs_id diff --git a/src/Model/GroundWaterFlow/gwf3oc8.f90 b/src/Model/GroundWaterFlow/gwf3oc8.f90 index 12e635b7963..03485adc738 100644 --- a/src/Model/GroundWaterFlow/gwf3oc8.f90 +++ b/src/Model/GroundWaterFlow/gwf3oc8.f90 @@ -59,7 +59,7 @@ end subroutine oc_cr !< subroutine oc_ar(this, head, dis, dnodata) ! -- dummy - class(GwfOcType) :: this !< GwtOcType object + class(GwfOcType) :: this !< GwfOcType object real(DP), dimension(:), pointer, contiguous, intent(in) :: head !< model head class(DisBaseType), pointer, intent(in) :: dis !< model discretization package real(DP), intent(in) :: dnodata !< no data value diff --git a/src/Model/GroundWaterFlow/gwf3rch8.f90 b/src/Model/GroundWaterFlow/gwf3rch8.f90 index e50ad4f279b..40920754da9 100644 --- a/src/Model/GroundWaterFlow/gwf3rch8.f90 +++ b/src/Model/GroundWaterFlow/gwf3rch8.f90 @@ -1,18 +1,19 @@ module RchModule ! - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: DZERO, LENFTYPE, LENPACKAGENAME, MAXCHARLEN, & - IWETLAKE + IWETLAKE, LINELENGTH use MemoryHelperModule, only: create_mem_path use BndModule, only: BndType - use SimModule, only: store_error, store_error_unit + use BndExtModule, only: BndExtType + use SimModule, only: store_error, store_error_filename use SimVariablesModule, only: errmsg use ObsModule, only: DefaultObsIdProcessor use TimeArraySeriesLinkModule, only: TimeArraySeriesLinkType - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use BlockParserModule, only: BlockParserType + use CharacterStringModule, only: CharacterStringType use MatrixBaseModule + use GeomUtilModule, only: get_node ! implicit none ! @@ -23,42 +24,42 @@ module RchModule character(len=LENPACKAGENAME) :: text = ' RCH' character(len=LENPACKAGENAME) :: texta = ' RCHA' ! - type, extends(BndType) :: RchType - integer(I4B), pointer :: inirch => NULL() + type, extends(BndExtType) :: RchType + real(DP), dimension(:), pointer, contiguous :: recharge => null() !< boundary recharge array integer(I4B), dimension(:), pointer, contiguous :: nodesontop => NULL() ! User provided cell numbers; nodelist is cells where recharge is applied) - logical, private :: fixed_cell = .false. - logical, private :: read_as_arrays = .false. + logical, pointer, private :: fixed_cell + logical, pointer, private :: read_as_arrays + contains + procedure :: rch_allocate_scalars - procedure :: bnd_options => rch_options - procedure :: read_dimensions => rch_read_dimensions + procedure :: allocate_arrays => rch_allocate_arrays + procedure :: source_options => rch_source_options + procedure :: source_dimensions => rch_source_dimensions + procedure :: log_rch_options procedure :: read_initial_attr => rch_read_initial_attr procedure :: bnd_rp => rch_rp - procedure :: set_nodesontop procedure :: bnd_cf => rch_cf procedure :: bnd_fc => rch_fc procedure :: bnd_da => rch_da + procedure :: set_nodesontop procedure :: define_listlabel => rch_define_listlabel - procedure, public :: bnd_rp_ts => rch_rp_ts - procedure, private :: rch_rp_array - procedure, private :: rch_rp_list + procedure :: bound_value => rch_bound_value procedure, private :: default_nodelist ! -- for observations procedure, public :: bnd_obs_supported => rch_obs_supported procedure, public :: bnd_df_obs => rch_df_obs + end type RchType contains - subroutine rch_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! rch_create -- Create a New Recharge Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a New Recharge Package + !! + !! Create new RCH package and point packobj to the new package + !< + subroutine rch_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -67,16 +68,16 @@ subroutine rch_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(rchtype), pointer :: rchobj -! ------------------------------------------------------------------------------ ! ! -- allocate recharge object and scalar variables allocate (rchobj) packobj => rchobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -84,550 +85,229 @@ subroutine rch_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 1 - packobj%iscloc = 1 ! sfac applies to recharge rate packobj%ictMemPath = create_mem_path(namemodel, 'NPF') - ! indxconvertflux is Column index of bound that will be multiplied by - ! cell area to convert flux rates to flow rates - packobj%indxconvertflux = 1 - packobj%AllowTimeArraySeries = .true. ! - ! -- return + ! -- Return return end subroutine rch_create + !> @brief Allocate scalar members + !< subroutine rch_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(RchType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! - ! -- call standard BndType allocate scalars - call this%BndType%allocate_scalars() + ! -- allocate base scalars + call this%BndExtType%allocate_scalars() ! - ! -- allocate the object and assign values to object variables - call mem_allocate(this%inirch, 'INIRCH', this%memoryPath) + ! -- allocate internal members + allocate (this%fixed_cell) + allocate (this%read_as_arrays) ! ! -- Set values - this%inirch = 0 this%fixed_cell = .false. + this%read_as_arrays = .false. ! - ! -- return + ! -- Return return end subroutine rch_allocate_scalars - subroutine rch_options(this, option, found) -! ****************************************************************************** -! rch_options -- set options specific to RchType -! -! rch_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: DZERO - use SimModule, only: store_error + !> @brief Allocate package arrays + !< + subroutine rch_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_setptr, mem_checkin + ! -- dummy + class(RchType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! + ! -- allocate base arrays + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set recharge input context pointer + call mem_setptr(this%recharge, 'RECHARGE', this%input_mempath) + ! + ! -- checkin recharge input context pointer + call mem_checkin(this%recharge, 'RECHARGE', this%memoryPath, & + 'RECHARGE', this%input_mempath) + ! + ! -- Return + return + end subroutine rch_allocate_arrays + + !> @brief Source options specific to RchType + !< + subroutine rch_source_options(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value implicit none ! -- dummy class(RchType), intent(inout) :: this - character(len=*), intent(inout) :: option - logical, intent(inout) :: found ! -- local - character(len=MAXCHARLEN) :: ermsg + logical(LGP) :: found_fixed_cell = .false. + logical(LGP) :: found_readasarrays = .false. + ! + ! -- source common bound options + call this%BndExtType%source_options() + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%fixed_cell, 'FIXED_CELL', this%input_mempath, & + found_fixed_cell) + call mem_set_value(this%read_as_arrays, 'READASARRAYS', this%input_mempath, & + found_readasarrays) + ! + if (found_readasarrays) then + if (this%dis%supports_layers()) then + this%text = texta + else + errmsg = 'READASARRAYS option is not compatible with selected'// & + ' discretization type.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + end if + ! + ! -- log rch params + call this%log_rch_options(found_fixed_cell, found_readasarrays) + ! + ! -- Return + return + end subroutine rch_source_options + + !> @brief Log options specific to RchType + !< + subroutine log_rch_options(this, found_fixed_cell, found_readasarrays) + implicit none + ! -- dummy + class(RchType), intent(inout) :: this + logical(LGP), intent(in) :: found_fixed_cell + logical(LGP), intent(in) :: found_readasarrays ! -- formats - character(len=*), parameter :: fmtihact = & - &"(4x, 'RECHARGE WILL BE APPLIED TO HIGHEST ACTIVE CELL.')" character(len=*), parameter :: fmtfixedcell = & &"(4x, 'RECHARGE WILL BE APPLIED TO SPECIFIED CELL.')" character(len=*), parameter :: fmtreadasarrays = & &"(4x, 'RECHARGE INPUT WILL BE READ AS ARRAY(S).')" -! ------------------------------------------------------------------------------ ! - ! -- Check for FIXED_CELL and READASARRAYS - select case (option) - case ('FIXED_CELL') - this%fixed_cell = .true. + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found_fixed_cell) then write (this%iout, fmtfixedcell) - found = .true. - case ('READASARRAYS') - if (this%dis%supports_layers()) then - this%read_as_arrays = .true. - this%text = texta - else - ermsg = 'READASARRAYS option is not compatible with selected'// & - ' discretization type.' - call store_error(ermsg) - call this%parser%StoreErrorUnit() - end if - ! - ! -- Write option + end if + ! + if (found_readasarrays) then write (this%iout, fmtreadasarrays) - ! - found = .true. - case default - ! - ! -- No options found - found = .false. - end select + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' ! - ! -- return + ! -- Return return - end subroutine rch_options + end subroutine log_rch_options - subroutine rch_read_dimensions(this) -! ****************************************************************************** -! bnd_read_dimensions -- Read the dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, store_error_unit + !> @brief Source the dimensions for this package + !! + !! Dimensions block is not required if: + !! (1) discretization is DIS or DISV, and + !! (2) READASARRAYS option has been specified. + !< + subroutine rch_source_dimensions(this) ! -- dummy class(RchType), intent(inout) :: this - ! -- local - character(len=LINELENGTH) :: keyword - integer(I4B) :: ierr - logical :: isfound, endOfBlock - ! -- format -! ------------------------------------------------------------------------------ - ! - ! Dimensions block is not required if: - ! (1) discretization is DIS or DISV, and - ! (2) READASARRAYS option has been specified. + ! if (this%read_as_arrays) then this%maxbound = this%dis%get_ncpl() - else - ! -- get dimensions block - call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & - supportOpenClose=.true.) ! - ! -- parse dimensions block if detected - if (isfound) then - write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & - ' DIMENSIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case ('MAXBOUND') - this%maxbound = this%parser%GetInteger() - write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound - case default - write (errmsg, '(a,a)') & - 'Unknown '//trim(this%text)//' DIMENSION: ', trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - ! - write (this%iout, '(1x,a)') & - 'END OF '//trim(adjustl(this%text))//' DIMENSIONS' - else - call store_error('Required DIMENSIONS block not found.') - call this%parser%StoreErrorUnit() + ! -- verify dimensions were set + if (this%maxbound <= 0) then + write (errmsg, '(a)') & + 'MAXBOUND must be an integer greater than zero.' + call store_error(errmsg) + call store_error_filename(this%input_fname) end if - end if - ! - ! -- verify dimensions were set - if (this%maxbound <= 0) then - write (errmsg, '(a)') & - 'MAXBOUND must be an integer greater than zero.' - call store_error(errmsg) - call this%parser%StoreErrorUnit() + ! + else + ! + ! -- source maxbound + call this%BndExtType%source_dimensions() end if ! ! -- Call define_listlabel to construct the list label that is written ! when PRINT_INPUT option is used. call this%define_listlabel() ! - ! -- return + ! -- Return return - end subroutine rch_read_dimensions + end subroutine rch_source_dimensions + !> @brief Part of allocate and read + !< subroutine rch_read_initial_attr(this) -! ****************************************************************************** -! rch_read_initial_attr -- Part of allocate and read -! If READASARRAYS has been specified, assign default IRCH = 1 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(RchType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! if (this%read_as_arrays) then call this%default_nodelist() end if ! + ! -- Return return end subroutine rch_read_initial_attr + !> @brief Read and Prepare + !! + !! Read itmp and read new boundaries if itmp > 0 + !< subroutine rch_rp(this) -! ****************************************************************************** -! rch_rp -- Read and Prepare -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: LINELENGTH - use TdisModule, only: kper, nper - use SimModule, only: store_error + ! -- modules + use TdisModule, only: kper implicit none ! -- dummy class(RchType), intent(inout) :: this - ! -- local - integer(I4B) :: ierr - integer(I4B) :: node, n - integer(I4B) :: inirch, inrech - logical :: isfound - logical :: supportopenclose - character(len=LINELENGTH) :: line - ! -- formats - character(len=*), parameter :: fmtblkerr = & - &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" - character(len=*), parameter :: fmtlsp = & - &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" - character(len=*), parameter :: fmtnbd = & - "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, & - &') IS GREATER THAN MAXIMUM(',I6,')')" - character(len=*), parameter :: fmtdimlayered = & - "('When READASARRAYS is specified for the selected discretization & - &package, DIMENSIONS block must be omitted.')" -! ------------------------------------------------------------------------------ - ! - if (this%inunit == 0) return - ! - ! -- Set ionper to the stress period number for which a new block of data - ! will be read. - if (this%ionper < kper) then - ! - ! -- get period block - supportopenclose = .not. this%read_as_arrays - ! When reading a list, OPEN/CLOSE is handled by list reader, - ! so supportOpenClose needs to be false in call the GetBlock. - ! When reading as arrays, set supportOpenClose as desired. - call this%parser%GetBlock('PERIOD', isfound, ierr, & - blockRequired=.false.) - if (isfound) then - ! - ! -- read ionper and check for increasing period numbers - call this%read_check_ionper() - else - ! - ! -- PERIOD block not found - if (ierr < 0) then - ! -- End of file found; data applies for remainder of simulation. - this%ionper = nper + 1 - else - ! -- Found invalid block - call this%parser%GetCurrentLine(line) - write (errmsg, fmtblkerr) adjustl(trim(line)) - call store_error(errmsg) - if (this%read_as_arrays) then - write (errmsg, fmtdimlayered) - call store_error(errmsg) - end if - call this%parser%StoreErrorUnit() - end if - end if - end if ! - ! -- Read data if ionper == kper - inrech = 0 - inirch = 0 - if (this%ionper == kper) then - ! - ! -- Remove all time-series links associated with this package - call this%TsManager%Reset(this%packName) - call this%TasManager%Reset(this%packName) + if (this%iper /= kper) return + ! + if (this%read_as_arrays) then ! - if (.not. this%read_as_arrays) then - ! -- Read RECHARGE and other input as a list - call this%rch_rp_list(inrech) - call this%bnd_rp_ts() - else - ! -- Read RECHARGE, IRCH, and AUX variables as arrays - call this%rch_rp_array(line, inrech) - end if + ! -- update nodelist based on IRCH input + call nodelist_update(this%nodelist, this%nbound, this%maxbound, & + this%dis, this%input_mempath) ! else - write (this%iout, fmtlsp) trim(this%filtyp) - end if - ! - ! -- If recharge was read, then multiply by cell area. If inrech = 2, then - ! recharge is begin managed as a time series, and the time series object - ! will multiply the recharge rate by the cell area. - if (inrech == 1) then - do n = 1, this%nbound - node = this%nodelist(n) - if (node > 0) then - this%bound(1, n) = this%bound(1, n) * this%dis%get_area(node) - end if - end do - end if - ! - ! -- return - return - end subroutine rch_rp - - subroutine rch_rp_array(this, line, inrech) -! ****************************************************************************** -! rch_rp_array -- Read and Prepare Recharge as arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use ConstantsModule, only: LENTIMESERIESNAME, LINELENGTH - use SimModule, only: store_error - use ArrayHandlersModule, only: ifind - implicit none - ! -- dummy - class(RchType), intent(inout) :: this - character(len=LINELENGTH), intent(inout) :: line - integer(I4B), intent(inout) :: inrech - ! -- local - integer(I4B) :: n - integer(I4B) :: ipos - integer(I4B) :: jcol, jauxcol, lpos, ivarsread - character(len=LENTIMESERIESNAME) :: tasName - character(len=24), dimension(2) :: aname - character(len=LINELENGTH) :: keyword, atemp - logical :: found, endOfBlock - logical :: convertFlux - ! - ! -- these time array series pointers need to be non-contiguous - ! beacuse a slice of bound is passed - real(DP), dimension(:), pointer :: bndArrayPtr => null() - real(DP), dimension(:), pointer :: auxArrayPtr => null() - real(DP), dimension(:), pointer :: auxMultArray => null() - type(TimeArraySeriesLinkType), pointer :: tasLink => null() - ! -- formats - character(len=*), parameter :: fmtrchauxmult = & - "(4x, 'THE RECHARGE ARRAY IS BEING MULTIPLED BY THE AUXILIARY ARRAY WITH & - &THE NAME: ', A)" - ! -- data - data aname(1)/' LAYER OR NODE INDEX'/ - data aname(2)/' RECHARGE'/ - ! -! ------------------------------------------------------------------------------ - ! - ! -- Initialize - jauxcol = 0 - ivarsread = 0 - ! - ! -- Read RECHARGE, IRCH, and AUX variables as arrays - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - ! - ! -- Parse the keywords - select case (keyword) - case ('RECHARGE') - ! - ! -- Look for keyword TIMEARRAYSERIES and time-array series - ! name on line, following RECHARGE - call this%parser%GetStringCaps(keyword) - if (keyword == 'TIMEARRAYSERIES') then - ! -- Get time-array series name - call this%parser%GetStringCaps(tasName) - jcol = 1 ! for recharge rate - bndArrayPtr => this%bound(jcol, :) - ! Make a time-array-series link and add it to the list of links - ! contained in the TimeArraySeriesManagerType object. - convertflux = .true. - call this%TasManager%MakeTasLink(this%packName, bndArrayPtr, & - this%iprpak, tasName, 'RECHARGE', & - convertFlux, this%nodelist, & - this%parser%iuactive) - lpos = this%TasManager%CountLinks() - tasLink => this%TasManager%GetLink(lpos) - inrech = 2 - else - ! - ! -- Read the recharge array, then indicate - ! that recharge was read by setting inrech - call this%dis%read_layer_array(this%nodelist, this%bound, & - this%ncolbnd, this%maxbound, 1, & - aname(2), this%parser%iuactive, & - this%iout) - inrech = 1 - end if - ! - case ('IRCH') - ! - ! -- Check to see if other variables have already been read. If so, - ! then terminate with an error that IRCH must be read first. - if (ivarsread > 0) then - call store_error('IRCH IS NOT FIRST VARIABLE IN & - &PERIOD BLOCK OR IT IS SPECIFIED MORE THAN ONCE.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Read the IRCH array - call this%dis%nlarray_to_nodelist(this%nodelist, this%maxbound, & - this%nbound, aname(1), & - this%parser%iuactive, this%iout) - ! - ! -- set flag to indicate that irch array has been read - this%inirch = 1 - ! - ! -- if fixed_cell option not set, then need to store nodelist - ! in the nodesontop array - if (.not. this%fixed_cell) call this%set_nodesontop() - ! - case default - ! - ! -- Check for auxname, and if found, then read into auxvar array - found = .false. - ipos = ifind(this%auxname, keyword) - if (ipos > 0) then - found = .true. - atemp = keyword - ! - ! -- Look for keyword TIMEARRAYSERIES and time-array series - ! name on line, following auxname - call this%parser%GetStringCaps(keyword) - if (keyword == 'TIMEARRAYSERIES') then - ! -- Get time-array series name - call this%parser%GetStringCaps(tasName) - jauxcol = jauxcol + 1 - auxArrayPtr => this%auxvar(jauxcol, :) - ! Make a time-array-series link and add it to the list of links - ! contained in the TimeArraySeriesManagerType object. - convertflux = .false. - call this%TasManager%MakeTasLink(this%packName, auxArrayPtr, & - this%iprpak, tasName, & - this%auxname(ipos), convertFlux, & - this%nodelist, & - this%parser%iuactive) - else - ! - ! -- Read the aux variable array - call this%dis%read_layer_array(this%nodelist, this%auxvar, & - this%naux, this%maxbound, ipos, & - atemp, this%parser%iuactive, this%iout) - end if - end if - ! - ! -- Nothing found - if (.not. found) then - call this%parser%GetCurrentLine(line) - errmsg = 'LOOKING FOR VALID VARIABLE NAME. FOUND: '//trim(line) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end if - ! - ! -- If this aux variable has been designated as a multiplier array - ! by presence of AUXMULTNAME, set local pointer appropriately. - if (this%iauxmultcol > 0 .and. this%iauxmultcol == ipos) then - auxMultArray => this%auxvar(this%iauxmultcol, :) - end if - end select ! - ! -- Increment the number of variables read - ivarsread = ivarsread + 1 + call this%BndExtType%bnd_rp() ! - end do - ! - ! -- If the multiplier-array pointer has been assigned and - ! stress is controlled by a time-array series, assign - ! multiplier-array pointer in time-array series link. - if (associated(auxMultArray)) then - if (associated(tasLink)) then - tasLink%RMultArray => auxMultArray - end if end if ! - ! -- If recharge was read and auxmultcol was specified, then multiply - ! the recharge rate by the multplier column - if (inrech == 1 .and. this%iauxmultcol > 0) then - write (this%iout, fmtrchauxmult) this%auxname(this%iauxmultcol) - do n = 1, this%nbound - this%bound(this%iscloc, n) = this%bound(this%iscloc, n) * & - this%auxvar(this%iauxmultcol, n) - end do - end if - ! - return - end subroutine rch_rp_array - - subroutine rch_rp_list(this, inrech) -! ****************************************************************************** -! rch_rp_list -- Read and Prepare Recharge as a list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - implicit none - ! -- dummy - class(RchType), intent(inout) :: this - integer(I4B), intent(inout) :: inrech - ! -- local - integer(I4B) :: maxboundorig, nlist - ! -! ------------------------------------------------------------------------------ - ! - ! -- initialize - nlist = -1 - maxboundorig = this%maxbound - ! - ! -- read the list of recharge values; scale the recharge by auxmultcol - ! if it is specified. - call this%dis%read_list(this%parser%iuactive, this%iout, this%iprpak, & - nlist, this%inamedbound, this%iauxmultcol, & - this%nodelist, this%bound, this%auxvar, & - this%auxname, this%boundname, this%listlabel, & - this%packName, this%tsManager, this%iscloc, & - this%indxconvertflux) - this%nbound = nlist - if (this%maxbound > maxboundorig) then - ! -- The arrays that belong to BndType have been extended. - ! Now, RCH array nodesontop needs to be recreated. - if (associated(this%nodesontop)) then - deallocate (this%nodesontop) - end if - end if + ! -- copy nodelist to nodesontop if not fixed cell if (.not. this%fixed_cell) call this%set_nodesontop() - inrech = 1 ! - ! -- terminate the period block - call this%parser%terminateblock() + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if ! + ! -- Return return - end subroutine rch_rp_list + end subroutine rch_rp + !> @brief Store nodelist in nodesontop + !< subroutine set_nodesontop(this) -! ****************************************************************************** -! set_nodesontop -- store nodelist in nodesontop -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none ! -- dummy class(RchType), intent(inout) :: this ! -- local integer(I4B) :: n - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- allocate if necessary if (.not. associated(this%nodesontop)) then @@ -639,25 +319,19 @@ subroutine set_nodesontop(this) this%nodesontop(n) = this%nodelist(n) end do ! - ! -- return + ! -- Return return end subroutine set_nodesontop - subroutine rch_cf(this, reset_mover) -! ****************************************************************************** -! rch_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no recharge -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no recharge. Otherwise, calculate hcof and rhs + !< + subroutine rch_cf(this) ! -- dummy class(rchtype) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node -! ------------------------------------------------------------------------------ ! ! -- Return if no recharge if (this%nbound == 0) return @@ -688,7 +362,12 @@ subroutine rch_cf(this, reset_mover) ! ! -- Set rhs and hcof this%hcof(i) = DZERO - this%rhs(i) = -this%bound(1, i) + if (this%iauxmultcol > 0) then + this%rhs(i) = -this%recharge(i) * this%dis%get_area(node) * & + this%auxvar(this%iauxmultcol, i) + else + this%rhs(i) = -this%recharge(i) * this%dis%get_area(node) + end if if (this%ibound(node) <= 0) then this%rhs(i) = DZERO cycle @@ -699,17 +378,13 @@ subroutine rch_cf(this, reset_mover) end if end do ! - ! -- return + ! -- Return return end subroutine rch_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine rch_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! rch_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(RchType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -718,7 +393,6 @@ subroutine rch_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, n, ipos -! -------------------------------------------------------------------------- ! ! -- Copy package rhs and hcof into solution rhs and amat do i = 1, this%nbound @@ -735,46 +409,39 @@ subroutine rch_fc(this, rhs, ia, idxglo, matrix_sln) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) end do ! - ! -- return + ! -- Return return end subroutine rch_fc + !> @brief Deallocate memory + !< subroutine rch_da(this) -! ****************************************************************************** -! rch_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(RchType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! ! -- scalars - call mem_deallocate(this%inirch) + deallocate (this%fixed_cell) + deallocate (this%read_as_arrays) ! ! -- arrays if (associated(this%nodesontop)) deallocate (this%nodesontop) + call mem_deallocate(this%recharge, 'RECHARGE', this%memoryPath) ! - ! -- return + ! -- Return return end subroutine rch_da + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine rch_define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(RchType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -795,27 +462,19 @@ subroutine rch_define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine rch_define_listlabel + !> @brief Assign default nodelist when READASARRAYS is specified. + !! + !! Equivalent to reading IRCH as CONSTANT 1 + !< subroutine default_nodelist(this) -! ****************************************************************************** -! default_nodelist -- Assign default nodelist when READASARRAYS is specified. -! Equivalent to reading IRCH as CONSTANT 1 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: get_node - use SimModule, only: store_error - use ConstantsModule, only: LINELENGTH ! -- dummy class(RchType) :: this ! -- local integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nodeu, noder, ipos -! ------------------------------------------------------------------------------ ! ! -- set variables if (this%dis%ndim == 3) then @@ -840,84 +499,129 @@ subroutine default_nodelist(this) end do end do ! - ! Set flag that indicates IRCH has been assigned, and assign nbound. - this%inirch = 1 + ! -- Assign nbound this%nbound = ipos - 1 ! ! -- if fixed_cell option not set, then need to store nodelist ! in the nodesontop array if (.not. this%fixed_cell) call this%set_nodesontop() ! - ! -- return + ! -- Return + return end subroutine default_nodelist ! -- Procedures related to observations + + !> @brief + !! + !! Overrides BndType%bnd_obs_supported() + !< logical function rch_obs_supported(this) - ! ****************************************************************************** - ! rch_obs_supported - ! -- Return true because RCH package supports observations. - ! -- Overrides BndType%bnd_obs_supported() - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none + ! -- dummy class(RchType) :: this - ! ------------------------------------------------------------------------------ + ! rch_obs_supported = .true. ! - ! -- return + ! -- Return return end function rch_obs_supported + !> @brief Implements bnd_df_obs + !! + !! Store observation type supported by RCH package. Overrides + !! BndType%bnd_df_obs + !< subroutine rch_df_obs(this) - ! ****************************************************************************** - ! rch_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by RCH package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none ! -- dummy class(RchType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('rch', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine rch_df_obs - ! - ! -- Procedure related to time series - subroutine rch_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In RCH package only the RECHARGE variable - ! can be controlled by time series. + !> @brief Return requested boundary value + !< + function rch_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO ! -- dummy - class(RchType), intent(inout) :: this - ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'RECHARGE' - end select + class(RchType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + if (this%iauxmultcol > 0) then + bndval = this%recharge(row) * this%auxvar(this%iauxmultcol, row) + else + bndval = this%recharge(row) end if - end do + case default + errmsg = 'Programming error. RCH bound value requested column '& + &'outside range of ncolbnd (1).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + ! + ! -- Return + return + end function rch_bound_value + + !> @brief Update the nodelist based on IRCH input + !! + !! This is a module scoped routine to check for IRCH + !! input. If array input was provided, INIRCH and IRCH + !! will be allocated in the input context. If the read + !! state variable INIRCH is set to 1 during this period + !! update, IRCH input was read and is used here to update + !! the nodelist. + !! + !< + subroutine nodelist_update(nodelist, nbound, maxbound, & + dis, input_mempath) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use BaseDisModule, only: DisBaseType + ! -- dummy + integer(I4B), dimension(:), contiguous, & + pointer, intent(inout) :: nodelist + class(DisBaseType), pointer, intent(in) :: dis + character(len=*), intent(in) :: input_mempath + integer(I4B), intent(inout) :: nbound + integer(I4B), intent(in) :: maxbound + character(len=24) :: aname = ' LAYER OR NODE INDEX' + ! -- local + integer(I4B), dimension(:), contiguous, & + pointer :: irch => null() + integer(I4B), pointer :: inirch => NULL() + ! + ! -- set pointer to input context INIRCH + call mem_setptr(inirch, 'INIRCH', input_mempath) + ! + ! -- check INIRCH read state + if (inirch == 1) then + ! -- irch was read this period + ! + ! -- set pointer to input context IRCH + call mem_setptr(irch, 'IRCH', input_mempath) + ! + ! -- update nodelist + call dis%nlarray_to_nodelist(irch, nodelist, & + maxbound, nbound, aname) + end if ! + ! -- Return return - end subroutine rch_rp_ts + end subroutine nodelist_update end module RchModule diff --git a/src/Model/GroundWaterFlow/gwf3rch8idm.f90 b/src/Model/GroundWaterFlow/gwf3rch8idm.f90 new file mode 100644 index 00000000000..a39fff2acda --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3rch8idm.f90 @@ -0,0 +1,430 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfRchInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_rch_param_definitions + public gwf_rch_aggregate_definitions + public gwf_rch_block_definitions + public GwfRchParamFoundType + public gwf_rch_multi_package + + type GwfRchParamFoundType + logical :: fixed_cell = .false. + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: recharge = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfRchParamFoundType + + logical :: gwf_rch_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfrch_fixed_cell = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'FIXED_CELL', & ! tag name + 'FIXED_CELL', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_recharge = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'PERIOD', & ! block + 'RECHARGE', & ! tag name + 'RECHARGE', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrch_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_rch_param_definitions(*) = & + [ & + gwfrch_fixed_cell, & + gwfrch_auxiliary, & + gwfrch_auxmultname, & + gwfrch_boundnames, & + gwfrch_iprpak, & + gwfrch_iprflow, & + gwfrch_ipakcb, & + gwfrch_ts_filerecord, & + gwfrch_ts6, & + gwfrch_filein, & + gwfrch_ts6_filename, & + gwfrch_obs_filerecord, & + gwfrch_obs6, & + gwfrch_obs6_filename, & + gwfrch_maxbound, & + gwfrch_cellid, & + gwfrch_recharge, & + gwfrch_auxvar, & + gwfrch_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfrch_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCH', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID RECHARGE AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_rch_aggregate_definitions(*) = & + [ & + gwfrch_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_rch_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfRchInputModule diff --git a/src/Model/GroundWaterFlow/gwf3rcha8idm.f90 b/src/Model/GroundWaterFlow/gwf3rcha8idm.f90 new file mode 100644 index 00000000000..d692d12ee29 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3rcha8idm.f90 @@ -0,0 +1,383 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfRchaInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_rcha_param_definitions + public gwf_rcha_aggregate_definitions + public gwf_rcha_block_definitions + public GwfRchaParamFoundType + public gwf_rcha_multi_package + + type GwfRchaParamFoundType + logical :: readasarrays = .false. + logical :: fixed_cell = .false. + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: tas_filerecord = .false. + logical :: tas6 = .false. + logical :: filein = .false. + logical :: tas6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: irch = .false. + logical :: recharge = .false. + logical :: auxvar = .false. + end type GwfRchaParamFoundType + + logical :: gwf_rcha_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfrcha_readasarrays = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'READASARRAYS', & ! tag name + 'READASARRAYS', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_fixed_cell = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'FIXED_CELL', & ! tag name + 'FIXED_CELL', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_tas_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS_FILERECORD', & ! tag name + 'TAS_FILERECORD', & ! fortran variable + 'RECORD TAS6 FILEIN TAS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_tas6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6', & ! tag name + 'TAS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_tas6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6_FILENAME', & ! tag name + 'TAS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_irch = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'PERIOD', & ! block + 'IRCH', & ! tag name + 'IRCH', & ! fortran variable + 'INTEGER1D', & ! type + 'NCPL', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_recharge = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'PERIOD', & ! block + 'RECHARGE', & ! tag name + 'RECHARGE', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfrcha_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RCHA', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE2D', & ! type + 'NAUX NCPL', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_rcha_param_definitions(*) = & + [ & + gwfrcha_readasarrays, & + gwfrcha_fixed_cell, & + gwfrcha_auxiliary, & + gwfrcha_auxmultname, & + gwfrcha_iprpak, & + gwfrcha_iprflow, & + gwfrcha_ipakcb, & + gwfrcha_tas_filerecord, & + gwfrcha_tas6, & + gwfrcha_filein, & + gwfrcha_tas6_filename, & + gwfrcha_obs_filerecord, & + gwfrcha_obs6, & + gwfrcha_obs6_filename, & + gwfrcha_irch, & + gwfrcha_recharge, & + gwfrcha_auxvar & + ] + + type(InputParamDefinitionType), parameter :: & + gwf_rcha_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_rcha_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .false., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfRchaInputModule diff --git a/src/Model/GroundWaterFlow/gwf3riv8.f90 b/src/Model/GroundWaterFlow/gwf3riv8.f90 index 8feffb43f43..5822f72944f 100644 --- a/src/Model/GroundWaterFlow/gwf3riv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3riv8.f90 @@ -1,11 +1,12 @@ module rivmodule use KindModule, only: DP, I4B use ConstantsModule, only: DZERO, LENFTYPE, LENPACKAGENAME + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename use MemoryHelperModule, only: create_mem_path use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObsModule, only: DefaultObsIdProcessor - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use MatrixBaseModule ! implicit none @@ -17,31 +18,36 @@ module rivmodule character(len=LENFTYPE) :: ftype = 'RIV' character(len=LENPACKAGENAME) :: text = ' RIV' ! - type, extends(BndType) :: RivType + type, extends(BndExtType) :: RivType + real(DP), dimension(:), pointer, contiguous :: stage => null() !< RIV head + real(DP), dimension(:), pointer, contiguous :: cond => null() !< RIV bed hydraulic conductance + real(DP), dimension(:), pointer, contiguous :: rbot => null() !< RIV bed bottom elevation + contains - procedure :: bnd_options => riv_options + + procedure :: allocate_arrays => riv_allocate_arrays + procedure :: source_options => riv_options + procedure :: log_riv_options + procedure :: bnd_rp => riv_rp procedure :: bnd_ck => riv_ck procedure :: bnd_cf => riv_cf procedure :: bnd_fc => riv_fc + procedure :: bnd_da => riv_da procedure :: define_listlabel + procedure :: bound_value => riv_bound_value + procedure :: cond_mult ! -- methods for observations procedure, public :: bnd_obs_supported => riv_obs_supported procedure, public :: bnd_df_obs => riv_df_obs - ! -- method for time series - procedure, public :: bnd_rp_ts => riv_rp_ts + procedure, public :: riv_store_user_cond end type RivType contains - subroutine riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! riv_create -- Create a New Riv Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a New Riv Package and point packobj to the new package + !< + subroutine riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -50,16 +56,16 @@ subroutine riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath ! -- local type(RivType), pointer :: rivobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (rivobj) packobj => rivobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -67,58 +73,147 @@ subroutine riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 3 ! stage, conductance, rbot - packobj%iscloc = 2 !sfac applies to conductance packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine riv_create - subroutine riv_options(this, option, found) -! ****************************************************************************** -! riv_options -- set options specific to RivType -! -! riv_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use InputOutputModule, only: urword + !> @brief Deallocate memory + !< + subroutine riv_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(RivType) :: this + ! + ! -- Deallocate parent package + call this%BndExtType%bnd_da() + ! + ! -- arrays + call mem_deallocate(this%stage, 'STAGE', this%memoryPath) + call mem_deallocate(this%cond, 'COND', this%memoryPath) + call mem_deallocate(this%rbot, 'RBOT', this%memoryPath) + ! + ! -- Return + return + end subroutine riv_da + + !> @brief Set options specific to RivType + !< + subroutine riv_options(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use GwfRivInputModule, only: GwfRivParamFoundType ! -- dummy class(RivType), intent(inout) :: this - character(len=*), intent(inout) :: option - logical, intent(inout) :: found ! -- local -! ------------------------------------------------------------------------------ + type(GwfRivParamFoundType) :: found ! - select case (option) - case ('MOVER') - this%imover = 1 - write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' - found = .true. - case default - ! - ! -- No options found - found = .false. - end select + ! -- source base class options + call this%BndExtType%source_options() + ! + ! -- source options from input context + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) + ! + ! -- log riv specific options + call this%log_riv_options(found) ! - ! -- return + ! -- Return return end subroutine riv_options + !> @brief Log options specific to RivType + !< + subroutine log_riv_options(this, found) + ! -- modules + use GwfRivInputModule, only: GwfRivParamFoundType + ! -- dummy variables + class(RivType), intent(inout) :: this !< BndExtType object + type(GwfRivParamFoundType), intent(in) :: found + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found%mover) then + write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' + ! + ! -- Return + return + end subroutine log_riv_options + + !> @brief Allocate package arrays + !< + subroutine riv_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(RivType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! + ! -- call base type allocate arrays + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set riv input context pointers + call mem_setptr(this%stage, 'STAGE', this%input_mempath) + call mem_setptr(this%cond, 'COND', this%input_mempath) + call mem_setptr(this%rbot, 'RBOT', this%input_mempath) + ! + ! --checkin riv input context pointers + call mem_checkin(this%stage, 'STAGE', this%memoryPath, & + 'STAGE', this%input_mempath) + call mem_checkin(this%cond, 'COND', this%memoryPath, & + 'COND', this%input_mempath) + call mem_checkin(this%rbot, 'RBOT', this%memoryPath, & + 'RBOT', this%input_mempath) + ! + ! -- Return + return + end subroutine riv_allocate_arrays + + !> @brief Read and prepare + !< + subroutine riv_rp(this) + ! -- modules + use TdisModule, only: kper + ! -- dummy + class(RivType), intent(inout) :: this + ! + if (this%iper /= kper) return + ! + ! -- Call the parent class read and prepare + call this%BndExtType%bnd_rp() + ! + ! -- store user cond + if (this%ivsc == 1) then + call this%riv_store_user_cond() + end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! + ! -- Return + return + end subroutine riv_rp + + !> @brief Check river boundary condition data + !< subroutine riv_ck(this) -! ****************************************************************************** -! riv_ck -- Check river boundary condition data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit @@ -141,14 +236,13 @@ subroutine riv_ck(this) character(len=*), parameter :: fmtriverr3 = & "('RIV BOUNDARY (',i0,') RIVER STAGE (',f10.4,') IS LESS & &THAN CELL BOTTOM (',f10.4,')')" -! ------------------------------------------------------------------------------ ! ! -- check stress period data do i = 1, this%nbound node = this%nodelist(i) bt = this%dis%bot(node) - stage = this%bound(1, i) - rbot = this%bound(3, i) + stage = this%stage(i) + rbot = this%rbot(i) ! -- accumulate errors if (rbot < bt .and. this%icelltype(node) /= 0) then write (errmsg, fmt=fmtriverr) i, rbot, bt @@ -169,38 +263,24 @@ subroutine riv_ck(this) call store_error_unit(this%inunit) end if ! - ! -- return + ! -- Return return end subroutine riv_ck - subroutine riv_cf(this, reset_mover) -! ****************************************************************************** -! riv_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip in no rivs -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip in no rivs, otherwise calculate hcof and rhs + !< + subroutine riv_cf(this) ! -- dummy class(RivType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node real(DP) :: hriv, criv, rbot - logical :: lrm -! ------------------------------------------------------------------------------ ! ! -- Return if no rivs if (this%nbound .eq. 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each riv entry do i = 1, this%nbound node = this%nodelist(i) @@ -209,9 +289,9 @@ subroutine riv_cf(this, reset_mover) this%rhs(i) = DZERO cycle end if - hriv = this%bound(1, i) - criv = this%bound(2, i) - rbot = this%bound(3, i) + hriv = this%stage(i) + criv = this%cond_mult(i) + rbot = this%rbot(i) if (this%xnew(node) <= rbot) then this%rhs(i) = -criv * (hriv - rbot) this%hcof(i) = DZERO @@ -221,17 +301,13 @@ subroutine riv_cf(this, reset_mover) end if end do ! - ! -- return + ! -- Return return end subroutine riv_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine riv_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! riv_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(RivType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -241,7 +317,6 @@ subroutine riv_fc(this, rhs, ia, idxglo, matrix_sln) ! -- local integer(I4B) :: i, n, ipos real(DP) :: cond, stage, qriv !, rbot -! -------------------------------------------------------------------------- ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -257,28 +332,24 @@ subroutine riv_fc(this, rhs, ia, idxglo, matrix_sln) ! ! -- If mover is active and this river cell is discharging, ! store available water (as positive value). - stage = this%bound(1, i) + stage = this%stage(i) if (this%imover == 1 .and. this%xnew(n) > stage) then - cond = this%bound(2, i) + cond = this%cond_mult(i) qriv = cond * (this%xnew(n) - stage) call this%pakmvrobj%accumulate_qformvr(i, qriv) end if end do ! - ! -- return + ! -- Return return end subroutine riv_fc + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules class(RivType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -299,43 +370,38 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel ! -- Procedures related to observations + !> @brief Return true because RIV package supports observations + !! + !! Return true because RIV package supports observations. + !> logical function riv_obs_supported(this) -! ****************************************************************************** -! riv_obs_supported -! -- Return true because RIV package supports observations. -! -- Overrides BndType%bnd_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! -- dummy class(RivType) :: this -! ------------------------------------------------------------------------------ + ! riv_obs_supported = .true. + ! + ! -- Return return end function riv_obs_supported + !> @brief Store observation type supported by RIV package + !! + !! Overrides BndType%bnd_df_obs + !< subroutine riv_df_obs(this) - ! ****************************************************************************** - ! riv_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by RIV package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none ! -- dummy class(RivType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('riv', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! @@ -344,39 +410,76 @@ subroutine riv_df_obs(this) call this%obs%StoreObsType('to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine riv_df_obs - ! -- Procedure related to time series - - subroutine riv_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In RIV package variables STAGE, COND, and RBOT - ! can be controlled by time series. + !> @brief Store user-specified conductance value + !< + subroutine riv_store_user_cond(this) ! -- dummy - class(RivType), intent(inout) :: this + class(RivType), intent(inout) :: this !< BndExtType object ! -- local - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - select case (tslink%JCol) - case (1) - tslink%Text = 'STAGE' - case (2) - tslink%Text = 'COND' - case (3) - tslink%Text = 'RBOT' - end select - end if + integer(I4B) :: n + ! + ! -- store backup copy of conductance values + do n = 1, this%nbound + this%condinput(n) = this%cond_mult(n) end do ! + ! -- Return + return + end subroutine riv_store_user_cond + + !> @brief Apply multiplier to conductance if auxmultcol option is in use + !< + function cond_mult(this, row) result(cond) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy + class(RivType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: cond + ! + if (this%iauxmultcol > 0) then + cond = this%cond(row) * this%auxvar(this%iauxmultcol, row) + else + cond = this%cond(row) + end if + ! + ! -- Return + return + end function cond_mult + + !> @brief Return requested boundary value + !< + function riv_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy + class(RivType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%stage(row) + case (2) + bndval = this%cond_mult(row) + case (3) + bndval = this%rbot(row) + case default + errmsg = 'Programming error. RIV bound value requested column '& + &'outside range of ncolbnd (3).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + ! + ! -- Return return - end subroutine riv_rp_ts + end function riv_bound_value end module rivmodule diff --git a/src/Model/GroundWaterFlow/gwf3riv8idm.f90 b/src/Model/GroundWaterFlow/gwf3riv8idm.f90 new file mode 100644 index 00000000000..b32255ad30f --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3riv8idm.f90 @@ -0,0 +1,468 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfRivInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_riv_param_definitions + public gwf_riv_aggregate_definitions + public gwf_riv_block_definitions + public GwfRivParamFoundType + public gwf_riv_multi_package + + type GwfRivParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: mover = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: stage = .false. + logical :: cond = .false. + logical :: rbot = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfRivParamFoundType + + logical :: gwf_riv_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfriv_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_mover = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'OPTIONS', & ! block + 'MOVER', & ! tag name + 'MOVER', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_stage = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'STAGE', & ! tag name + 'STAGE', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_cond = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'COND', & ! tag name + 'COND', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_rbot = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'RBOT', & ! tag name + 'RBOT', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfriv_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_riv_param_definitions(*) = & + [ & + gwfriv_auxiliary, & + gwfriv_auxmultname, & + gwfriv_boundnames, & + gwfriv_iprpak, & + gwfriv_iprflow, & + gwfriv_ipakcb, & + gwfriv_ts_filerecord, & + gwfriv_ts6, & + gwfriv_filein, & + gwfriv_ts6_filename, & + gwfriv_obs_filerecord, & + gwfriv_obs6, & + gwfriv_obs6_filename, & + gwfriv_mover, & + gwfriv_maxbound, & + gwfriv_cellid, & + gwfriv_stage, & + gwfriv_cond, & + gwfriv_rbot, & + gwfriv_auxvar, & + gwfriv_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfriv_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'RIV', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID STAGE COND RBOT AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_riv_aggregate_definitions(*) = & + [ & + gwfriv_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_riv_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfRivInputModule diff --git a/src/Model/GroundWaterFlow/gwf3sfr8.f90 b/src/Model/GroundWaterFlow/gwf3sfr8.f90 index 2a043350ec7..c9a4141fc9d 100644 --- a/src/Model/GroundWaterFlow/gwf3sfr8.f90 +++ b/src/Model/GroundWaterFlow/gwf3sfr8.f90 @@ -28,7 +28,7 @@ module SfrModule use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr use TableModule, only: TableType, table_cr use ObserveModule, only: ObserveType - use InputOutputModule, only: extract_idnum_or_bndname + use InputOutputModule, only: extract_idnum_or_bndname, upcase use BaseDisModule, only: DisBaseType use SimModule, only: count_errors, store_error, store_error_unit, & store_warning, deprecation_warning @@ -844,7 +844,6 @@ subroutine sfr_read_packagedata(this) ! -- local variables character(len=LINELENGTH) :: text character(len=LINELENGTH) :: cellid - character(len=LINELENGTH) :: keyword character(len=10) :: cnum character(len=LENBOUNDNAME) :: bndName character(len=LENBOUNDNAME) :: bndNameTemp @@ -904,19 +903,30 @@ subroutine sfr_read_packagedata(this) call this%parser%GetCellid(this%dis%ndim, cellid, flag_string=.true.) this%igwfnode(n) = this%dis%noder_from_cellid(cellid, this%inunit, & this%iout, & - flag_string=.true.) + flag_string=.true., & + allow_zero=.true.) this%igwftopnode(n) = this%igwfnode(n) ! ! -- read the cellid string and determine if 'none' is specified if (this%igwfnode(n) < 1) then - call this%parser%GetStringCaps(keyword) this%ianynone = this%ianynone + 1 - if (keyword /= 'NONE') then + call upcase(cellid) + if (cellid == 'NONE') then + call this%parser%GetStringCaps(cellid) + ! + ! -- create warning message write (cnum, '(i0)') n - errmsg = 'Cell ID ('//trim(cellid)// & - ') for unconnected reach '//trim(cnum)// & - ' must be NONE' - call store_error(errmsg) + warnmsg = 'CELLID for unconnected reach '//trim(cnum)// & + ' specified to be NONE. Unconnected reaches '// & + 'should be specified with a zero for each grid '// & + 'dimension. For example, for a DIS grid a CELLID '// & + 'of 0 0 0 should be specified for unconnected reaches' + ! + ! -- create deprecation warning + call deprecation_warning('PACKAGEDATA', 'CELLID=NONE', '6.5.0', & + warnmsg, this%parser%GetUnit()) + else + end if end if ! -- get reach length @@ -1945,14 +1955,12 @@ end subroutine sfr_ad !! added to the coefficient matrix and right-hand side vector. !! !< - subroutine sfr_cf(this, reset_mover) + subroutine sfr_cf(this) ! -- dummy variables class(SfrType) :: this !< SfrType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover ! -- local variables integer(I4B) :: n integer(I4B) :: igwfnode - logical(LGP) :: lrm ! ! -- return if no sfr reaches if (this%nbound == 0) return @@ -1969,13 +1977,6 @@ subroutine sfr_cf(this, reset_mover) this%nodelist(n) = igwfnode end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- return return end subroutine sfr_cf @@ -2694,9 +2695,11 @@ subroutine sfr_da(this) ! ! -- deallocate package csv table if (this%ipakcsv > 0) then - call this%pakcsvtab%table_da() - deallocate (this%pakcsvtab) - nullify (this%pakcsvtab) + if (associated(this%pakcsvtab)) then + call this%pakcsvtab%table_da() + deallocate (this%pakcsvtab) + nullify (this%pakcsvtab) + end if end if ! ! -- deallocate scalars @@ -3833,6 +3836,10 @@ subroutine sfr_update_flows(this, n, qd, qgwf) do i = this%ia(n) + 1, this%ia(n + 1) - 1 if (this%idir(i) > 0) cycle this%qconn(i) = DZERO + idiv = this%idiv(i) + if (idiv == 0) cycle + jpos = this%iadiv(n) + idiv - 1 + this%divq(jpos) = DZERO end do end if ! diff --git a/src/Model/GroundWaterFlow/gwf3tvk8.f90 b/src/Model/GroundWaterFlow/gwf3tvk8.f90 index 48385d07329..e801efdbd6d 100644 --- a/src/Model/GroundWaterFlow/gwf3tvk8.f90 +++ b/src/Model/GroundWaterFlow/gwf3tvk8.f90 @@ -31,7 +31,9 @@ module TvkModule integer(I4B), pointer :: kchangeper => null() !< NPF last stress period in which any node K (or K22, or K33) values were changed (0 if unchanged from start of simulation) integer(I4B), pointer :: kchangestp => null() !< NPF last time step in which any node K (or K22, or K33) values were changed (0 if unchanged from start of simulation) integer(I4B), dimension(:), pointer, contiguous :: nodekchange => null() !< NPF grid array of flags indicating for each node whether its K (or K22, or K33) value changed (1) at (kchangeper, kchangestp) or not (0) + contains + procedure :: da => tvk_da procedure :: ar_set_pointers => tvk_ar_set_pointers procedure :: read_option => tvk_read_option @@ -46,10 +48,9 @@ module TvkModule !> @brief Create a new TvkType object !! !! Create a new time-varying conductivity (TvkType) object. - !! !< subroutine tvk_cr(tvk, name_model, inunit, iout) - ! -- dummy variables + ! -- dummy type(TvkType), pointer, intent(out) :: tvk character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit @@ -58,6 +59,7 @@ subroutine tvk_cr(tvk, name_model, inunit, iout) allocate (tvk) call tvk%init(name_model, 'TVK', 'TVK', inunit, iout) ! + ! -- Return return end subroutine tvk_cr @@ -65,12 +67,11 @@ end subroutine tvk_cr !! !! Announce package version and set array and variable pointers from the NPF !! package for access by TVK. - !! !< subroutine tvk_ar_set_pointers(this) - ! -- dummy variables + ! -- dummy class(TvkType) :: this - ! -- local variables + ! -- local character(len=LENMEMPATH) :: npfMemoryPath ! -- formats character(len=*), parameter :: fmttvk = & @@ -92,6 +93,7 @@ subroutine tvk_ar_set_pointers(this) call mem_setptr(this%kchangestp, 'KCHANGESTP', npfMemoryPath) call mem_setptr(this%nodekchange, 'NODEKCHANGE', npfMemoryPath) ! + ! -- Return return end subroutine tvk_ar_set_pointers @@ -99,10 +101,9 @@ end subroutine tvk_ar_set_pointers !! !! Process a single TVK-specific option. Used when reading the OPTIONS block !! of the TVK package input file. - !! !< function tvk_read_option(this, keyword) result(success) - ! -- dummy variables + ! -- dummy class(TvkType) :: this character(len=*), intent(in) :: keyword ! -- return @@ -111,6 +112,7 @@ function tvk_read_option(this, keyword) result(success) ! -- There are no TVK-specific options, so just return false success = .false. ! + ! -- Return return end function tvk_read_option @@ -118,10 +120,9 @@ end function tvk_read_option !! !! Return a pointer to the given node's value in the appropriate NPF array !! based on the given variable name string. - !! !< function tvk_get_pointer_to_value(this, n, varName) result(bndElem) - ! -- dummy variables + ! -- dummy class(TvkType) :: this integer(I4B), intent(in) :: n character(len=*), intent(in) :: varName @@ -139,6 +140,7 @@ function tvk_get_pointer_to_value(this, n, varName) result(bndElem) bndElem => null() end select ! + ! -- Return return end function tvk_get_pointer_to_value @@ -146,10 +148,9 @@ end function tvk_get_pointer_to_value !! !! Deferred procedure implementation called by the TvBaseType code when a !! property value change occurs at (kper, kstp). - !! !< subroutine tvk_set_changed_at(this, kper, kstp) - ! -- dummy variables + ! -- dummy class(TvkType) :: this integer(I4B), intent(in) :: kper integer(I4B), intent(in) :: kstp @@ -157,6 +158,7 @@ subroutine tvk_set_changed_at(this, kper, kstp) this%kchangeper = kper this%kchangestp = kstp ! + ! -- Return return end subroutine tvk_set_changed_at @@ -165,7 +167,6 @@ end subroutine tvk_set_changed_at !! Deferred procedure implementation called by the TvBaseType code when a !! new time step commences, indicating that any previously set per-node !! property value change flags should be reset. - !! !< subroutine tvk_reset_change_flags(this) ! -- dummy variables @@ -178,6 +179,7 @@ subroutine tvk_reset_change_flags(this) this%nodekchange(i) = 0 end do ! + ! -- Return return end subroutine tvk_reset_change_flags @@ -187,14 +189,13 @@ end subroutine tvk_reset_change_flags !! property value change occurs. Check if the property value of the given !! variable at the given node is invalid, and log an error if so. Update !! K22 and K33 values appropriately when specified as anisotropy. - !! !< subroutine tvk_validate_change(this, n, varName) - ! -- dummy variables + ! -- dummy class(TvkType) :: this integer(I4B), intent(in) :: n character(len=*), intent(in) :: varName - ! -- local variables + ! -- local character(len=LINELENGTH) :: cellstr ! -- formats character(len=*), parameter :: fmtkerr = & @@ -234,16 +235,16 @@ subroutine tvk_validate_change(this, n, varName) end if end if ! + ! -- Return return end subroutine tvk_validate_change !> @brief Deallocate package memory !! !! Deallocate TVK package scalars and arrays. - !! !< subroutine tvk_da(this) - ! -- dummy variables + ! -- dummy class(TvkType) :: this ! ! -- Nullify pointers to other package variables @@ -259,6 +260,7 @@ subroutine tvk_da(this) ! -- Deallocate parent call tvbase_da(this) ! + ! -- Return return end subroutine tvk_da diff --git a/src/Model/GroundWaterFlow/gwf3tvs8.f90 b/src/Model/GroundWaterFlow/gwf3tvs8.f90 index 390810b77e2..e516424c4fe 100644 --- a/src/Model/GroundWaterFlow/gwf3tvs8.f90 +++ b/src/Model/GroundWaterFlow/gwf3tvs8.f90 @@ -27,7 +27,9 @@ module TvsModule integer(I4B), pointer :: iusesy => null() !< STO flag set if any cell is convertible (0, 1) real(DP), dimension(:), pointer, contiguous :: ss => null() !< STO specfic storage or storage coefficient real(DP), dimension(:), pointer, contiguous :: sy => null() !< STO specific yield + contains + procedure :: da => tvs_da procedure :: ar_set_pointers => tvs_ar_set_pointers procedure :: read_option => tvs_read_option @@ -42,10 +44,9 @@ module TvsModule !> @brief Create a new TvsType object !! !! Create a new time-varying storage (TVS) object. - !! !< subroutine tvs_cr(tvs, name_model, inunit, iout) - ! -- dummy variables + ! -- dummy type(TvsType), pointer, intent(out) :: tvs character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit @@ -54,6 +55,7 @@ subroutine tvs_cr(tvs, name_model, inunit, iout) allocate (tvs) call tvs%init(name_model, 'TVS', 'TVS', inunit, iout) ! + ! -- Return return end subroutine tvs_cr @@ -61,12 +63,11 @@ end subroutine tvs_cr !! !! Announce package version, set array and variable pointers from the STO !! package for access by TVS, and enable storage change integration. - !! !< subroutine tvs_ar_set_pointers(this) - ! -- dummy variables + ! -- dummy class(TvsType) :: this - ! -- local variables + ! -- local character(len=LENMEMPATH) :: stoMemoryPath ! -- formats character(len=*), parameter :: fmttvs = & @@ -87,6 +88,7 @@ subroutine tvs_ar_set_pointers(this) ! -- Instruct STO to integrate storage changes, since TVS is active this%integratechanges = 1 ! + ! -- Return return end subroutine tvs_ar_set_pointers @@ -94,10 +96,9 @@ end subroutine tvs_ar_set_pointers !! !! Process a single TVS-specific option. Used when reading the OPTIONS block !! of the TVS package input file. - !! !< function tvs_read_option(this, keyword) result(success) - ! -- dummy variables + ! -- dummy class(TvsType) :: this character(len=*), intent(in) :: keyword ! -- return @@ -116,6 +117,7 @@ function tvs_read_option(this, keyword) result(success) success = .false. end select ! + ! -- Return return end function tvs_read_option @@ -123,10 +125,9 @@ end function tvs_read_option !! !! Return a pointer to the given node's value in the appropriate STO array !! based on the given variable name string. - !! !< function tvs_get_pointer_to_value(this, n, varName) result(bndElem) - ! -- dummy variables + ! -- dummy class(TvsType) :: this integer(I4B), intent(in) :: n character(len=*), intent(in) :: varName @@ -142,6 +143,7 @@ function tvs_get_pointer_to_value(this, n, varName) result(bndElem) bndElem => null() end select ! + ! -- Return return end function tvs_get_pointer_to_value @@ -149,10 +151,9 @@ end function tvs_get_pointer_to_value !! !! Deferred procedure implementation called by the TvBaseType code when a !! property value change occurs at (kper, kstp). - !! !< subroutine tvs_set_changed_at(this, kper, kstp) - ! -- dummy variables + ! -- dummy class(TvsType) :: this integer(I4B), intent(in) :: kper integer(I4B), intent(in) :: kstp @@ -160,6 +161,7 @@ subroutine tvs_set_changed_at(this, kper, kstp) ! -- No need to record TVS/STO changes, as no other packages cache ! -- Ss or Sy values ! + ! -- Return return end subroutine tvs_set_changed_at @@ -168,14 +170,15 @@ end subroutine tvs_set_changed_at !! Deferred procedure implementation called by the TvBaseType code when a !! new time step commences, indicating that any previously set per-node !! property value change flags should be reset. - !! !< subroutine tvs_reset_change_flags(this) + ! -- dummy class(TvsType) :: this ! ! -- No need to record TVS/STO changes, as no other packages cache ! -- Ss or Sy values ! + ! -- Return return end subroutine tvs_reset_change_flags @@ -184,14 +187,13 @@ end subroutine tvs_reset_change_flags !! Deferred procedure implementation called by the TvBaseType code after a !! property value change occurs. Check if the property value of the given !! variable at the given node is invalid, and log an error if so. - !! !< subroutine tvs_validate_change(this, n, varName) - ! -- dummy variables + ! -- dummy class(TvsType) :: this integer(I4B), intent(in) :: n character(len=*), intent(in) :: varName - ! -- local variables + ! -- local character(len=LINELENGTH) :: cellstr ! -- formats character(len=*), parameter :: fmtserr = & @@ -223,16 +225,16 @@ subroutine tvs_validate_change(this, n, varName) end if end if ! + ! -- Return return end subroutine tvs_validate_change !> @brief Deallocate package memory !! !! Deallocate TVS package scalars and arrays. - !! !< subroutine tvs_da(this) - ! -- dummy variables + ! -- dummy class(TvsType) :: this ! ! -- Nullify pointers to other package variables @@ -244,6 +246,7 @@ subroutine tvs_da(this) ! -- Deallocate parent call tvbase_da(this) ! + ! -- Return return end subroutine tvs_da diff --git a/src/Model/GroundWaterFlow/gwf3uzf8.f90 b/src/Model/GroundWaterFlow/gwf3uzf8.f90 index 51204499414..d8b7019fc6a 100644 --- a/src/Model/GroundWaterFlow/gwf3uzf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3uzf8.f90 @@ -10,7 +10,6 @@ module UzfModule DHNOFLO, DHDRY, & TABLEFT, TABCENTER, TABRIGHT, & TABSTRING, TABUCSTRING, TABINTEGER, TABREAL - use GenericUtilitiesModule, only: sim_message use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr, & mem_deallocate use MemoryHelperModule, only: create_mem_path @@ -169,15 +168,9 @@ module UzfModule contains + !> @brief Create a New UZF Package and point packobj to the new package + !< subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! uzf_create -- Create a New UZF Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -190,7 +183,6 @@ subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) character(len=*), intent(in) :: pakname ! -- local type(UzfType), pointer :: uzfobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (uzfobj) @@ -215,17 +207,13 @@ subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%isadvpak = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine uzf_create + !> @brief Allocate and Read + !< subroutine uzf_ar(this) -! ****************************************************************************** -! uzf_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_reallocate ! -- dummy @@ -233,7 +221,6 @@ subroutine uzf_ar(this) ! -- local integer(I4B) :: n, i real(DP) :: hgwf -! ------------------------------------------------------------------------------ ! call this%obs%obs_ar() ! @@ -269,24 +256,18 @@ subroutine uzf_ar(this) call this%pakmvrobj%ar(this%maxbound, this%maxbound, this%memoryPath) end if ! - ! -- return + ! -- Return return end subroutine uzf_ar + !> @brief Allocate arrays used for uzf + !< subroutine uzf_allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- allocate arrays used for uzf -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfType), intent(inout) :: this ! -- local integer(I4B) :: i integer(I4B) :: j -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars (now done from AR) !call this%BndType%allocate_arrays() @@ -309,11 +290,11 @@ subroutine uzf_allocate_arrays(this) call mem_allocate(this%rch0, this%nodes, 'RCH0', this%memoryPath) call mem_allocate(this%qsto, this%nodes, 'QSTO', this%memoryPath) call mem_allocate(this%deriv, this%nodes, 'DERIV', this%memoryPath) - + ! ! -- integer vectors call mem_allocate(this%ia, this%dis%nodes + 1, 'IA', this%memoryPath) call mem_allocate(this%ja, this%nodes, 'JA', this%memoryPath) - + ! ! -- allocate timeseries aware variables call mem_allocate(this%sinf, this%nodes, 'SINF', this%memoryPath) call mem_allocate(this%pet, this%nodes, 'PET', this%memoryPath) @@ -324,7 +305,7 @@ subroutine uzf_allocate_arrays(this) call mem_allocate(this%rootact, this%nodes, 'ROOTACT', this%memoryPath) call mem_allocate(this%uauxvar, this%naux, this%nodes, 'UAUXVAR', & this%memoryPath) - + ! ! -- initialize do i = 1, this%nodes this%appliedinf(i) = DZERO @@ -388,20 +369,16 @@ subroutine uzf_allocate_arrays(this) this%qauxcbc(i) = DZERO end do ! - ! -- return + ! -- Return return end subroutine uzf_allocate_arrays -! + !> @brief Set options specific to UzfType + !! + !! Overrides BoundaryPackageType%child_class_options + !< subroutine uzf_options(this, option, found) -! ****************************************************************************** -! uzf_options -- set options specific to UzfType -! -! uzf_options overrides BoundaryPackageType%child_class_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DZERO, MNORMAL use OpenSpecModule, only: access, form use SimModule, only: store_error @@ -436,8 +413,6 @@ subroutine uzf_options(this, option, found) &a, /4x, 'OPENED ON UNIT: ', I0)" character(len=*), parameter :: fmtuzfopt = & &"(4x, 'UZF ', a, ' VALUE (',g15.7,') SPECIFIED.')" - -! ------------------------------------------------------------------------------ ! ! found = .true. @@ -541,26 +516,20 @@ subroutine uzf_options(this, option, found) ! -- No options found found = .false. end select - ! -- return + ! -- Return return end subroutine uzf_options ! + !> @brief Set dimensions specific to UzfType + !< subroutine uzf_readdimensions(this) -! ****************************************************************************** -! uzf_readdimensions -- set dimensions specific to UzfType -! -! uzf_readdimensions BoundaryPackageType%readdimensions -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors class(uzftype), intent(inout) :: this character(len=LINELENGTH) :: keyword integer(I4B) :: ierr logical :: isfound, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- initialize dimensions to -1 this%nodes = -1 @@ -659,20 +628,17 @@ subroutine uzf_readdimensions(this) ! -- setup the budget object call this%uzf_setup_budobj() ! - ! -- return + ! -- Return return end subroutine uzf_readdimensions + !> @brief Read stress data + !! + !! - check if bc changes + !! - read new bc for stress period + !! - set kinematic variables to bc values + !< subroutine uzf_rp(this) -! ****************************************************************************** -! uzf_rp -- Read stress data -! Subroutine: (1) check if bc changes -! (2) read new bc for stress period -! (3) set kinematic variables to bc values -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kper, nper use TimeSeriesManagerModule, only: read_value_or_time_series_adv @@ -708,7 +674,6 @@ subroutine uzf_rp(this) &WHENEVER ICBCFL IS NOT ZERO.')" character(len=*), parameter :: fmtflow = & &"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)" -! ------------------------------------------------------------------------------ ! ! -- Set ionper to the stress period number for which a new block of data ! will be read. @@ -958,17 +923,13 @@ subroutine uzf_rp(this) ! -- Save old ss flag this%issflagold = this%issflag ! - ! -- return + ! -- Return return end subroutine uzf_rp + !> @brief Advance UZF Package + !< subroutine uzf_ad(this) -! ****************************************************************************** -! uzf_ad -- Advance UZF Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: iFailedStepRetry ! -- dummy @@ -978,7 +939,6 @@ subroutine uzf_ad(this) integer(I4B) :: ivertflag integer(I4B) :: n, iaux real(DP) :: rval1, rval2, rval3 -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -1069,23 +1029,17 @@ subroutine uzf_ad(this) return end subroutine uzf_ad - subroutine uzf_cf(this, reset_mover) -! ****************************************************************************** -! uzf_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no UZF cells -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! - skip if no UZF cells + !! - calculate hcof and rhs + !< + subroutine uzf_cf(this) ! -- modules ! -- dummy class(UzfType) :: this - logical, intent(in), optional :: reset_mover ! -- locals integer(I4B) :: n - logical :: lrm -! ------------------------------------------------------------------------------ ! ! -- Return if no UZF cells if (this%nodes == 0) return @@ -1098,24 +1052,13 @@ subroutine uzf_cf(this, reset_mover) this%gwd0(n) = this%gwd(n) end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! - ! -- return + ! -- Return return end subroutine uzf_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! uzf_fc -- Copy rhs and hcof into solution rhs and amat -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -1124,7 +1067,6 @@ subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, n, ipos -! ------------------------------------------------------------------------------ ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -1143,17 +1085,13 @@ subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) end do ! - ! -- return + ! -- Return return end subroutine uzf_fc -! + + !> @brief Fill newton terms + !< subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! uzf_fn -- Fill newton terms -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(UzfType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -1163,7 +1101,6 @@ subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) ! -- local integer(I4B) :: i, n integer(I4B) :: ipos -! -------------------------------------------------------------------------- ! ! -- Add derivative terms to rhs and amat do i = 1, this%nodes @@ -1173,17 +1110,14 @@ subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) rhs(n) = rhs(n) + this%deriv(i) * this%xnew(n) end do ! - ! -- return + ! -- Return return end subroutine uzf_fn + !> @brief Final convergence check for package + !< subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) -! ************************************************************************** -! uzf_cc -- Final convergence check for package -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: totim, kstp, kper, delt ! -- dummy class(Uzftype), intent(inout) :: this @@ -1217,8 +1151,6 @@ subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) real(DP) :: dseepmax real(DP) :: dqfrommvr real(DP) :: dqfrommvrmax - ! format -! -------------------------------------------------------------------------- ! ! -- initialize local variables icheck = this%iconvchk @@ -1409,17 +1341,13 @@ subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) end if end if ! - ! -- return + ! -- Return return end subroutine uzf_cc + !> @brief Calculate flows + !< subroutine uzf_cq(this, x, flowja, iadv) -! ************************************************************************** -! uzf_cq -- Calculate flows -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- modules use TdisModule, only: delt use ConstantsModule, only: LENBOUNDNAME, DZERO, DHNOFLO, DHDRY @@ -1440,7 +1368,6 @@ subroutine uzf_cq(this, x, flowja, iadv) ! -- formats character(len=*), parameter :: fmttkk = & &"(1X,/1X,A,' PERIOD ',I0,' STEP ',I0)" -! ------------------------------------------------------------------------------ ! ! -- Make uzf solution for budget calculations, and then reset waves. ! Final uzf solve will be done as part of ot(). @@ -1518,12 +1445,13 @@ subroutine uzf_cq(this, x, flowja, iadv) ! -- fill the budget object call this%uzf_fill_budobj() ! - ! -- return + ! -- Return return end subroutine uzf_cq function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & thtr, delt, iss) result(qsto) + ! -- dummy real(DP), intent(in) :: top real(DP), intent(in) :: bot real(DP), intent(in) :: hold @@ -1534,7 +1462,9 @@ function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & real(DP), intent(in) :: carea real(DP), intent(in) :: delt integer(I4B) :: iss + ! -- return real(DP) :: qsto + ! -- local real(DP) :: thknew real(DP) :: thkold if (iss == 0) then @@ -1551,9 +1481,13 @@ function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & else qsto = DZERO end if + ! + ! -- Return return end function get_storage_change + !> @brief Add package ratin/ratout to model budget + !< subroutine uzf_bd(this, model_budget) ! -- add package ratin/ratout to model budget use TdisModule, only: delt @@ -1564,12 +1498,12 @@ subroutine uzf_bd(this, model_budget) real(DP) :: ratout integer(I4B) :: isuppress_output isuppress_output = 0 - + ! ! -- Calculate flow from uzf to gwf (UZF-GWRCH) call rate_accumulator(this%rch, ratin, ratout) call model_budget%addentry(ratin, ratout, delt, this%bdtxt(2), & isuppress_output, this%packName) - + ! ! -- GW discharge and GW discharge to mover if (this%iseepflag == 1) then call rate_accumulator(-this%gwd, ratin, ratout) @@ -1581,24 +1515,21 @@ subroutine uzf_bd(this, model_budget) isuppress_output, this%packName) end if end if - + ! ! -- groundwater et (gwet array is positive, so switch ratin/ratout) if (this%igwetflag /= 0) then call rate_accumulator(-this%gwet, ratin, ratout) call model_budget%addentry(ratin, ratout, delt, this%bdtxt(4), & isuppress_output, this%packName) end if - + ! + ! -- Return return end subroutine uzf_bd + !> @brief Write flows to binary file and/or print flows to budget + !< subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) -! ****************************************************************************** -! bnd_ot_model_flows -- write flows to binary file and/or print flows to budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, DZERO use BndModule, only: save_print_model_flows @@ -1611,8 +1542,6 @@ subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) ! -- local character(len=LINELENGTH) :: title integer(I4B) :: itxt - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- UZF-GWRCH itxt = 2 @@ -1672,12 +1601,16 @@ subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) this%boundname) end if ! - ! -- return + ! -- Return return end subroutine uzf_ot_model_flows + !> @brief Output UZF package flow terms + !< subroutine uzf_ot_package_flows(this, icbcfl, ibudfl) + ! -- modules use TdisModule, only: kstp, kper, delt, pertim, totim + ! -- dummy class(UzfType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl @@ -1698,15 +1631,22 @@ subroutine uzf_ot_package_flows(this, icbcfl, ibudfl) if (ibudfl /= 0 .and. this%iprflow /= 0) then call this%budobj%write_flowtable(this%dis, kstp, kper) end if - + ! + ! -- Return + return end subroutine uzf_ot_package_flows + !> @brief Save UZF-calculated values to binary file + !< subroutine uzf_ot_dv(this, idvsave, idvprint) + ! -- modules use TdisModule, only: kstp, kper, pertim, totim + ! -- dummy use InputOutputModule, only: ulasav class(UzfType) :: this integer(I4B), intent(in) :: idvsave integer(I4B), intent(in) :: idvprint + ! -- local integer(I4B) :: ibinun ! ! -- set unit number for binary dependent variable output @@ -1721,8 +1661,13 @@ subroutine uzf_ot_dv(this, idvsave, idvprint) call ulasav(this%wcnew, ' WATER-CONTENT', kstp, kper, pertim, & totim, this%nodes, 1, 1, ibinun) end if + ! + ! -- Return + return end subroutine uzf_ot_dv + !> @brief Write UZF budget to listing file + !< subroutine uzf_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! -- module use TdisModule, only: totim @@ -1735,17 +1680,13 @@ subroutine uzf_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim) ! - ! -- return + ! -- Return return end subroutine uzf_ot_bdsummary + !> @brief Formulate the HCOF and RHS terms + !< subroutine uzf_solve(this, reset_state) -! ****************************************************************************** -! uzf_solve -- Formulate the HCOF and RHS terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt logical, intent(in) :: reset_state !< flag indicating that waves should be reset after solution @@ -1760,7 +1701,6 @@ subroutine uzf_solve(this, reset_state) real(DP) :: qformvr real(DP) :: wc real(DP) :: watabold -! ------------------------------------------------------------------------------ ! ! -- Initialize ierr = 0 @@ -1862,20 +1802,16 @@ subroutine uzf_solve(this, reset_state) end if end do ! - ! -- return + ! -- Return return end subroutine uzf_solve + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(UzfType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -1894,18 +1830,21 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel + !> @brief Identify overlying cell ID based on user-specified mapping + !< subroutine findcellabove(this, n, nml) + ! -- dummy class(UzfType) :: this integer(I4B), intent(in) :: n integer(I4B), intent(inout) :: nml + ! -- local integer(I4B) :: m, ipos -! ------------------------------------------------------------------------------ -! - ! -- return nml = n if no cell is above it + ! + ! -- Return nml = n if no cell is above it nml = n do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 m = this%dis%con%ja(ipos) @@ -1918,17 +1857,17 @@ subroutine findcellabove(this, n, nml) end if end if end do + ! + ! -- Return return end subroutine findcellabove + !> @brief Read UZF cell properties and set them for UzfCellGroup type + !< subroutine read_cell_properties(this) -! ****************************************************************************** -! read_cell_properties -- Read UZF cell properties and set them for -! UzfCellGroup type. -! ****************************************************************************** + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType), intent(inout) :: this ! -- local @@ -1945,8 +1884,6 @@ subroutine read_cell_properties(this) integer(I4B), dimension(:), allocatable :: rowmaxnnz type(sparsematrix) :: sparse integer(I4B), dimension(:), allocatable :: nboundchk -! ------------------------------------------------------------------------------ -! ! ! -- allocate space for node counter and initilize allocate (rowmaxnnz(this%dis%nodes)) @@ -2158,16 +2095,13 @@ subroutine read_cell_properties(this) deallocate (rowmaxnnz) deallocate (nboundchk) ! - ! -- return + ! -- Return return end subroutine read_cell_properties + !> @brief Read UZF cell properties and set them for UZFCellGroup type + !< subroutine print_cell_properties(this) -! ****************************************************************************** -! print_cell_properties -- Read UZF cell properties and set them for -! UZFCellGroup type. -! ****************************************************************************** -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType), intent(inout) :: this ! -- local @@ -2178,8 +2112,6 @@ subroutine print_cell_properties(this) integer(I4B) :: ntabcols integer(I4B) :: i integer(I4B) :: node -! ------------------------------------------------------------------------------ -! ! ! -- setup inputtab tableobj ! @@ -2247,17 +2179,16 @@ subroutine print_cell_properties(this) end if end do ! - ! -- return + ! -- Return return end subroutine print_cell_properties + !> @brief Check UZF cell areas + !< subroutine check_cell_area(this) -! ****************************************************************************** -! check_cell_area -- Check UZF cell areas. -! ****************************************************************************** + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this ! -- local @@ -2275,8 +2206,6 @@ subroutine check_cell_area(this) real(DP) :: sumarea real(DP) :: cellarea real(DP) :: d -! ------------------------------------------------------------------------------ -! ! ! -- check that the area of vertically connected uzf cells is the equal do i = 1, this%nodes @@ -2331,40 +2260,36 @@ subroutine check_cell_area(this) if (count_errors() > 0) then call this%parser%StoreErrorUnit() end if - ! -- return + ! -- Return return end subroutine check_cell_area ! -- Procedures related to observations (type-bound) + + !> @brief Return true because uzf package supports observations + !! + !! Overrides BndType%bnd_obs_supported + !< logical function uzf_obs_supported(this) -! ****************************************************************************** -! uzf_obs_supported -! -- Return true because uzf package supports observations. -! -- Overrides BndType%bnd_obs_supported -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(UzfType) :: this -! ------------------------------------------------------------------------------ + ! uzf_obs_supported = .true. + ! + ! -- Return return end function uzf_obs_supported + !> @brief Implements bnd_df_obs + !! + !! Store observation type supported by uzf package. + !! Overrides BndType%bnd_df_obs + !< subroutine uzf_df_obs(this) -! ****************************************************************************** -! uzf_df_obs (implements bnd_df_obs) -! -- Store observation type supported by uzf package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! @@ -2416,19 +2341,14 @@ subroutine uzf_df_obs(this) call this%obs%StoreObsType('water-content', .false., indx) this%obs%obsData(indx)%ProcessIdPtr => uzf_process_obsID ! - ! -- return + ! -- Return return end subroutine uzf_df_obs -! + + !> @brief Calculate observations this time step and call ObsType%SaveOneSimval + !! for each UzfType observation + !< subroutine uzf_bd_obs(this) - ! ************************************************************************** - ! uzf_bd_obs - ! -- Calculate observations this time step and call - ! ObsType%SaveOneSimval for each UzfType observation. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(UzfType) :: this ! -- local @@ -2437,7 +2357,6 @@ subroutine uzf_bd_obs(this) integer(I4B) :: n real(DP) :: v type(ObserveType), pointer :: obsrv => null() - !--------------------------------------------------------------------------- ! ! -- Make final uzf solution, and do not reset waves. This will advance ! the waves to their new state at the end of the time step. This should @@ -2519,11 +2438,17 @@ subroutine uzf_bd_obs(this) end if end if ! - ! -- return + ! -- Return return end subroutine uzf_bd_obs -! + + !> @brief Process each observation + !! + !! Only done the first stress period since boundaries are fixed for the + !! simulation + !< subroutine uzf_rp_obs(this) + ! -- modules use TdisModule, only: kper ! -- dummy class(UzfType), intent(inout) :: this @@ -2537,13 +2462,9 @@ subroutine uzf_rp_obs(this) real(DP) :: dmax character(len=LENBOUNDNAME) :: bname class(ObserveType), pointer :: obsrv => null() - ! -------------------------------------------------------------------------- ! -- formats 60 format('Invalid node number in OBS input: ', i0) ! - ! -- process each package observation - ! only done the first stress period since boundaries are fixed - ! for the simulation if (kper == 1) then do i = 1, this%obs%npakobs obsrv => this%obs%pakobs(i)%obsrv @@ -2642,13 +2563,19 @@ subroutine uzf_rp_obs(this) end if end if ! + ! -- Return return end subroutine uzf_rp_obs - ! + ! -- Procedures related to observations (NOT type-bound) + + !> @brief This procedure is pointed to by ObsDataType%ProcesssIdPtr + !! + !! Process the ID string of an observation definition for UZF-package + !! observations + !< subroutine uzf_process_obsID(obsrv, dis, inunitobs, iout) - ! -- This procedure is pointed to by ObsDataType%ProcesssIdPtr. It processes - ! the ID string of an observation definition for UZF-package observations. + ! -- . ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -2693,22 +2620,17 @@ subroutine uzf_process_obsID(obsrv, dis, inunitobs, iout) obsrv%Obsdepth = obsdepth end if ! + ! -- Return return end subroutine uzf_process_obsID + !> @brief Allocate scalar members + !< subroutine uzf_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(UzfType) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_scalars() @@ -2736,7 +2658,7 @@ subroutine uzf_allocate_scalars(this) call mem_allocate(this%igwetflag, 'IGWETFLAG', this%memoryPath) call mem_allocate(this%iuzf2uzf, 'IUZF2UZF', this%memoryPath) call mem_allocate(this%cbcauxitems, 'CBCAUXITEMS', this%memoryPath) - + ! call mem_allocate(this%iconvchk, 'ICONVCHK', this%memoryPath) ! ! -- initialize scalars @@ -2761,30 +2683,24 @@ subroutine uzf_allocate_scalars(this) ! -- convergence check this%iconvchk = 1 ! - ! -- return + ! -- Return return end subroutine uzf_allocate_scalars -! + + !> @brief Deallocate objects + !< subroutine uzf_da(this) -! ****************************************************************************** -! uzf_da -- Deallocate objects -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(UzfType) :: this - ! -- locals - ! -- format -! ------------------------------------------------------------------------------ ! ! -- deallocate uzf objects call this%uzfobj%dealloc() deallocate (this%uzfobj) nullify (this%uzfobj) call this%uzfobjwork%dealloc() - + ! call this%budobj%budgetobject_da() deallocate (this%budobj) nullify (this%budobj) @@ -2796,9 +2712,11 @@ subroutine uzf_da(this) ! ! -- package csv table if (this%ipakcsv > 0) then - call this%pakcsvtab%table_da() - deallocate (this%pakcsvtab) - nullify (this%pakcsvtab) + if (associated(this%pakcsvtab)) then + call this%pakcsvtab%table_da() + deallocate (this%pakcsvtab) + nullify (this%pakcsvtab) + end if end if ! ! -- deallocate scalars @@ -2869,15 +2787,12 @@ subroutine uzf_da(this) return end subroutine uzf_da + !> @brief Set up the budget object that stores all the uzf flows + !! + !! The terms listed here must correspond in number and order to the ones + !! listed in the uzf_fill_budobj routine + !< subroutine uzf_setup_budobj(this) -! ****************************************************************************** -! uzf_setup_budobj -- Set up the budget object that stores all the uzf flows -! The terms listed here must correspond in number and order to the ones -! listed in the uzf_fill_budobj routine. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -2892,7 +2807,6 @@ subroutine uzf_setup_budobj(this) real(DP) :: q character(len=LENBUDTXT) :: text character(len=LENBUDTXT), dimension(1) :: auxtxt -! ------------------------------------------------------------------------------ ! ! -- Determine the number of uzf to uzf connections nlen = 0 @@ -3075,19 +2989,13 @@ subroutine uzf_setup_budobj(this) call this%budobj%flowtable_df(this%iout, cellids='GWF') end if ! - ! -- return + ! -- Return return - end subroutine uzf_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine uzf_fill_budobj(this) -! ****************************************************************************** -! uzf_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfType) :: this ! -- local @@ -3103,8 +3011,6 @@ subroutine uzf_fill_budobj(this) real(DP) :: thick real(DP) :: fm real(DP) :: v - ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 @@ -3236,7 +3142,7 @@ subroutine uzf_fill_budobj(this) ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return end subroutine uzf_fill_budobj diff --git a/src/Model/GroundWaterFlow/gwf3vsc8.f90 b/src/Model/GroundWaterFlow/gwf3vsc8.f90 index d803f5937ee..56af59c0424 100644 --- a/src/Model/GroundWaterFlow/gwf3vsc8.f90 +++ b/src/Model/GroundWaterFlow/gwf3vsc8.f90 @@ -64,6 +64,7 @@ module GwfVscModule integer(I4B), dimension(:), pointer, contiguous :: nodekchange => null() ! grid array of flags indicating for each node whether its K (or K22, or K33) value changed (1) at (kchangeper, kchangestp) or not (0) contains + procedure :: vsc_df procedure :: vsc_ar procedure, public :: vsc_ar_bnd @@ -90,16 +91,11 @@ module GwfVscModule contains + !> @brief Generic function to calculate changes in fluid viscosity using a + !! linear formulation + !< function calc_visc(ivisc, viscref, dviscdc, cviscref, conc, & a2, a3, a4) result(visc) -! ****************************************************************************** -! calc_visc -- generic function to calculate changes in fluid viscosity -! using a linear formulation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy integer(I4B), dimension(:), intent(in) :: ivisc real(DP), intent(in) :: viscref @@ -114,11 +110,10 @@ function calc_visc(ivisc, viscref, dviscdc, cviscref, conc, & integer(I4B) :: i real(DP) :: mu_t real(DP) :: expon -! ------------------------------------------------------------------------------ ! nviscspec = size(dviscdc) visc = viscref - + ! do i = 1, nviscspec if (ivisc(i) == 1) then visc = visc + dviscdc(i) * (conc(i) - cviscref(i)) @@ -136,14 +131,13 @@ function calc_visc(ivisc, viscref, dviscdc, cviscref, conc, & ! end if end do ! - ! -- return + ! -- Return return end function calc_visc !> @ brief Create a new package object !! !! Create a new VSC Package object. - !! !< subroutine vsc_cr(vscobj, name_model, inunit, iout) ! -- dummy @@ -151,7 +145,6 @@ subroutine vsc_cr(vscobj, name_model, inunit, iout) character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (vscobj) @@ -176,27 +169,23 @@ end subroutine vsc_cr !> @ brief Define viscosity package options and dimensions !! !! Define viscosity package options and dimensions - !! !< subroutine vsc_df(this, dis, vsc_input) - ! -- modules ! -- dummy class(GwfVscType) :: this !< this viscosity package class(DisBaseType), pointer, intent(in) :: dis !< pointer to discretization type(GwfVscInputDataType), optional, intent(in) :: vsc_input !< optional vsc input data, otherwise read from file - ! -- local ! -- formats character(len=*), parameter :: fmtvsc = & "(1x,/1x,'VSC -- Viscosity Package, version 1, 11/15/2022', & &' input read from unit ', i0, //)" -! ------------------------------------------------------------------------------ ! ! --print a message identifying the viscosity package write (this%iout, fmtvsc) this%inunit ! ! -- store pointers to arguments that were passed in this%dis => dis - + ! if (.not. present(vsc_input)) then ! ! -- Read viscosity options @@ -212,7 +201,7 @@ subroutine vsc_df(this, dis, vsc_input) ! ! -- Allocate arrays call this%allocate_arrays(dis%nodes) - + ! if (.not. present(vsc_input)) then ! ! -- Read viscosity packagedata @@ -230,16 +219,11 @@ end subroutine vsc_df !! !! Generic method to allocate and read static data for the viscosity !! package available within the GWF model type. - !! !< subroutine vsc_ar(this, ibound) - ! -- modules ! -- dummy class(GwfVscType) :: this integer(I4B), dimension(:), pointer :: ibound - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- store pointers to arguments that were passed in this%ibound => ibound @@ -256,7 +240,6 @@ end subroutine vsc_ar !! Viscosity ar_bnd rountine to activate viscosity in the advanced !! packages. This routine is called from gwf_ar() as it moves through each !! package - !! !< subroutine vsc_ar_bnd(this, packobj) ! -- modules @@ -270,8 +253,6 @@ subroutine vsc_ar_bnd(this, packobj) ! -- dummy class(GwfVscType) :: this class(BndType), pointer :: packobj - ! -- local - ! ---------------------------------------------------------------------------- ! ! -- Add density terms based on boundary package type select case (packobj%filtyp) @@ -303,7 +284,6 @@ subroutine vsc_ar_bnd(this, packobj) type is (LakType) call packobj%lak_activate_viscosity() end select - case ('SFR') ! ! -- activate viscosity for sfr package @@ -311,7 +291,6 @@ subroutine vsc_ar_bnd(this, packobj) type is (SfrType) call packobj%sfr_activate_viscosity() end select - case ('MAW') ! ! -- activate viscosity for maw package @@ -319,7 +298,6 @@ subroutine vsc_ar_bnd(this, packobj) type is (MawType) call packobj%maw_activate_viscosity() end select - case default ! ! -- nothing @@ -333,12 +311,11 @@ end subroutine vsc_ar_bnd !! !! Set array and variable pointers from the NPF !! package for access by VSC. - !! !< subroutine set_npf_pointers(this) - ! -- dummy variables + ! -- dummy class(GwfVscType) :: this - ! -- local variables + ! -- local character(len=LENMEMPATH) :: npfMemoryPath ! ! -- Set pointers to other package variables @@ -354,13 +331,13 @@ subroutine set_npf_pointers(this) call mem_setptr(this%kchangestp, 'KCHANGESTP', npfMemoryPath) call mem_setptr(this%nodekchange, 'NODEKCHANGE', npfMemoryPath) ! + ! -- Return return end subroutine set_npf_pointers !> @ brief Read new period data in viscosity package !! !! Method to read and prepare period data for the VSC package. - !! !< subroutine vsc_rp(this) ! -- modules @@ -376,7 +353,6 @@ subroutine vsc_rp(this) &for species ',i0,'. One or more model names may be specified & &incorrectly in the PACKAGEDATA block or a GWF-GWT exchange may need & &to be activated.')" -! ------------------------------------------------------------------------------ ! ! -- Check to make sure all concentration pointers have been set if (kstp * kper == 1) then @@ -391,22 +367,18 @@ subroutine vsc_rp(this) end if end if ! - ! -- return + ! -- Return return end subroutine vsc_rp !> @ brief Advance the viscosity package !! - !! Advance data in the VSC package. The method sets or - !! advances time series, time array series, and observation - !! data. - !! + !! Advance data in the VSC package. The method sets or advances time series, + !! time array series, and observation data. !< subroutine vsc_ad(this) ! -- dummy class(GwfVscType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- update viscosity using the latest concentration/temperature call this%vsc_calcvisc() @@ -519,6 +491,9 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & ivisc, a2, a3, a4, ctemp) ! -- modules use BndModule, only: BndType + use DrnModule, only: DrnType + use RivModule, only: RivType + use GhbModule, only: GhbType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -536,7 +511,6 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & integer(I4B) :: n integer(I4B) :: node real(DP) :: viscbnd -! ------------------------------------------------------------------------------- ! ! -- Process density terms for each GHB do n = 1, packobj%nbound @@ -551,8 +525,29 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & packobj%auxvar) ! ! -- update boundary conductance based on viscosity effects - packobj%bound(2, n) = update_bnd_cond(viscbnd, viscref, & + select case (packobj%filtyp) + case ('DRN') + select type (packobj) + type is (DrnType) + packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & + packobj%condinput(n)) + end select + case ('GHB') + select type (packobj) + type is (GhbType) + packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & + packobj%condinput(n)) + end select + case ('RIV') + select type (packobj) + type is (RivType) + packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & packobj%condinput(n)) + end select + case default + packobj%bound(2, n) = update_bnd_cond(viscbnd, viscref, & + packobj%condinput(n)) + end select ! end do ! @@ -586,7 +581,6 @@ subroutine vsc_ad_sfr(packobj, visc, viscref, elev, locvisc, locconc, & integer(I4B) :: n integer(I4B) :: node real(DP) :: viscsfr -! ------------------------------------------------------------------------------- ! ! -- update viscosity ratios for updating hyd. cond (and conductance) select type (packobj) @@ -644,7 +638,6 @@ subroutine vsc_ad_lak(packobj, visc, viscref, elev, locvisc, locconc, & integer(I4B) :: n integer(I4B) :: node real(DP) :: visclak -! ------------------------------------------------------------------------------- ! ! -- update viscosity ratios for updating hyd. cond (and conductance) select type (packobj) @@ -702,7 +695,6 @@ subroutine vsc_ad_maw(packobj, visc, viscref, elev, locvisc, locconc, & integer(I4B) :: n integer(I4B) :: node real(DP) :: viscmaw -! ------------------------------------------------------------------------------- ! ! -- update viscosity ratios for updating hyd. cond (and conductance) select type (packobj) @@ -740,7 +732,6 @@ end subroutine vsc_ad_maw !! active boundary package's conductance term. !< function update_bnd_cond(bndvisc, viscref, spcfdcond) result(updatedcond) - ! -- modules ! -- dummy real(DP), intent(in) :: viscref real(DP), intent(in) :: bndvisc @@ -748,7 +739,6 @@ function update_bnd_cond(bndvisc, viscref, spcfdcond) result(updatedcond) ! -- local real(DP) :: vscratio real(DP) :: updatedcond -! ------------------------------------------------------------------------------- ! vscratio = calc_vsc_ratio(viscref, bndvisc) ! @@ -767,7 +757,6 @@ function calc_vsc_ratio(viscref, bndvisc) result(viscratio) real(DP), intent(in) :: bndvisc ! -- local real(DP) :: viscratio -! ------------------------------------------------------------------------------- ! viscratio = viscref / bndvisc ! @@ -797,11 +786,10 @@ function calc_bnd_viscosity(n, locvisc, locconc, viscref, dviscdc, cviscref, & real(DP), dimension(:), intent(in) :: cviscref real(DP), dimension(:), intent(inout) :: ctemp real(DP), dimension(:, :), intent(in) :: auxvar - ! -- return + ! -- Return real(DP) :: viscbnd ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- assign boundary viscosity based on one of three options if (locvisc > 0) then @@ -821,7 +809,7 @@ function calc_bnd_viscosity(n, locvisc, locconc, viscref, dviscdc, cviscref, & viscbnd = viscref end if ! - ! -- return + ! -- Return return end function calc_bnd_viscosity @@ -842,8 +830,7 @@ subroutine get_visc_ratio(this, n, m, gwhdn, gwhdm, viscratio) real(DP), intent(inout) :: viscratio ! -- loca integer(I4B) :: cellid -! ------------------------------------------------------------------------------ -! + ! viscratio = DONE if (gwhdm > gwhdn) then cellid = m @@ -852,7 +839,7 @@ subroutine get_visc_ratio(this, n, m, gwhdn, gwhdm, viscratio) end if call this%calc_q_visc(cellid, viscratio) ! - ! -- return + ! -- Return return end subroutine get_visc_ratio @@ -866,11 +853,10 @@ subroutine calc_q_visc(this, cellid, viscratio) ! -- dummy variables class(GwfVscType) :: this integer(I4B), intent(in) :: cellid - ! -- return + ! -- Return real(DP), intent(inout) :: viscratio ! -- local real(DP) :: visc -! ------------------------------------------------------------------------------ ! ! -- Retrieve viscosity for the passed node number visc = this%visc(cellid) @@ -878,7 +864,7 @@ subroutine calc_q_visc(this, cellid, viscratio) ! -- Calculate the viscosity ratio for the viscratio = calc_vsc_ratio(this%viscref, visc) ! - ! -- return + ! -- Return return end subroutine calc_q_visc @@ -890,13 +876,11 @@ end subroutine calc_q_visc !! for each cell. !< subroutine update_k_with_vsc(this) - ! -- modules ! -- dummy class(GwfVscType) :: this ! -- local integer(I4B) :: n real(DP) :: viscratio -! ------------------------------------------------------------------------------ ! ! -- For viscosity-based K's, apply change of K to K11 by starting with ! user-specified K values and not the K's leftover from the last viscosity @@ -912,7 +896,7 @@ subroutine update_k_with_vsc(this) ! -- Flag kchange call this%vsc_set_changed_at(kper, kstp) ! - ! -- return + ! -- Return return end subroutine update_k_with_vsc @@ -920,7 +904,6 @@ end subroutine update_k_with_vsc !! !! Procedure called by VSC code when K updated due to viscosity changes. !! K values changed at (kper, kstp). - !! !< subroutine vsc_set_changed_at(this, kper, kstp) ! -- dummy variables @@ -931,13 +914,13 @@ subroutine vsc_set_changed_at(this, kper, kstp) this%kchangeper = kper this%kchangestp = kstp ! + ! -- Return return end subroutine vsc_set_changed_at !> @ brief Output viscosity package dependent-variable terms. !! !! Save calculated viscosity array to binary file - !! !< subroutine vsc_ot_dv(this, idvfl) ! -- dummy @@ -950,7 +933,6 @@ subroutine vsc_ot_dv(this, idvfl) integer(I4B) :: nvaluesp integer(I4B) :: nwidthp real(DP) :: dinact -! ------------------------------------------------------------------------------ ! ! -- Set unit number for viscosity output if (this%ioutvisc /= 0) then @@ -969,7 +951,7 @@ subroutine vsc_ot_dv(this, idvfl) if (this%ioutvisc /= 0) then ibinun = this%ioutvisc call this%dis%record_array(this%visc, this%iout, iprint, ibinun, & - ' VISCOSITY', cdatafmp, nvaluesp, & + ' VISCOSITY', cdatafmp, nvaluesp, & nwidthp, editdesc, dinact) end if end if @@ -981,13 +963,10 @@ end subroutine vsc_ot_dv !> @ brief Deallocate viscosity package memory !! !! Deallocate viscosity package scalars and arrays. - !! !< subroutine vsc_da(this) - ! -- modules ! -- dummy class(GwfVscType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate arrays if package was active if (this%inunit > 0) then @@ -1034,7 +1013,6 @@ end subroutine vsc_da !> @ brief Read dimensions !! !! Read dimensions for the viscosity package - !! !< subroutine read_dimensions(this) ! -- modules @@ -1044,8 +1022,6 @@ subroutine read_dimensions(this) character(len=LINELENGTH) :: errmsg, keyword integer(I4B) :: ierr logical :: isfound, endOfBlock - ! -- format -! ------------------------------------------------------------------------------ ! ! -- get dimensions block call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -1081,17 +1057,15 @@ subroutine read_dimensions(this) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine read_dimensions !> @ brief Read data for package !! !! Method to read data for the viscosity package. - !! !< subroutine read_packagedata(this) - ! -- modules ! -- dummy class(GwfVscType) :: this ! -- local @@ -1109,7 +1083,6 @@ subroutine read_packagedata(this) "('Invalid value for IRHOSPEC (',i0,') detected in VSC Package. & &IRHOSPEC must be > 0 and <= NVISCSPECIES, and duplicate values & &are not allowed.')" -! ------------------------------------------------------------------------------ ! ! -- initialize allocate (itemp(this%nviscspecies)) @@ -1191,41 +1164,41 @@ subroutine read_packagedata(this) ! write (this%iout, '(/,1x,a)') 'End of VSC PACKAGEDATA block' ! - ! -- return + ! -- Return return end subroutine read_packagedata !> @brief Sets package data instead of reading from file !< subroutine set_packagedata(this, input_data) + ! -- dummy class(GwfVscType) :: this !< this vscoancy pkg type(GwfVscInputDataType), intent(in) :: input_data !< the input data to be set - ! local + ! -- local integer(I4B) :: ispec - + ! do ispec = 1, this%nviscspecies this%dviscdc(ispec) = input_data%dviscdc(ispec) this%cviscref(ispec) = input_data%cviscref(ispec) this%cmodelname(ispec) = input_data%cmodelname(ispec) this%cauxspeciesname(ispec) = input_data%cauxspeciesname(ispec) end do - + ! + ! -- Return + return end subroutine set_packagedata !> @brief Calculate fluid viscosity !! !! Calculates fluid viscosity based on concentration or !! temperature - !! !< subroutine vsc_calcvisc(this) ! -- dummy class(GwfVscType) :: this - ! -- local integer(I4B) :: n integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- Calculate the viscosity using the specified concentration and/or ! temperature arrays @@ -1251,21 +1224,12 @@ end subroutine vsc_calcvisc !! !! Allocate and initialize scalars for the VSC package. The base model !! allocate scalars method is also called. - !! !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DZERO, DTEN, DEP3 ! -- dummy class(GwfVscType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -1303,16 +1267,13 @@ end subroutine allocate_scalars !> @ brief Allocate arrays !! !! Allocate and initialize arrays for the VSC package. - !! !< subroutine allocate_arrays(this, nodes) - ! -- modules ! -- dummy class(GwfVscType) :: this integer(I4B), intent(in) :: nodes ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- Allocate call mem_allocate(this%visc, nodes, 'VISC', this%memoryPath) @@ -1348,7 +1309,6 @@ end subroutine allocate_arrays !> @ brief Read Options block !! !! Reads the options block inside the VSC package. - !! !< subroutine read_options(this) ! -- modules @@ -1371,7 +1331,6 @@ subroutine read_options(this) character(len=*), parameter :: fmtnonlinear = & "(/,1x,'Viscosity will vary non-linearly with temperature & &change ')" -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, & @@ -1498,9 +1457,10 @@ end subroutine read_options !> @brief Sets options as opposed to reading them from a file !< subroutine set_options(this, input_data) + ! -- dummy class(GwfVscType) :: this type(GwfVscInputDataType), intent(in) :: input_data !< the input data to be set - + ! this%viscref = input_data%viscref ! ! -- Return @@ -1513,10 +1473,8 @@ end subroutine set_options !! and store a pointer to these in the VSC package so that !! viscosity can be calculated from them. This routine is called !! from the gwfgwt exchange in the exg_ar() method. - !! !< subroutine set_concentration_pointer(this, modelname, conc, icbund, istmpr) - ! -- modules ! -- dummy class(GwfVscType) :: this character(len=LENMODELNAME), intent(in) :: modelname @@ -1526,7 +1484,6 @@ subroutine set_concentration_pointer(this, modelname, conc, icbund, istmpr) ! -- local integer(I4B) :: i logical :: found -! ------------------------------------------------------------------------------ ! this%iconcset = 1 found = .false. diff --git a/src/Model/GroundWaterFlow/gwf3wel8.f90 b/src/Model/GroundWaterFlow/gwf3wel8.f90 index f06e2774b33..9bc5281412f 100644 --- a/src/Model/GroundWaterFlow/gwf3wel8.f90 +++ b/src/Model/GroundWaterFlow/gwf3wel8.f90 @@ -15,16 +15,15 @@ module WelModule ! -- modules used by WelModule methods use KindModule, only: DP, I4B - use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, DNODATA, MAXCHARLEN + use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, DNODATA, LINELENGTH use SimVariablesModule, only: errmsg - use SimModule, only: store_error + use SimModule, only: store_error, store_error_filename use MemoryHelperModule, only: create_mem_path use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObsModule, only: DefaultObsIdProcessor use SmoothingModule, only: sQSaturation, sQSaturationDerivative use ObserveModule, only: ObserveType - use TimeSeriesLinkModule, only: TimeSeriesLinkType, & - GetTimeSeriesLinkFromList use BlockParserModule, only: BlockParserType use InputOutputModule, only: GetUnit, openfile use MatrixBaseModule @@ -37,24 +36,28 @@ module WelModule character(len=LENFTYPE) :: ftype = 'WEL' !< package ftype character(len=16) :: text = ' WEL' !< package flow text string ! - type, extends(BndType) :: WelType + type, extends(BndExtType) :: WelType + real(DP), dimension(:), pointer, contiguous :: q => null() !< volumetric well rate integer(I4B), pointer :: iflowred => null() !< flag indicating if the AUTO_FLOW_REDUCE option is active real(DP), pointer :: flowred => null() !< AUTO_FLOW_REDUCE variable integer(I4B), pointer :: ioutafrcsv => null() !< unit number for CSV output file containing wells with reduced puping rates contains procedure :: allocate_scalars => wel_allocate_scalars - procedure :: bnd_options => wel_options + procedure :: allocate_arrays => wel_allocate_arrays + procedure :: source_options => wel_options + procedure :: log_wel_options + procedure :: bnd_rp => wel_rp procedure :: bnd_cf => wel_cf procedure :: bnd_fc => wel_fc procedure :: bnd_fn => wel_fn procedure :: bnd_da => wel_da procedure :: define_listlabel + procedure :: bound_value => wel_bound_value + procedure :: q_mult ! -- methods for observations procedure, public :: bnd_obs_supported => wel_obs_supported procedure, public :: bnd_df_obs => wel_df_obs procedure, public :: bnd_bd_obs => wel_bd_obs - ! -- methods for time series - procedure, public :: bnd_rp_ts => wel_rp_ts ! -- afr procedure, private :: wel_afr_csv_init procedure, private :: wel_afr_csv_write @@ -67,7 +70,8 @@ module WelModule !! Create a new WEL Package object !! !< - subroutine wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) + subroutine wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) ! -- dummy variables class(BndType), pointer :: packobj !< pointer to default package type integer(I4B), intent(in) :: id !< package id @@ -76,6 +80,7 @@ subroutine wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout !< unit number of model listing file character(len=*), intent(in) :: namemodel !< model name character(len=*), intent(in) :: pakname !< package name + character(len=*), intent(in) :: mempath !< input mempath ! -- local variables type(WelType), pointer :: welobj ! @@ -84,7 +89,7 @@ subroutine wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj => welobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars @@ -97,8 +102,6 @@ subroutine wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 1 - packobj%iscloc = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! ! -- return @@ -117,12 +120,13 @@ subroutine wel_da(this) class(WelType) :: this !< WelType object ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! ! -- scalars call mem_deallocate(this%iflowred) call mem_deallocate(this%flowred) call mem_deallocate(this%ioutafrcsv) + call mem_deallocate(this%q, 'Q', this%memoryPath) ! ! -- return return @@ -140,8 +144,8 @@ subroutine wel_allocate_scalars(this) ! -- dummy variables class(WelType) :: this !< WelType object ! - ! -- call standard BndType allocate scalars - call this%BndType%allocate_scalars() + ! -- call base type allocate scalars + call this%BndExtType%allocate_scalars() ! ! -- allocate the object and assign values to object variables call mem_allocate(this%iflowred, 'IFLOWRED', this%memoryPath) @@ -157,67 +161,152 @@ subroutine wel_allocate_scalars(this) return end subroutine wel_allocate_scalars - !> @ brief Read additional options for package + !> @ brief Allocate arrays !! - !! Read additional options for WEL package. + !! Allocate and initialize arrays for the WEL package !! !< - subroutine wel_options(this, option, found) + subroutine wel_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(WelType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! -- local + ! + ! -- call BndExtType allocate scalars + call this%BndExtType%allocate_arrays(nodelist, auxvar) + ! + ! -- set constant head array input context pointer + call mem_setptr(this%q, 'Q', this%input_mempath) + ! + ! -- checkin constant head array input context pointer + call mem_checkin(this%q, 'Q', this%memoryPath, & + 'Q', this%input_mempath) + ! + ! -- return + return + end subroutine wel_allocate_arrays + + !> @ brief Source additional options for package + !! + !! Source additional options for WEL package. + !! + !< + subroutine wel_options(this) ! -- modules use InputOutputModule, only: urword + use MemoryManagerExtModule, only: mem_set_value + use GwfWelInputModule, only: GwfWelParamFoundType ! -- dummy variables class(WelType), intent(inout) :: this !< WelType object - character(len=*), intent(inout) :: option !< option keyword string - logical, intent(inout) :: found !< boolean indicating if option found ! -- local variables - real(DP) :: r - character(len=MAXCHARLEN) :: fname - character(len=MAXCHARLEN) :: keyword + character(len=LINELENGTH) :: fname + type(GwfWelParamFoundType) :: found ! -- formats character(len=*), parameter :: fmtflowred = & &"(4x, 'AUTOMATIC FLOW REDUCTION OF WELLS IMPLEMENTED.')" character(len=*), parameter :: fmtflowredv = & &"(4x, 'AUTOMATIC FLOW REDUCTION FRACTION (',g15.7,').')" ! - ! -- Check for 'AUTO_FLOW_REDUCE' and set this%iflowred - select case (option) - case ('AUTO_FLOW_REDUCE') + ! -- source base BndExtType options + call this%BndExtType%source_options() + ! + ! -- source well options from input context + call mem_set_value(this%flowred, 'FLOWRED', this%input_mempath, found%flowred) + call mem_set_value(fname, 'AFRCSVFILE', this%input_mempath, found%afrcsvfile) + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) + ! + if (found%flowred) then + ! this%iflowred = 1 - r = this%parser%GetDouble() - if (r <= DZERO) then - r = DEM1 - else if (r > DONE) then - r = DONE - end if - this%flowred = r ! - ! -- Write option and return with found set to true + if (this%flowred <= DZERO) then + this%flowred = DEM1 + else if (this%flowred > DONE) then + this%flowred = DONE + end if + end if + ! + if (found%afrcsvfile) then + call this%wel_afr_csv_init(fname) + end if + ! + if (found%mover) then + this%imover = 1 + end if + ! + ! -- log WEL specific options + call this%log_wel_options(found) + ! + ! -- return + return + end subroutine wel_options + + !> @ brief Log WEL specific package options + !< + subroutine log_wel_options(this, found) + ! -- modules + use GwfWelInputModule, only: GwfWelParamFoundType + ! -- dummy variables + class(WelType), intent(inout) :: this !< BndExtType object + type(GwfWelParamFoundType), intent(in) :: found + ! -- local variables + ! -- format + character(len=*), parameter :: fmtflowred = & + &"(4x, 'AUTOMATIC FLOW REDUCTION OF WELLS IMPLEMENTED.')" + character(len=*), parameter :: fmtflowredv = & + &"(4x, 'AUTOMATIC FLOW REDUCTION FRACTION (',g15.7,').')" + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found%flowred) then if (this%iflowred > 0) & write (this%iout, fmtflowred) write (this%iout, fmtflowredv) this%flowred - found = .true. - case ('AUTO_FLOW_REDUCE_CSV') - call this%parser%GetStringCaps(keyword) - if (keyword == 'FILEOUT') then - call this%parser%GetString(fname) - call this%wel_afr_csv_init(fname) - else - call store_error('OPTIONAL AUTO_FLOW_REDUCE_CSV KEYWORD MUST BE & - &FOLLOWED BY FILEOUT') - end if - case ('MOVER') - this%imover = 1 + end if + ! + if (found%afrcsvfile) then + ! -- currently no-op + end if + ! + if (found%mover) then write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' - found = .true. - case default - ! - ! -- No options found - found = .false. - end select + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' ! ! -- return return - end subroutine wel_options + end subroutine log_wel_options + + !> @ brief WEL read and prepare + !! + !< + subroutine wel_rp(this) + use TdisModule, only: kper + ! -- dummy + class(WelType), intent(inout) :: this + ! -- local + ! + if (this%iper /= kper) return + ! + ! -- Call the parent class read and prepare + call this%BndExtType%bnd_rp() + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + ! + ! -- return + return + end subroutine wel_rp !> @ brief Formulate the package hcof and rhs terms. !! @@ -225,10 +314,9 @@ end subroutine wel_options !! added to the coefficient matrix and right-hand side vector. !! !< - subroutine wel_cf(this, reset_mover) + subroutine wel_cf(this) ! -- dummy variables class(WelType) :: this !< WelType object - logical, intent(in), optional :: reset_mover !< boolean for resetting mover ! -- local variables integer(I4B) :: i, node, ict real(DP) :: qmult @@ -236,18 +324,10 @@ subroutine wel_cf(this, reset_mover) real(DP) :: tp real(DP) :: bt real(DP) :: thick - logical :: lrm ! ! -- Return if no wells if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each well entry do i = 1, this%nbound node = this%nodelist(i) @@ -256,7 +336,7 @@ subroutine wel_cf(this, reset_mover) this%rhs(i) = DZERO cycle end if - q = this%bound(1, i) + q = this%q_mult(i) if (this%iflowred /= 0 .and. q < DZERO) then ict = this%icelltype(node) if (ict /= 0) then @@ -360,7 +440,7 @@ subroutine wel_fn(this, rhs, ia, idxglo, matrix_sln) thick = tp - bt tp = bt + this%flowred * thick drterm = sQSaturationDerivative(tp, bt, this%xnew(node)) - drterm = drterm * this%bound(1, i) + drterm = drterm * this%q_mult(i) !--fill amat and rhs with newton-raphson terms call matrix_sln%add_value_pos(idxglo(ipos), drterm) rhs(node) = rhs(node) + drterm * this%xnew(node) @@ -412,11 +492,11 @@ subroutine wel_afr_csv_write(this) if (this%ibound(nodereduced) <= 0) then cycle end if - v = this%bound(1, i) + this%rhs(i) + v = this%q_mult(i) + this%rhs(i) if (v < DZERO) then nodeuser = this%dis%get_nodeuser(nodereduced) write (this%ioutafrcsv, '(*(G0,:,","))') & - totim, kper, kstp, i, nodeuser, this%bound(1, i), this%simvals(i), v + totim, kper, kstp, i, nodeuser, this%q_mult(i), this%simvals(i), v end if end do end subroutine wel_afr_csv_write @@ -539,7 +619,7 @@ subroutine wel_bd_obs(this) v = this%simvals(jj) case ('WEL-REDUCTION') if (this%iflowred > 0) then - v = this%bound(1, jj) + this%rhs(jj) + v = this%q_mult(jj) + this%rhs(jj) end if case default errmsg = 'Unrecognized observation type: '//trim(obsrv%ObsTypeId) @@ -561,34 +641,53 @@ subroutine wel_bd_obs(this) return end subroutine wel_bd_obs - ! -- Procedure related to time series + function q_mult(this, row) result(q) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(WelType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: q + ! + if (this%iauxmultcol > 0) then + q = this%q(row) * this%auxvar(this%iauxmultcol, row) + else + q = this%q(row) + end if + ! + ! -- return + return + end function q_mult - !> @brief Assign time series links for the package + !> @ brief Return a bound value !! - !! Assign the time series links for the WEL package. Only - !! the Q variable can be defined with time series. + !! Return a bound value associated with an ncolbnd index + !! and row. !! !< - subroutine wel_rp_ts(this) + function wel_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO ! -- dummy variables - class(WelType), intent(inout) :: this !< WelType object - ! -- local variables - integer(I4B) :: i, nlinks - type(TimeSeriesLinkType), pointer :: tslink => null() - ! - ! -- set up the time series links - nlinks = this%TsManager%boundtslinks%Count() - do i = 1, nlinks - tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i) - if (associated(tslink)) then - if (tslink%JCol == 1) then - tslink%Text = 'Q' - end if - end if - end do + class(WelType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%q_mult(row) + case default + errmsg = 'Programming error. WEL bound value requested column '& + &'outside range of ncolbnd (1).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select ! ! -- return return - end subroutine wel_rp_ts + end function wel_bound_value end module WelModule diff --git a/src/Model/GroundWaterFlow/gwf3wel8idm.f90 b/src/Model/GroundWaterFlow/gwf3wel8idm.f90 new file mode 100644 index 00000000000..5b3b6b68d2f --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf3wel8idm.f90 @@ -0,0 +1,525 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfWelInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_wel_param_definitions + public gwf_wel_aggregate_definitions + public gwf_wel_block_definitions + public GwfWelParamFoundType + public gwf_wel_multi_package + + type GwfWelParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: flowred = .false. + logical :: afrcsv_rec = .false. + logical :: afrcsv = .false. + logical :: fileout = .false. + logical :: afrcsvfile = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: mover = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: q = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwfWelParamFoundType + + logical :: gwf_wel_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwfwel_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_boundnames = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_flowred = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AUTO_FLOW_REDUCE', & ! tag name + 'FLOWRED', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_afrcsv_rec = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AFRCSV_FILERECORD', & ! tag name + 'AFRCSV_REC', & ! fortran variable + 'RECORD AUTO_FLOW_REDUCE_CSV FILEOUT AFRCSVFILE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_afrcsv = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AUTO_FLOW_REDUCE_CSV', & ! tag name + 'AFRCSV', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_fileout = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'FILEOUT', & ! tag name + 'FILEOUT', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_afrcsvfile = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'AFRCSVFILE', & ! tag name + 'AFRCSVFILE', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_ts_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_ts6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_ts6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_mover = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'OPTIONS', & ! block + 'MOVER', & ! tag name + 'MOVER', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_cellid = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_q = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'PERIOD', & ! block + 'Q', & ! tag name + 'Q', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfwel_boundname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_wel_param_definitions(*) = & + [ & + gwfwel_auxiliary, & + gwfwel_auxmultname, & + gwfwel_boundnames, & + gwfwel_iprpak, & + gwfwel_iprflow, & + gwfwel_ipakcb, & + gwfwel_flowred, & + gwfwel_afrcsv_rec, & + gwfwel_afrcsv, & + gwfwel_fileout, & + gwfwel_afrcsvfile, & + gwfwel_ts_filerecord, & + gwfwel_ts6, & + gwfwel_filein, & + gwfwel_ts6_filename, & + gwfwel_obs_filerecord, & + gwfwel_obs6, & + gwfwel_obs6_filename, & + gwfwel_mover, & + gwfwel_maxbound, & + gwfwel_cellid, & + gwfwel_q, & + gwfwel_auxvar, & + gwfwel_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwfwel_spd = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'WEL', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID Q AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_wel_aggregate_definitions(*) = & + [ & + gwfwel_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_wel_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfWelInputModule diff --git a/src/Model/GroundWaterTransport/gwt1.f90 b/src/Model/GroundWaterTransport/gwt1.f90 index 0e391664630..8f32e270e72 100644 --- a/src/Model/GroundWaterTransport/gwt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1.f90 @@ -8,22 +8,17 @@ module GwtModule use KindModule, only: DP, I4B - use ConstantsModule, only: LENFTYPE, LENMEMPATH, DZERO, LENPAKLOC + use ConstantsModule, only: LENFTYPE, LENMEMPATH, DZERO, DONE, & + LENPAKLOC, LENVARNAME, LENPACKAGETYPE use VersionModule, only: write_listfile_header use NumericalModelModule, only: NumericalModelType - use TransportModelModule, only: TransportModelType + use BaseModelModule, only: BaseModelType use BndModule, only: BndType, AddBndToList, GetBndFromList - use GwtIcModule, only: GwtIcType - use GwtFmiModule, only: GwtFmiType - use GwtAdvModule, only: GwtAdvType use GwtDspModule, only: GwtDspType - use GwtSsmModule, only: GwtSsmType - use GwtMvtModule, only: GwtMvtType use GwtMstModule, only: GwtMstType - use GwtOcModule, only: GwtOcType - use GwtObsModule, only: GwtObsType use BudgetModule, only: BudgetType + use TransportModelModule use MatrixBaseModule implicit none @@ -32,28 +27,18 @@ module GwtModule public :: gwt_cr public :: GwtModelType public :: CastAsGwtModel + public :: GWT_NBASEPKG, GWT_NMULTIPKG + public :: GWT_BASEPKG, GWT_MULTIPKG + character(len=LENVARNAME), parameter :: dvt = 'CONCENTRATION ' !< dependent variable type, varies based on model type + character(len=LENVARNAME), parameter :: dvu = 'MASS ' !< dependent variable unit of measure, either "mass" or "energy" + character(len=LENVARNAME), parameter :: dvua = 'M ' !< abbreviation of the dependent variable unit of measure, either "M" or "E" type, extends(TransportModelType) :: GwtModelType - type(GwtIcType), pointer :: ic => null() ! initial conditions package - type(GwtFmiType), pointer :: fmi => null() ! flow model interface type(GwtMstType), pointer :: mst => null() ! mass storage and transfer package - type(GwtAdvType), pointer :: adv => null() ! advection package type(GwtDspType), pointer :: dsp => null() ! dispersion package - type(GwtSsmType), pointer :: ssm => null() ! source sink mixing package - type(GwtMvtType), pointer :: mvt => null() ! mover transport package - type(GwtOcType), pointer :: oc => null() ! output control package - type(GwtObsType), pointer :: obs => null() ! observation package - type(BudgetType), pointer :: budget => null() ! budget object - integer(I4B), pointer :: inic => null() ! unit number IC - integer(I4B), pointer :: infmi => null() ! unit number FMI - integer(I4B), pointer :: inmvt => null() ! unit number MVT integer(I4B), pointer :: inmst => null() ! unit number MST - integer(I4B), pointer :: inadv => null() ! unit number ADV integer(I4B), pointer :: indsp => null() ! DSP enabled flag - integer(I4B), pointer :: inssm => null() ! unit number SSM - integer(I4B), pointer :: inoc => null() ! unit number OC - integer(I4B), pointer :: inobs => null() ! unit number OBS contains @@ -71,130 +56,122 @@ module GwtModule procedure :: model_ot => gwt_ot procedure :: model_da => gwt_da procedure :: model_bdentry => gwt_bdentry - procedure :: allocate_scalars - procedure, private :: package_create - procedure, private :: ftype_check procedure :: get_iasym => gwt_get_iasym - procedure, private :: gwt_ot_flow - procedure, private :: gwt_ot_flowja - procedure, private :: gwt_ot_dv - procedure, private :: gwt_ot_bdsummary - procedure, private :: gwt_ot_obs - procedure, private :: create_packages + procedure :: create_packages => create_gwt_packages procedure, private :: create_bndpkgs - procedure, private :: create_lstfile - procedure, private :: log_namfile_options + procedure, private :: package_create + end type GwtModelType + !> @brief GWT base package array descriptors + !! + !! GWT6 model base package types. Only listed packages are candidates + !! for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: GWT_NBASEPKG = 50 + character(len=LENPACKAGETYPE), dimension(GWT_NBASEPKG) :: GWT_BASEPKG + data GWT_BASEPKG/'DIS6 ', 'DISV6', 'DISU6', ' ', ' ', & ! 5 + &'IC6 ', 'FMI6 ', 'MST6 ', 'ADV6 ', ' ', & ! 10 + &'DSP6 ', 'SSM6 ', 'MVT6 ', 'OC6 ', ' ', & ! 15 + &'OBS6 ', ' ', ' ', ' ', ' ', & ! 20 + &30*' '/ ! 50 + + !> @brief GWT multi package array descriptors + !! + !! GWT6 model multi-instance package types. Only listed packages are + !! candidates for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: GWT_NMULTIPKG = 50 + character(len=LENPACKAGETYPE), dimension(GWT_NMULTIPKG) :: GWT_MULTIPKG + data GWT_MULTIPKG/'CNC6 ', 'SRC6 ', 'LKT6 ', 'IST6 ', ' ', & ! 5 + &'SFT6 ', 'MWT6 ', 'UZT6 ', 'API6 ', ' ', & ! 10 + &40*' '/ ! 50 + + ! -- size of supported model package arrays + integer(I4B), parameter :: NIUNIT_GWT = GWT_NBASEPKG + GWT_NMULTIPKG + contains + !> @brief Create a new groundwater transport model object + !< subroutine gwt_cr(filename, id, modelname) -! ****************************************************************************** -! gwt_cr -- Create a new groundwater transport model object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ListsModule, only: basemodellist use BaseModelModule, only: AddBaseModelToList - use ConstantsModule, only: LINELENGTH + use ConstantsModule, only: LINELENGTH, LENPACKAGENAME use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value - use SimVariablesModule, only: idm_context - use GwfNamInputModule, only: GwfNamParamFoundType + use GwtNamInputModule, only: GwtNamParamFoundType use BudgetModule, only: budget_cr ! -- dummy character(len=*), intent(in) :: filename integer(I4B), intent(in) :: id character(len=*), intent(in) :: modelname ! -- local + integer(I4B) :: indis type(GwtModelType), pointer :: this class(BaseModelType), pointer :: model - character(len=LENMEMPATH) :: input_mempath - character(len=LINELENGTH) :: lst_fname - type(GwfNamParamFoundType) :: found - ! -- format -! ------------------------------------------------------------------------------ ! - ! -- Allocate a new GWT Model (this) and add it to basemodellist + ! -- Allocate a new GWT Model (this) allocate (this) ! ! -- Set memory path before allocation in memory manager can be done this%memoryPath = create_mem_path(modelname) ! + ! -- Allocate scalars and add model to basemodellist call this%allocate_scalars(modelname) - model => this - call AddBaseModelToList(basemodellist, model) ! - ! -- Assign values - this%filename = filename - this%name = modelname - this%macronym = 'GWT' - this%id = id - ! - ! -- set input model namfile memory path - input_mempath = create_mem_path(modelname, 'NAM', idm_context) - ! - ! -- copy option params from input context - call mem_set_value(lst_fname, 'LIST', input_mempath, found%list) - call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, & - found%print_input) - call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, & - found%print_flows) - call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, found%save_flows) - ! - ! -- create the list file - call this%create_lstfile(lst_fname, filename, found%list) - ! - ! -- activate save_flows if found - if (found%save_flows) then - this%ipakcb = -1 - end if + ! -- set labels for transport model - needed by create_packages() below + call this%set_tsp_labels(this%macronym, dvt, dvu, dvua) ! - ! -- log set options - if (this%iout > 0) then - call this%log_namfile_options(found) - end if + model => this + call AddBaseModelToList(basemodellist, model) ! - ! -- Create utility objects - call budget_cr(this%budget, this%name) + ! -- Call parent class routine + call this%tsp_cr(filename, id, modelname, 'GWT', indis) ! ! -- create model packages - call this%create_packages() + call this%create_packages(indis) ! - ! -- return + ! -- Return return end subroutine gwt_cr + !> @brief Define packages of the GWT model + !! + !! This subroutine defines a gwt model type. Steps include: + !! (1) call df routines for each package + !! (2) set variables and pointers + !< subroutine gwt_df(this) -! ****************************************************************************** -! gwt_df -- Define packages of the model -! Subroutine: (1) call df routines for each package -! (2) set variables and pointers -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use ModelPackageInputsModule, only: NIUNIT_GWT + use SimModule, only: store_error ! -- dummy class(GwtModelType) :: this ! -- local integer(I4B) :: ip class(BndType), pointer :: packobj -! ------------------------------------------------------------------------------ ! ! -- Define packages and utility objects call this%dis%dis_df() - call this%fmi%fmi_df(this%dis, this%inssm) + call this%fmi%fmi_df(this%dis) if (this%inmvt > 0) call this%mvt%mvt_df(this%dis) if (this%inadv > 0) call this%adv%adv_df() if (this%indsp > 0) call this%dsp%dsp_df(this%dis) if (this%inssm > 0) call this%ssm%ssm_df() call this%oc%oc_df() - call this%budget%budget_df(NIUNIT_GWT, 'MASS', 'M') + call this%budget%budget_df(NIUNIT_GWT, this%depvarunit, & + this%depvarunitabbrev) + ! + ! -- Check for SSM package + if (this%inssm == 0) then + if (this%fmi%nflowpack > 0) then + call store_error('Flow model has boundary packages, but there & + &is no SSM package. The SSM package must be activated.', & + terminate=.TRUE.) + end if + end if ! ! -- Assign or point model members to dis members this%neq = this%dis%nodes @@ -216,17 +193,13 @@ subroutine gwt_df(this) ! -- Store information needed for observations call this%obs%obs_df(this%iout, this%name, 'GWT', this%dis) ! - ! -- return + ! -- Return return end subroutine gwt_df + !> @brief Add the internal connections of this model to the sparse matrix + !< subroutine gwt_ac(this, sparse) -! ****************************************************************************** -! gwt_ac -- Add the internal connections of this model to the sparse matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix ! -- dummy @@ -235,7 +208,6 @@ subroutine gwt_ac(this, sparse) ! -- local class(BndType), pointer :: packobj integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- Add the internal connections of this model to sparse call this%dis%dis_ac(this%moffset, sparse) @@ -248,29 +220,25 @@ subroutine gwt_ac(this, sparse) call packobj%bnd_ac(this%moffset, sparse) end do ! - ! -- return + ! -- Return return end subroutine gwt_ac + !> @brief Map the positions of the GWT model connections in the numerical + !! solution coefficient matrix. + !< subroutine gwt_mc(this, matrix_sln) -! ****************************************************************************** -! gwt_mc -- Map the positions of this models connections in the -! numerical solution coefficient matrix. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtModelType) :: this class(MatrixBaseType), pointer :: matrix_sln !< global system matrix ! -- local class(BndType), pointer :: packobj integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- Find the position of each connection in the global ia, ja structure ! and store them in idxglo. call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln) + ! if (this%indsp > 0) call this%dsp%dsp_mc(this%moffset, matrix_sln) ! ! -- Map any package connections @@ -279,19 +247,17 @@ subroutine gwt_mc(this, matrix_sln) call packobj%bnd_mc(this%moffset, matrix_sln) end do ! - ! -- return + ! -- Return return end subroutine gwt_mc + !> @brief GWT Model Allocate and Read + !! + !! This subroutine: + !! - allocates and reads packages that are part of this model, + !! - allocates memory for arrays used by this model object + !< subroutine gwt_ar(this) -! ****************************************************************************** -! gwt_ar -- GroundWater Transport Model Allocate and Read -! Subroutine: (1) allocates and reads packages part of this model, -! (2) allocates memory for arrays part of this model object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHNOFLO ! -- dummy @@ -299,7 +265,6 @@ subroutine gwt_ar(this) ! -- locals integer(I4B) :: ip class(BndType), pointer :: packobj -! ------------------------------------------------------------------------------ ! ! -- Allocate and read modules attached to model call this%fmi%fmi_ar(this%ibound) @@ -309,13 +274,22 @@ subroutine gwt_ar(this) if (this%inadv > 0) call this%adv%adv_ar(this%dis, this%ibound) if (this%indsp > 0) call this%dsp%dsp_ar(this%ibound, this%mst%thetam) if (this%inssm > 0) call this%ssm%ssm_ar(this%dis, this%ibound, this%x) - if (this%inobs > 0) call this%obs%gwt_obs_ar(this%ic, this%x, this%flowja) + if (this%inobs > 0) call this%obs%tsp_obs_ar(this%ic, this%x, this%flowja) + ! + ! -- Set governing equation scale factor. Note that this scale factor + ! -- cannot be set arbitrarily. For solute transport, it must be set + ! -- to 1. Setting it to a different value will NOT automatically + ! -- scale all the terms of the governing equation correctly by that + ! -- value. This is because much of the coding in the associated + ! -- packages implicitly assumes the governing equation for solute + ! -- transport is scaled by 1. (effectively unscaled). + this%eqnsclfac = DONE ! ! -- Call dis_ar to write binary grid file !call this%dis%dis_ar(this%npf%icelltype) ! ! -- set up output control - call this%oc%oc_ar(this%x, this%dis, DHNOFLO) + call this%oc%oc_ar(this%x, this%dis, DHNOFLO, this%depvartype) call this%budget%set_ibudcsv(this%oc%ibudcsv) ! ! -- Package input files now open, so allocate and read @@ -327,18 +301,15 @@ subroutine gwt_ar(this) call packobj%bnd_ar() end do ! - ! -- return + ! -- Return return end subroutine gwt_ar + !> @brief GWT Model Read and Prepare + !! + !! Call the read and prepare routines of the attached packages + !< subroutine gwt_rp(this) -! ****************************************************************************** -! gwt_rp -- GroundWater Transport Model Read and Prepare -! Subroutine: (1) calls package read and prepare routines -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: readnewdata ! -- dummy @@ -346,7 +317,6 @@ subroutine gwt_rp(this) ! -- local class(BndType), pointer :: packobj integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- In fmi, check for mvt and mvrbudobj consistency call this%fmi%fmi_rp(this%inmvt) @@ -368,14 +338,11 @@ subroutine gwt_rp(this) return end subroutine gwt_rp + !> @brief GWT Model Time Step Advance + !! + !! Call the advance subroutines of the attached packages + !< subroutine gwt_ad(this) -! ****************************************************************************** -! gwt_ad -- GroundWater Transport Model Time Step Advance -! Subroutine: (1) calls package advance subroutines -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: isimcheck, iFailedStepRetry ! -- dummy @@ -384,7 +351,6 @@ subroutine gwt_ad(this) ! -- local integer(I4B) :: irestore integer(I4B) :: ip, n -! ------------------------------------------------------------------------------ ! ! -- Reset state variable irestore = 0 @@ -425,17 +391,15 @@ subroutine gwt_ad(this) ! -- Push simulated values to preceding time/subtime step call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine gwt_ad + !> @brief GWT Model calculate coefficients + !! + !! Call the calculate coefficients subroutines of the attached packages + !< subroutine gwt_cf(this, kiter) -! ****************************************************************************** -! gwt_cf -- GroundWater Transport Model calculate coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtModelType) :: this @@ -443,7 +407,6 @@ subroutine gwt_cf(this, kiter) ! -- local class(BndType), pointer :: packobj integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- Call package cf routines do ip = 1, this%bndlist%Count() @@ -451,17 +414,15 @@ subroutine gwt_cf(this, kiter) call packobj%bnd_cf() end do ! - ! -- return + ! -- Return return end subroutine gwt_cf + !> @brief GWT Model fill coefficients + !! + !! Call the fill coefficients subroutines attached packages + !< subroutine gwt_fc(this, kiter, matrix_sln, inwtflag) -! ****************************************************************************** -! gwt_fc -- GroundWater Transport Model fill coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtModelType) :: this @@ -471,7 +432,6 @@ subroutine gwt_fc(this, kiter, matrix_sln, inwtflag) ! -- local class(BndType), pointer :: packobj integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- call fc routines call this%fmi%fmi_fc(this%dis%nodes, this%xold, this%nja, matrix_sln, & @@ -501,18 +461,20 @@ subroutine gwt_fc(this, kiter, matrix_sln, inwtflag) call packobj%bnd_fc(this%rhs, this%ia, this%idxglo, matrix_sln) end do ! - ! -- return + ! -- Return return end subroutine gwt_fc + !> @brief GWT Model Final Convergence Check + !! + !! If MVR/MVT is active, call the MVR convergence check subroutines to force + !! at least 2 outer iterations. The other advanced transport packages are + !! solved in the matrix equations directly which means the solver is + !! completing the necessary checks thereby eliminating need to call package + !! cc routines. That is, no need to loop over active packages and run: + !! call packobj%bnd_cc(iend, icnvg, hclose, rclose) + !< subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) -! ****************************************************************************** -! gwt_cc -- GroundWater Transport Model Final Convergence Check -! Subroutine: (1) calls package cc routines -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtModelType) :: this integer(I4B), intent(in) :: innertot @@ -523,32 +485,20 @@ subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) integer(I4B), intent(inout) :: ipak real(DP), intent(inout) :: dpak ! -- local - !class(BndType), pointer :: packobj - !integer(I4B) :: ip ! -- formats -! ------------------------------------------------------------------------------ ! ! -- If mover is on, then at least 2 outers required if (this%inmvt > 0) call this%mvt%mvt_cc(kiter, iend, icnvgmod, cpak, dpak) ! - ! -- Call package cc routines - !do ip = 1, this%bndlist%Count() - ! packobj => GetBndFromList(this%bndlist, ip) - ! call packobj%bnd_cc(iend, icnvg, hclose, rclose) - !enddo - ! - ! -- return + ! -- Return return end subroutine gwt_cc + !> @brief GWT Model calculate flow + !! + !! Call the intercell flows (flow ja) subroutine + !< subroutine gwt_cq(this, icnvg, isuppress_output) -! ****************************************************************************** -! gwt_cq --Groundwater transport model calculate flow -! Subroutine: (1) Calculate intercell flows (flowja) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: csr_diagsum ! -- dummy @@ -559,7 +509,6 @@ subroutine gwt_cq(this, icnvg, isuppress_output) integer(I4B) :: i integer(I4B) :: ip class(BndType), pointer :: packobj -! ------------------------------------------------------------------------------ ! ! -- Construct the flowja array. Flowja is calculated each time, even if ! output is suppressed. (flowja is positive into a cell.) The diagonal @@ -581,7 +530,7 @@ subroutine gwt_cq(this, icnvg, isuppress_output) ! conc solution. do ip = 1, this%bndlist%Count() packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_cf(reset_mover=.false.) + call packobj%bnd_cf() call packobj%bnd_cq(this%x, this%flowja) end do ! @@ -594,15 +543,13 @@ subroutine gwt_cq(this, icnvg, isuppress_output) return end subroutine gwt_cq + !> @brief GWT Model Budget + !! + !! This subroutine: + !! (1) calculates intercell flows (flowja) + !! (2) calculates package contributions to the model budget + !< subroutine gwt_bd(this, icnvg, isuppress_output) -! ****************************************************************************** -! gwt_bd --GroundWater Transport Model Budget -! Subroutine: (1) Calculate intercell flows (flowja) -! (2) Calculate package contributions to model budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: DZERO ! -- dummy class(GwtModelType) :: this @@ -611,7 +558,6 @@ subroutine gwt_bd(this, icnvg, isuppress_output) ! -- local integer(I4B) :: ip class(BndType), pointer :: packobj -! ------------------------------------------------------------------------------ ! ! -- Save the solution convergence flag this%icnvg = icnvg @@ -629,241 +575,43 @@ subroutine gwt_bd(this, icnvg, isuppress_output) packobj => GetBndFromList(this%bndlist, ip) call packobj%bnd_bd(this%budget) end do - ! ! -- Return return end subroutine gwt_bd + !> @brief Print and/or save model output + !! + !! Call the parent class output routine + !< subroutine gwt_ot(this) -! ****************************************************************************** -! gwt_ot -- GroundWater Transport Model Output -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use TdisModule, only: kstp, kper, tdis_ot, endofperiod ! -- dummy class(GwtModelType) :: this ! -- local - integer(I4B) :: idvsave - integer(I4B) :: idvprint integer(I4B) :: icbcfl integer(I4B) :: icbcun - integer(I4B) :: ibudfl - integer(I4B) :: ipflag - ! -- formats - character(len=*), parameter :: fmtnocnvg = & - "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', & - &I0,' OF STRESS PERIOD ',I0,'****')" -! ------------------------------------------------------------------------------ - ! - ! -- Set write and print flags - idvsave = 0 - idvprint = 0 - icbcfl = 0 - ibudfl = 0 - if (this%oc%oc_save('CONCENTRATION')) idvsave = 1 - if (this%oc%oc_print('CONCENTRATION')) idvprint = 1 - if (this%oc%oc_save('BUDGET')) icbcfl = 1 - if (this%oc%oc_print('BUDGET')) ibudfl = 1 - icbcun = this%oc%oc_save_unit('BUDGET') - ! - ! -- Override ibudfl and idvprint flags for nonconvergence - ! and end of period - ibudfl = this%oc%set_print_flag('BUDGET', this%icnvg, endofperiod) - idvprint = this%oc%set_print_flag('CONCENTRATION', this%icnvg, endofperiod) - ! - ! Calculate and save observations - call this%gwt_ot_obs() - ! - ! Save and print flows - call this%gwt_ot_flow(icbcfl, ibudfl, icbcun) ! - ! Save and print dependent variables - call this%gwt_ot_dv(idvsave, idvprint, ipflag) ! - ! Print budget summaries - call this%gwt_ot_bdsummary(ibudfl, ipflag) - ! - ! -- Timing Output; if any dependendent variables or budgets - ! are printed, then ipflag is set to 1. - if (ipflag == 1) call tdis_ot(this%iout) - ! - ! -- Write non-convergence message - if (this%icnvg == 0) then - write (this%iout, fmtnocnvg) kstp, kper - end if + ! -- Initialize + icbcfl = 0 ! - ! -- Return - return - end subroutine gwt_ot - - subroutine gwt_ot_obs(this) - class(GwtModelType) :: this - class(BndType), pointer :: packobj - integer(I4B) :: ip - - ! -- Calculate and save observations - call this%obs%obs_bd() - call this%obs%obs_ot() - - ! -- Calculate and save package obserations - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_bd_obs() - call packobj%bnd_ot_obs() - end do - - end subroutine gwt_ot_obs - - subroutine gwt_ot_flow(this, icbcfl, ibudfl, icbcun) - class(GwtModelType) :: this - integer(I4B), intent(in) :: icbcfl - integer(I4B), intent(in) :: ibudfl - integer(I4B), intent(in) :: icbcun - class(BndType), pointer :: packobj - integer(I4B) :: ip - - ! -- Save GWT flows - call this%gwt_ot_flowja(this%nja, this%flowja, icbcfl, icbcun) + ! -- Because mst belongs to gwt, call mst_ot_flow directly (and not from parent) + if (this%oc%oc_save('BUDGET')) icbcfl = 1 + icbcun = this%oc%oc_save_unit('BUDGET') if (this%inmst > 0) call this%mst%mst_ot_flow(icbcfl, icbcun) - if (this%infmi > 0) call this%fmi%fmi_ot_flow(icbcfl, icbcun) - if (this%inssm > 0) then - call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun) - end if - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun) - end do - - ! -- Save advanced package flows - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0) - end do - if (this%inmvt > 0) then - call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl) - end if - - ! -- Print GWF flows - ! no need to print flowja - ! no need to print mst - ! no need to print fmi - if (this%inssm > 0) then - call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0) - end if - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0) - end do - - ! -- Print advanced package flows - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl) - end do - if (this%inmvt > 0) then - call this%mvt%mvt_ot_printflow(icbcfl, ibudfl) - end if - - end subroutine gwt_ot_flow - - subroutine gwt_ot_flowja(this, nja, flowja, icbcfl, icbcun) -! ****************************************************************************** -! gwt_ot_flowja -- Write intercell flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy - class(GwtModelType) :: this - integer(I4B), intent(in) :: nja - real(DP), dimension(nja), intent(in) :: flowja - integer(I4B), intent(in) :: icbcfl - integer(I4B), intent(in) :: icbcun - ! -- local - integer(I4B) :: ibinun - ! -- formats -! ------------------------------------------------------------------------------ ! - ! -- Set unit number for binary output - if (this%ipakcb < 0) then - ibinun = icbcun - elseif (this%ipakcb == 0) then - ibinun = 0 - else - ibinun = this%ipakcb - end if - if (icbcfl == 0) ibinun = 0 - ! - ! -- Write the face flows if requested - if (ibinun /= 0) then - call this%dis%record_connection_array(flowja, ibinun, this%iout) - end if + ! -- Call parent class _ot routines. + call this%tsp_ot(this%inmst) ! ! -- Return return - end subroutine gwt_ot_flowja - - subroutine gwt_ot_dv(this, idvsave, idvprint, ipflag) - class(GwtModelType) :: this - integer(I4B), intent(in) :: idvsave - integer(I4B), intent(in) :: idvprint - integer(I4B), intent(inout) :: ipflag - class(BndType), pointer :: packobj - integer(I4B) :: ip - - ! -- Print advanced package dependent variables - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_dv(idvsave, idvprint) - end do - - ! -- save head and print head - call this%oc%oc_ot(ipflag) - - end subroutine gwt_ot_dv - - subroutine gwt_ot_bdsummary(this, ibudfl, ipflag) - use TdisModule, only: kstp, kper, totim - class(GwtModelType) :: this - integer(I4B), intent(in) :: ibudfl - integer(I4B), intent(inout) :: ipflag - class(BndType), pointer :: packobj - integer(I4B) :: ip - - ! - ! -- Package budget summary - do ip = 1, this%bndlist%Count() - packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl) - end do - - ! -- mover budget summary - if (this%inmvt > 0) then - call this%mvt%mvt_ot_bdsummary(ibudfl) - end if - - ! -- model budget summary - if (ibudfl /= 0) then - ipflag = 1 - call this%budget%budget_ot(kstp, kper, this%iout) - end if - - ! -- Write to budget csv - call this%budget%writecsv(totim) - - end subroutine gwt_ot_bdsummary + end subroutine gwt_ot + !> @brief Deallocate + !! + !! Deallocate memmory at conclusion of model run + !< subroutine gwt_da(this) -! ****************************************************************************** -! gwt_da -- Deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate use MemoryManagerExtModule, only: memorylist_remove @@ -873,7 +621,6 @@ subroutine gwt_da(this) ! -- local integer(I4B) :: ip class(BndType), pointer :: packobj -! ------------------------------------------------------------------------------ ! ! -- Deallocate idm memory call memorylist_remove(this%name, 'NAM', idm_context) @@ -895,11 +642,10 @@ subroutine gwt_da(this) ! -- Internal package objects deallocate (this%dis) deallocate (this%ic) - deallocate (this%fmi) - deallocate (this%adv) deallocate (this%dsp) deallocate (this%ssm) deallocate (this%mst) + deallocate (this%adv) deallocate (this%mvt) deallocate (this%budget) deallocate (this%oc) @@ -913,20 +659,16 @@ subroutine gwt_da(this) end do ! ! -- Scalars - call mem_deallocate(this%inic) - call mem_deallocate(this%infmi) - call mem_deallocate(this%inadv) call mem_deallocate(this%indsp) - call mem_deallocate(this%inssm) call mem_deallocate(this%inmst) - call mem_deallocate(this%inmvt) - call mem_deallocate(this%inoc) - call mem_deallocate(this%inobs) + ! + ! -- Parent class members + call this%TransportModelType%tsp_da() ! ! -- NumericalModelType call this%NumericalModelType%model_da() ! - ! -- return + ! -- Return return end subroutine gwt_da @@ -935,8 +677,6 @@ end subroutine gwt_da !! This subroutine adds a budget entry to the flow budget. It was added as !! a method for the gwt model object so that the exchange object could add its !! contributions. - !! - !! (1) adds the entry to the budget object !< subroutine gwt_bdentry(this, budterm, budtxt, rowlabel) ! -- modules @@ -947,11 +687,10 @@ subroutine gwt_bdentry(this, budterm, budtxt, rowlabel) real(DP), dimension(:, :), intent(in) :: budterm character(len=LENBUDTXT), dimension(:), intent(in) :: budtxt character(len=*), intent(in) :: rowlabel -! ------------------------------------------------------------------------------ ! call this%budget%addentry(budterm, delt, budtxt, rowlabel=rowlabel) ! - ! -- return + ! -- Return return end subroutine gwt_bdentry @@ -984,60 +723,43 @@ function gwt_get_iasym(this) result(iasym) if (packobj%iasym /= 0) iasym = 1 end do ! - ! -- return + ! -- Return return end function gwt_get_iasym + !> Allocate memory for non-allocatable members + !! + !! A subroutine for allocating the scalars specific to the GWT model type. + !! Additional scalars used by the parent class are allocated by the parent + !! class. + !< subroutine allocate_scalars(this, modelname) -! ****************************************************************************** -! allocate_scalars -- Allocate memory for non-allocatable members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtModelType) :: this character(len=*), intent(in) :: modelname -! ------------------------------------------------------------------------------ ! - ! -- allocate members from parent class - call this%NumericalModelType%allocate_scalars(modelname) + ! -- allocate parent class scalars + call this%allocate_tsp_scalars(modelname) ! - ! -- allocate members that are part of model class - call mem_allocate(this%inic, 'INIC', this%memoryPath) - call mem_allocate(this%infmi, 'INFMI', this%memoryPath) - call mem_allocate(this%inmvt, 'INMVT', this%memoryPath) + ! -- allocate additional members specific to GWT model type call mem_allocate(this%inmst, 'INMST', this%memoryPath) - call mem_allocate(this%inadv, 'INADV', this%memoryPath) call mem_allocate(this%indsp, 'INDSP', this%memoryPath) - call mem_allocate(this%inssm, 'INSSM', this%memoryPath) - call mem_allocate(this%inoc, 'INOC ', this%memoryPath) - call mem_allocate(this%inobs, 'INOBS', this%memoryPath) ! - this%inic = 0 - this%infmi = 0 - this%inmvt = 0 this%inmst = 0 - this%inadv = 0 this%indsp = 0 - this%inssm = 0 - this%inoc = 0 - this%inobs = 0 ! - ! -- return + ! -- Return return end subroutine allocate_scalars - subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & - iout) -! ****************************************************************************** -! package_create -- Create boundary condition packages for this model -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create boundary condition packages for this model + !! + !! Call the package create routines for packages activated by the user. + !< + subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & + inunit, iout) ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error @@ -1056,32 +778,38 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & integer(I4B), intent(in) :: ipakid integer(I4B), intent(in) :: ipaknum character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout ! -- local class(BndType), pointer :: packobj class(BndType), pointer :: packobj2 integer(I4B) :: ip -! ------------------------------------------------------------------------------ ! ! -- This part creates the package object select case (filtyp) case ('CNC6') - call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, dvt, mempath) case ('SRC6') - call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) + call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + this%depvartype, pakname) case ('LKT6') call lkt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac, this%depvartype, & + this%depvarunit, this%depvarunitabbrev) case ('SFT6') call sft_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac, this%depvartype, & + this%depvarunit, this%depvarunitabbrev) case ('MWT6') call mwt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac, this%depvartype, & + this%depvarunit, this%depvarunitabbrev) case ('UZT6') call uzt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac, this%depvartype, & + this%depvarunit, this%depvarunitabbrev) case ('IST6') call ist_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, this%fmi, this%mst) @@ -1105,66 +833,25 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, & end do call AddBndToList(this%bndlist, packobj) ! - ! -- return + ! -- Return return end subroutine package_create - subroutine ftype_check(this, indis) -! ****************************************************************************** -! ftype_check -- Check to make sure required input files have been specified -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, count_errors, store_error_filename - ! -- dummy - class(GwtModelType) :: this - integer(I4B), intent(in) :: indis - ! -- local - character(len=LINELENGTH) :: errmsg -! ------------------------------------------------------------------------------ - ! - ! -- Check for IC6, DIS(u), and MST. Stop if not present. - if (this%inic == 0) then - write (errmsg, '(a)') & - 'Initial conditions (IC6) package not specified.' - call store_error(errmsg) - end if - if (indis == 0) then - write (errmsg, '(a)') & - 'Discretization (DIS6 or DISU6) package not specified.' - call store_error(errmsg) - end if - if (this%inmst == 0) then - write (errmsg, '(a)') 'Mass storage and transfer (MST6) & - &package not specified.' - call store_error(errmsg) - end if - ! - if (count_errors() > 0) then - write (errmsg, '(a)') 'Required package(s) not specified.' - call store_error(errmsg) - call store_error_filename(this%filename) - end if - ! - ! -- return - return - end subroutine ftype_check - !> @brief Cast to GwtModelType + !< function CastAsGwtModel(model) result(gwtmodel) class(*), pointer :: model !< The object to be cast class(GwtModelType), pointer :: gwtmodel !< The GWT model - + ! gwtmodel => null() if (.not. associated(model)) return select type (model) type is (GwtModelType) gwtmodel => model end select - + ! + ! -- Return + return end function CastAsGwtModel !> @brief Source package info and begin to process @@ -1192,7 +879,7 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, & character(len=LENMEMPATH) :: mempath integer(I4B), pointer :: inunit integer(I4B) :: n - + ! if (allocated(bndpkgs)) then ! ! -- create stress packages @@ -1210,8 +897,8 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, & bndptype = pkgtype end if ! - call this%package_create(pkgtype, ipakid, ipaknum, pkgname, inunit, & - this%iout) + call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, & + inunit, this%iout) ipakid = ipakid + 1 ipaknum = ipaknum + 1 end do @@ -1220,13 +907,13 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, & deallocate (bndpkgs) end if ! - ! -- return + ! -- Return return end subroutine create_bndpkgs !> @brief Source package info and begin to process !< - subroutine create_packages(this) + subroutine create_gwt_packages(this, indis) ! -- modules use ConstantsModule, only: LINELENGTH, LENPACKAGENAME use CharacterStringModule, only: CharacterStringType @@ -1234,20 +921,11 @@ subroutine create_packages(this) use MemoryManagerModule, only: mem_setptr use MemoryHelperModule, only: create_mem_path use SimVariablesModule, only: idm_context - use GwfDisModule, only: dis_cr - use GwfDisvModule, only: disv_cr - use GwfDisuModule, only: disu_cr - use GwtIcModule, only: ic_cr - use GwtFmiModule, only: fmi_cr use GwtMstModule, only: mst_cr - use GwtAdvModule, only: adv_cr use GwtDspModule, only: dsp_cr - use GwtSsmModule, only: ssm_cr - use GwtMvtModule, only: mvt_cr - use GwtOcModule, only: oc_cr - use GwtObsModule, only: gwt_obs_cr ! -- dummy class(GwtModelType) :: this + integer(I4B), intent(in) :: indis ! -- local type(CharacterStringType), dimension(:), contiguous, & pointer :: pkgtypes => null() @@ -1264,7 +942,6 @@ subroutine create_packages(this) integer(I4B), pointer :: inunit integer(I4B), dimension(:), allocatable :: bndpkgs integer(I4B) :: n - integer(I4B) :: indis = 0 ! DIS enabled flag character(len=LENMEMPATH) :: mempathdsp = '' ! ! -- set input memory paths, input/model and input/model/namfile @@ -1286,34 +963,11 @@ subroutine create_packages(this) ! ! -- create dis package as it is a prerequisite for other packages select case (pkgtype) - case ('DIS6') - indis = 1 - call dis_cr(this%dis, this%name, mempath, indis, this%iout) - case ('DISV6') - indis = 1 - call disv_cr(this%dis, this%name, mempath, indis, this%iout) - case ('DISU6') - indis = 1 - call disu_cr(this%dis, this%name, mempath, indis, this%iout) - case ('IC6') - this%inic = inunit - case ('FMI6') - this%infmi = inunit - case ('MVT6') - this%inmvt = inunit case ('MST6') this%inmst = inunit - case ('ADV6') - this%inadv = inunit case ('DSP6') this%indsp = 1 mempathdsp = mempath - case ('SSM6') - this%inssm = inunit - case ('OC6') - this%inoc = inunit - case ('OBS6') - this%inobs = inunit case ('CNC6', 'SRC6', 'LKT6', 'SFT6', & 'MWT6', 'UZT6', 'IST6', 'API6') call expandarray(bndpkgs) @@ -1324,107 +978,17 @@ subroutine create_packages(this) end do ! ! -- Create packages that are tied directly to model - call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis) - call fmi_cr(this%fmi, this%name, this%infmi, this%iout) call mst_cr(this%mst, this%name, this%inmst, this%iout, this%fmi) - call adv_cr(this%adv, this%name, this%inadv, this%iout, this%fmi) call dsp_cr(this%dsp, this%name, mempathdsp, this%indsp, this%iout, & this%fmi) - call ssm_cr(this%ssm, this%name, this%inssm, this%iout, this%fmi) - call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi) - call oc_cr(this%oc, this%name, this%inoc, this%iout) - call gwt_obs_cr(this%obs, this%inobs) ! ! -- Check to make sure that required ftype's have been specified - call this%ftype_check(indis) + call this%ftype_check(indis, this%inmst) ! call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits) - - end subroutine create_packages - - subroutine create_lstfile(this, lst_fname, model_fname, defined) - ! -- modules - use KindModule, only: LGP - use InputOutputModule, only: openfile, getunit - ! -- dummy - class(GwtModelType) :: this - character(len=*), intent(inout) :: lst_fname - character(len=*), intent(in) :: model_fname - logical(LGP), intent(in) :: defined - ! -- local - integer(I4B) :: i, istart, istop - ! - ! -- set list file name if not provided - if (.not. defined) then - ! - ! -- initialize - lst_fname = ' ' - istart = 0 - istop = len_trim(model_fname) - ! - ! -- identify '.' character position from back of string - do i = istop, 1, -1 - if (model_fname(i:i) == '.') then - istart = i - exit - end if - end do - ! - ! -- if not found start from string end - if (istart == 0) istart = istop + 1 - ! - ! -- set list file name - lst_fname = model_fname(1:istart) - istop = istart + 3 - lst_fname(istart:istop) = '.lst' - end if ! - ! -- create the list file - this%iout = getunit() - call openfile(this%iout, 0, lst_fname, 'LIST', filstat_opt='REPLACE') - ! - ! -- write list file header - call write_listfile_header(this%iout, 'GROUNDWATER TRANSPORT MODEL (GWT)') - ! - ! -- return + ! -- Return return - end subroutine create_lstfile - - !> @brief Write model namfile options to list file - !< - subroutine log_namfile_options(this, found) - use GwfNamInputModule, only: GwfNamParamFoundType - class(GwtModelType) :: this - type(GwfNamParamFoundType), intent(in) :: found - - write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:' - - if (found%newton) then - write (this%iout, '(4x,a)') & - 'NEWTON-RAPHSON method enabled for the model.' - if (found%under_relaxation) then - write (this%iout, '(4x,a,a)') & - 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', & - 'elevation of the model will be applied to the model.' - end if - end if - - if (found%print_input) then - write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// & - 'FOR ALL MODEL STRESS PACKAGES' - end if - - if (found%print_flows) then - write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// & - 'FOR ALL MODEL PACKAGES' - end if - - if (found%save_flows) then - write (this%iout, '(4x,a)') & - 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL' - end if - - write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:' - end subroutine log_namfile_options + end subroutine create_gwt_packages end module GwtModule diff --git a/src/Model/GroundWaterTransport/gwt1cnc1.f90 b/src/Model/GroundWaterTransport/gwt1cnc1.f90 index 5fc5378f078..366a094c2a1 100644 --- a/src/Model/GroundWaterTransport/gwt1cnc1.f90 +++ b/src/Model/GroundWaterTransport/gwt1cnc1.f90 @@ -2,12 +2,16 @@ module GwtCncModule ! use KindModule, only: DP, I4B use ConstantsModule, only: DZERO, DONE, NAMEDBOUNDFLAG, LENFTYPE, & - LENPACKAGENAME + LENPACKAGENAME, LENVARNAME + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename use ObsModule, only: DefaultObsIdProcessor use BndModule, only: BndType + use BndExtModule, only: BndExtType use ObserveModule, only: ObserveType use TimeSeriesLinkModule, only: TimeSeriesLinkType, & GetTimeSeriesLinkFromList + use InputOutputModule, only: str_pad_left use MatrixBaseModule ! implicit none @@ -18,9 +22,12 @@ module GwtCncModule character(len=LENFTYPE) :: ftype = 'CNC' character(len=LENPACKAGENAME) :: text = ' CNC' ! - type, extends(BndType) :: GwtCncType + type, extends(BndExtType) :: GwtCncType + + real(DP), dimension(:), pointer, contiguous :: tspvar => null() !< constant concentration array real(DP), dimension(:), pointer, contiguous :: ratecncin => null() !simulated flows into constant conc (excluding other concs) real(DP), dimension(:), pointer, contiguous :: ratecncout => null() !simulated flows out of constant conc (excluding to other concs) + character(len=LENVARNAME) :: depvartype = '' !< stores string of dependent variable type, depending on model type contains procedure :: bnd_rp => cnc_rp procedure :: bnd_ad => cnc_ad @@ -31,6 +38,8 @@ module GwtCncModule procedure :: bnd_da => cnc_da procedure :: allocate_arrays => cnc_allocate_arrays procedure :: define_listlabel + procedure :: bound_value => cnc_bound_value + procedure :: conc_mult ! -- methods for observations procedure, public :: bnd_obs_supported => cnc_obs_supported procedure, public :: bnd_df_obs => cnc_df_obs @@ -40,15 +49,12 @@ module GwtCncModule contains - subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! cnc_create -- Create a New Constant Concentration Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new constant concentration or temperature package + !! + !! Routine points packobj to the newly created package + !< + subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + depvartype, mempath) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -57,20 +63,21 @@ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=LENVARNAME), intent(in) :: depvartype + character(len=*), intent(in) :: mempath ! -- local type(GwtCncType), pointer :: cncobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (cncobj) packobj => cncobj ! ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype) + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) packobj%text = text ! ! -- allocate scalars - call packobj%allocate_scalars() + call cncobj%allocate_scalars() ! ! -- initialize package call packobj%pack_initialize() @@ -80,32 +87,29 @@ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum - packobj%ncolbnd = 1 - packobj%iscloc = 1 ! - ! -- return + ! -- Store the appropriate label based on the dependent variable + cncobj%depvartype = depvartype + ! + ! -- Return return end subroutine cnc_create + !> @brief Allocate arrays specific to the constant concentration/tempeature + !! package. + !< subroutine cnc_allocate_arrays(this, nodelist, auxvar) -! ****************************************************************************** -! allocate_scalars -- allocate arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use MemoryManagerModule, only: mem_allocate + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin ! -- dummy class(GwtCncType) :: this integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars - call this%BndType%allocate_arrays() + call this%BndExtType%allocate_arrays(nodelist, auxvar) ! ! -- allocate ratecncex call mem_allocate(this%ratecncin, this%maxbound, 'RATECNCIN', this%memoryPath) @@ -115,24 +119,28 @@ subroutine cnc_allocate_arrays(this, nodelist, auxvar) this%ratecncin(i) = DZERO this%ratecncout(i) = DZERO end do + ! -- set constant head array input context pointer + call mem_setptr(this%tspvar, 'TSPVAR', this%input_mempath) + ! + ! -- checkin constant head array input context pointer + call mem_checkin(this%tspvar, 'TSPVAR', this%memoryPath, & + 'TSPVAR', this%input_mempath) ! - ! -- return + ! + ! -- Return return end subroutine cnc_allocate_arrays + !> @brief Constant concentration/temperature read and prepare (rp) routine + !< subroutine cnc_rp(this) -! ****************************************************************************** -! cnc_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SimModule, only: store_error + use InputOutputModule, only: lowcase implicit none class(GwtCncType), intent(inout) :: this integer(I4B) :: i, node, ibd, ierr character(len=30) :: nodestr -! ------------------------------------------------------------------------------ + character(len=LENVARNAME) :: dvtype ! ! -- Reset previous CNCs to active cell do i = 1, this%nbound @@ -141,7 +149,7 @@ subroutine cnc_rp(this) end do ! ! -- Call the parent class read and prepare - call this%BndType%bnd_rp() + call this%BndExtType%bnd_rp() ! ! -- Set ibound to -(ibcnum + 1) for constant concentration cells ierr = 0 @@ -150,8 +158,10 @@ subroutine cnc_rp(this) ibd = this%ibound(node) if (ibd < 0) then call this%dis%noder_to_string(node, nodestr) - call store_error('Cell is already a constant concentration: ' & - //trim(adjustl(nodestr))) + dvtype = trim(this%depvartype) + call lowcase(dvtype) + call store_error('Cell is already a constant ' & + //dvtype//': '//trim(adjustl(nodestr))) ierr = ierr + 1 else this%ibound(node) = -this%ibcnum @@ -160,20 +170,23 @@ subroutine cnc_rp(this) ! ! -- Stop if errors detected if (ierr > 0) then - call this%parser%StoreErrorUnit() + call store_error_filename(this%input_fname) + end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() end if ! - ! -- return + ! -- Return return end subroutine cnc_rp + !> @brief Constant concentration/temperature package advance routine + !! + !! Add package connections to matrix + !< subroutine cnc_ad(this) -! ****************************************************************************** -! cnc_ad -- Advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtCncType) :: this @@ -181,7 +194,6 @@ subroutine cnc_ad(this) integer(I4B) :: i, node real(DP) :: cb ! -- formats -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -189,7 +201,8 @@ subroutine cnc_ad(this) ! -- Process each entry in the constant concentration cell list do i = 1, this%nbound node = this%nodelist(i) - cb = this%bound(1, i) + cb = this%conc_mult(i) + ! this%xnew(node) = cb this%xold(node) = this%xnew(node) end do @@ -199,59 +212,51 @@ subroutine cnc_ad(this) ! "current" value. call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine cnc_ad + !> @brief Check constant concentration/temperature boundary condition data + !< subroutine cnc_ck(this) -! ****************************************************************************** -! cnc_ck -- Check cnc boundary condition data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, count_errors, store_error_unit ! -- dummy class(GwtCncType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: errmsg character(len=30) :: nodestr integer(I4B) :: i integer(I4B) :: node ! -- formats character(len=*), parameter :: fmtcncerr = & - &"('CNC boundary ',i0,' conc (',g0,') is less than zero for cell', a)" -! ------------------------------------------------------------------------------ + &"('Specified dependent variable boundary ',i0, & + &' conc (',g0,') is less than zero for cell', a)" ! ! -- check stress period data do i = 1, this%nbound node = this%nodelist(i) ! -- accumulate errors - if (this%bound(1, i) < DZERO) then + if (this%conc_mult(i) < DZERO) then call this%dis%noder_to_string(node, nodestr) - write (errmsg, fmt=fmtcncerr) i, this%bound(1, i), trim(nodestr) + write (errmsg, fmt=fmtcncerr) i, this%tspvar(i), trim(nodestr) call store_error(errmsg) end if end do ! ! -- write summary of cnc package error messages if (count_errors() > 0) then - call this%parser%StoreErrorUnit() + call store_error_filename(this%input_fname) end if ! - ! -- return + ! -- Return return end subroutine cnc_ck + !> @brief Override bnd_fc and do nothing + !! + !! For constant concentration/temperature boundary type, the call to bnd_fc + !! needs to be overwritten to prevent logic found in bnd from being executed + !< subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! cnc_fc -- Override bnd_fc and do nothing -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(GwtCncType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -259,19 +264,17 @@ subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local -! -------------------------------------------------------------------------- ! - ! -- return + ! -- Return return end subroutine cnc_fc + !> @brief Calculate flow associated with constant concentration/temperature + !! boundary + !! + !! This method overrides bnd_cq() + !< subroutine cnc_cq(this, x, flowja, iadv) -! ****************************************************************************** -! cnc_cq -- Calculate constant concenration flow. This method overrides bnd_cq(). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtCncType), intent(inout) :: this @@ -287,7 +290,6 @@ subroutine cnc_cq(this, x, flowja, iadv) real(DP) :: rate real(DP) :: ratein, rateout real(DP) :: q -! ------------------------------------------------------------------------------ ! ! -- If no boundaries, skip flow calculations. if (this%nbound > 0) then @@ -332,61 +334,65 @@ subroutine cnc_cq(this, x, flowja, iadv) ! end if ! - ! -- return + ! -- Return return end subroutine cnc_cq + !> @brief Add package ratin/ratout to model budget + !< subroutine cnc_bd(this, model_budget) - ! -- add package ratin/ratout to model budget + ! -- modules use TdisModule, only: delt use BudgetModule, only: BudgetType, rate_accumulator + ! -- dummy class(GwtCncType) :: this + ! -- local type(BudgetType), intent(inout) :: model_budget real(DP) :: ratin real(DP) :: ratout real(DP) :: dum integer(I4B) :: isuppress_output + ! isuppress_output = 0 call rate_accumulator(this%ratecncin(1:this%nbound), ratin, dum) call rate_accumulator(this%ratecncout(1:this%nbound), ratout, dum) call model_budget%addentry(ratin, ratout, delt, this%text, & isuppress_output, this%packName) + ! + ! -- Return + return end subroutine cnc_bd + !> @brief Deallocate memory + !! + !! Method to deallocate memory for the package. + !< subroutine cnc_da(this) -! ****************************************************************************** -! cnc_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtCncType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate parent package - call this%BndType%bnd_da() + call this%BndExtType%bnd_da() ! ! -- arrays call mem_deallocate(this%ratecncin) call mem_deallocate(this%ratecncout) + call mem_deallocate(this%tspvar, 'TSPVAR', this%memoryPath) ! - ! -- return + ! -- Return return end subroutine cnc_da + !> @brief Define labels used in list file + !! + !! Define the list heading that is written to iout when PRINT_INPUT option + !! is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(GwtCncType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -400,76 +406,67 @@ subroutine define_listlabel(this) else write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE' end if - write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONCENTRATION' + write (this%listlabel, '(a, a16)') trim(this%listlabel), & + trim(this%depvartype) if (this%inamedbound == 1) then write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel - ! -- Procedures related to observations - + !> @brief Procedure related to observation processing + !! + !! This routine: + !! - returns true because the SDV package supports observations, + !! - overrides packagetype%_obs_supported() logical function cnc_obs_supported(this) -! ****************************************************************************** -! cnc_obs_supported -! -- Return true because CNC package supports observations. -! -- Overrides packagetype%_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtCncType) :: this -! ------------------------------------------------------------------------------ ! cnc_obs_supported = .true. ! - ! -- return + ! -- Return return end function cnc_obs_supported + !> @brief Procedure related to observation processing + !! + !! This routine: + !! - defines observations + !! - stores observation types supported by either of the SDV packages + !! (CNC or CNT), + !! - overrides BndExtType%bnd_df_obs + !< subroutine cnc_df_obs(this) -! ****************************************************************************** -! cnc_df_obs (implements bnd_df_obs) -! -- Store observation type supported by CNC package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtCncType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! - call this%obs%StoreObsType('cnc', .true., indx) + call this%obs%StoreObsType(this%filtyp, .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine cnc_df_obs ! -- Procedure related to time series + !> @brief Procedure related to time series + !! + !! Assign tsLink%Text appropriately for all time series in use by package. + !! For any specified dependent variable package, for example either the + !! constant concentration or constant temperature packages, the dependent + !! variable can be controlled by time series. + !< subroutine cnc_rp_ts(this) -! ****************************************************************************** -! -- Assign tsLink%Text appropriately for -! all time series in use by package. -! In CNC package variable CONCENTRATION -! can be controlled by time series. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtCncType), intent(inout) :: this ! -- local integer(I4B) :: i, nlinks type(TimeSeriesLinkType), pointer :: tslink => null() -! ------------------------------------------------------------------------------ ! nlinks = this%TsManager%boundtslinks%Count() do i = 1, nlinks @@ -477,13 +474,63 @@ subroutine cnc_rp_ts(this) if (associated(tslink)) then select case (tslink%JCol) case (1) - tslink%Text = 'CONCENTRATION' + tslink%Text = trim(this%depvartype) end select end if end do ! - ! -- return + ! -- Return return end subroutine cnc_rp_ts + !> @brief Apply auxiliary multiplier to specified concentration if + !< appropriate + function conc_mult(this, row) result(conc) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(GwtCncType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: conc + ! + if (this%iauxmultcol > 0) then + conc = this%tspvar(row) * this%auxvar(this%iauxmultcol, row) + else + conc = this%tspvar(row) + end if + ! + ! -- Return + return + end function conc_mult + + !> @ brief Return a bound value + !! + !! Return a bound value associated with an ncolbnd index and row. + !< + function cnc_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(GwtCncType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + select case (col) + case (1) + bndval = this%conc_mult(row) + case default + write (errmsg, '(3a)') 'Programming error. ', & + & adjustl(trim(this%filtyp)), ' bound value requested column '& + &'outside range of ncolbnd (1).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + ! + ! -- Return + return + end function cnc_bound_value + end module GwtCncModule diff --git a/src/Model/GroundWaterTransport/gwt1cnc1idm.f90 b/src/Model/GroundWaterTransport/gwt1cnc1idm.f90 new file mode 100644 index 00000000000..2edbab4bfe5 --- /dev/null +++ b/src/Model/GroundWaterTransport/gwt1cnc1idm.f90 @@ -0,0 +1,411 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwtCncInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwt_cnc_param_definitions + public gwt_cnc_aggregate_definitions + public gwt_cnc_block_definitions + public GwtCncParamFoundType + public gwt_cnc_multi_package + + type GwtCncParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: boundnames = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: iprpak = .false. + logical :: ts_filerecord = .false. + logical :: ts6 = .false. + logical :: filein = .false. + logical :: ts6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: maxbound = .false. + logical :: cellid = .false. + logical :: tspvar = .false. + logical :: auxvar = .false. + logical :: boundname = .false. + end type GwtCncParamFoundType + + logical :: gwt_cnc_multi_package = .true. + + type(InputParamDefinitionType), parameter :: & + gwtcnc_auxiliary = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_auxmultname = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_boundnames = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'BOUNDNAMES', & ! tag name + 'BOUNDNAMES', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_iprflow = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_ipakcb = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_iprpak = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_ts_filerecord = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'TS_FILERECORD', & ! tag name + 'TS_FILERECORD', & ! fortran variable + 'RECORD TS6 FILEIN TS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_ts6 = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'TS6', & ! tag name + 'TS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_filein = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_ts6_filename = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'TS6_FILENAME', & ! tag name + 'TS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_obs_filerecord = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_obs6 = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_obs6_filename = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_maxbound = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_cellid = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'PERIOD', & ! block + 'CELLID', & ! tag name + 'CELLID', & ! fortran variable + 'INTEGER1D', & ! type + 'NCELLDIM', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_tspvar = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'PERIOD', & ! block + 'CONC', & ! tag name + 'TSPVAR', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_auxvar = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NAUX', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .true. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwtcnc_boundname = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'PERIOD', & ! block + 'BOUNDNAME', & ! tag name + 'BOUNDNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwt_cnc_param_definitions(*) = & + [ & + gwtcnc_auxiliary, & + gwtcnc_auxmultname, & + gwtcnc_boundnames, & + gwtcnc_iprflow, & + gwtcnc_ipakcb, & + gwtcnc_iprpak, & + gwtcnc_ts_filerecord, & + gwtcnc_ts6, & + gwtcnc_filein, & + gwtcnc_ts6_filename, & + gwtcnc_obs_filerecord, & + gwtcnc_obs6, & + gwtcnc_obs6_filename, & + gwtcnc_maxbound, & + gwtcnc_cellid, & + gwtcnc_tspvar, & + gwtcnc_auxvar, & + gwtcnc_boundname & + ] + + type(InputParamDefinitionType), parameter :: & + gwtcnc_spd = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'CNC', & ! subcomponent + 'PERIOD', & ! block + 'STRESS_PERIOD_DATA', & ! tag name + 'SPD', & ! fortran variable + 'RECARRAY CELLID CONC AUX BOUNDNAME', & ! type + 'MAXBOUND', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwt_cnc_aggregate_definitions(*) = & + [ & + gwtcnc_spd & + ] + + type(InputBlockDefinitionType), parameter :: & + gwt_cnc_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .true., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwtCncInputModule diff --git a/src/Model/GroundWaterTransport/gwt1dis1idm.f90 b/src/Model/GroundWaterTransport/gwt1dis1idm.f90 index dda32a6b3a1..9a0330c9461 100644 --- a/src/Model/GroundWaterTransport/gwt1dis1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1dis1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -40,7 +41,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -56,7 +58,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -72,7 +75,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -88,7 +92,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -104,7 +109,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -120,7 +126,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -136,7 +143,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -152,7 +160,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -168,7 +177,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -184,7 +194,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -200,7 +211,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -216,7 +228,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -232,7 +245,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +282,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterTransport/gwt1disu1idm.f90 b/src/Model/GroundWaterTransport/gwt1disu1idm.f90 index 1a194976e94..9b552f60f11 100644 --- a/src/Model/GroundWaterTransport/gwt1disu1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1disu1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisuInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -54,7 +55,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -70,7 +72,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -86,7 +89,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -102,7 +106,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -118,7 +123,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -134,7 +140,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -150,7 +157,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -166,7 +174,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -182,7 +191,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -198,7 +208,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -214,7 +225,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -230,7 +242,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -246,7 +259,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -262,7 +276,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -278,7 +293,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -294,7 +310,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -310,7 +327,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -326,7 +344,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -342,7 +361,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -358,7 +378,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +395,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +412,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -406,7 +429,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -422,7 +446,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -438,7 +463,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -454,7 +480,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -470,7 +497,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -515,10 +543,11 @@ module GwtDisuInputModule 'VERTICES', & ! fortran variable 'RECARRAY IV XV YV', & ! type 'NVERT', & ! shape - .true., & ! required + .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -531,10 +560,11 @@ module GwtDisuInputModule 'CELL2D', & ! fortran variable 'RECARRAY ICELL2D XC YC NCVERT ICVERT', & ! type 'NODES', & ! shape - .true., & ! required + .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -573,13 +603,13 @@ module GwtDisuInputModule ), & InputBlockDefinitionType( & 'VERTICES', & ! blockname - .true., & ! required + .false., & ! required .true., & ! aggregate .false. & ! block_variable ), & InputBlockDefinitionType( & 'CELL2D', & ! blockname - .true., & ! required + .false., & ! required .true., & ! aggregate .false. & ! block_variable ) & diff --git a/src/Model/GroundWaterTransport/gwt1disv1idm.f90 b/src/Model/GroundWaterTransport/gwt1disv1idm.f90 index 4ed35aca51a..615cc025374 100644 --- a/src/Model/GroundWaterTransport/gwt1disv1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1disv1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisvInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -46,7 +47,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -62,7 +64,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -78,7 +81,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -94,7 +98,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -110,7 +115,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -126,7 +132,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -142,7 +149,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +166,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -174,7 +183,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -190,7 +200,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -206,7 +217,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -222,7 +234,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -238,7 +251,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -254,7 +268,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -270,7 +285,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -286,7 +302,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -302,7 +319,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -318,7 +336,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -334,7 +353,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +394,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +411,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterTransport/gwt1dsp1.f90 b/src/Model/GroundWaterTransport/gwt1dsp1.f90 index 50881f867c7..427c7701e86 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp1.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp1.f90 @@ -4,7 +4,7 @@ module GwtDspModule use ConstantsModule, only: DONE, DZERO, DHALF, DPI use NumericalPackageModule, only: NumericalPackageType use BaseDisModule, only: DisBaseType - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use Xt3dModule, only: Xt3dType, xt3d_cr use GwtDspOptionsModule, only: GwtDspOptionsType use MatrixBaseModule @@ -17,7 +17,7 @@ module GwtDspModule type, extends(NumericalPackageType) :: GwtDspType integer(I4B), dimension(:), pointer, contiguous :: ibound => null() ! pointer to GWT model ibound - type(GwtFmiType), pointer :: fmi => null() ! pointer to GWT fmi object + type(TspFmiType), pointer :: fmi => null() ! pointer to GWT fmi object real(DP), dimension(:), pointer, contiguous :: thetam => null() ! pointer to GWT storage porosity (voids per aquifer volume) real(DP), dimension(:), pointer, contiguous :: diffc => null() ! molecular diffusion coefficient for each cell real(DP), dimension(:), pointer, contiguous :: alh => null() ! longitudinal horizontal dispersivity @@ -72,13 +72,9 @@ module GwtDspModule contains + !> @brief Create a DSP object + !< subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi) -! ****************************************************************************** -! dsp_cr -- Create a new DSP object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use KindModule, only: LGP use MemoryManagerExtModule, only: mem_set_value @@ -88,34 +84,27 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi) character(len=*), intent(in) :: input_mempath integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout - type(GwtFmiType), intent(in), target :: fmi + type(TspFmiType), intent(in), target :: fmi ! -- locals - logical(LGP) :: found_fname ! -- formats character(len=*), parameter :: fmtdsp = & "(1x,/1x,'DSP-- DISPERSION PACKAGE, VERSION 1, 1/24/2018', & &' INPUT READ FROM MEMPATH: ', A, //)" -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (dspobj) ! ! -- create name and memory path - call dspobj%set_names(1, name_model, 'DSP', 'DSP') + call dspobj%set_names(1, name_model, 'DSP', 'DSP', input_mempath) ! ! -- Allocate scalars call dspobj%allocate_scalars() ! ! -- Set variables - dspobj%input_mempath = input_mempath dspobj%inunit = inunit dspobj%iout = iout dspobj%fmi => fmi ! - ! -- set name of input file - call mem_set_value(dspobj%input_fname, 'INPUT_FNAME', dspobj%input_mempath, & - found_fname) - ! if (dspobj%inunit > 0) then ! ! -- Print a message identifying the dispersion package. @@ -128,13 +117,9 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi) return end subroutine dsp_cr + !> @brief Define DSP object + !< subroutine dsp_df(this, dis, dspOptions) -! ****************************************************************************** -! dsp_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtDspType) :: this @@ -142,7 +127,6 @@ subroutine dsp_df(this, dis, dspOptions) type(GwtDspOptionsType), optional, intent(in) :: dspOptions !< the optional DSP options, used when not !! creating DSP from file ! -- local -! ------------------------------------------------------------------------------ ! ! -- Store pointer to dis this%dis => dis @@ -179,13 +163,11 @@ subroutine dsp_df(this, dis, dspOptions) return end subroutine dsp_df + !> @brief Add connections to DSP + !! + !! Add connections for extended neighbors to the sparse matrix + !< subroutine dsp_ac(this, moffset, sparse) -! ****************************************************************************** -! dsp_ac -- Add connections for extended neighbors to the sparse matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix use MemoryManagerModule, only: mem_allocate @@ -194,7 +176,6 @@ subroutine dsp_ac(this, moffset, sparse) integer(I4B), intent(in) :: moffset type(sparsematrix), intent(inout) :: sparse ! -- local -! ------------------------------------------------------------------------------ ! ! -- Add extended neighbors (neighbors of neighbors) if (this%ixt3d > 0) call this%xt3d%xt3d_ac(moffset, sparse) @@ -203,13 +184,11 @@ subroutine dsp_ac(this, moffset, sparse) return end subroutine dsp_ac + !> @brief Map DSP connections + !! + !! Map connections and construct iax, jax, and idxglox + !< subroutine dsp_mc(this, moffset, matrix_sln) -! ****************************************************************************** -! dsp_mc -- Map connections and construct iax, jax, and idxglox -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -217,7 +196,6 @@ subroutine dsp_mc(this, moffset, matrix_sln) integer(I4B), intent(in) :: moffset class(MatrixBaseType), pointer :: matrix_sln ! -- local -! ------------------------------------------------------------------------------ ! ! -- Call xt3d map connections if (this%ixt3d > 0) call this%xt3d%xt3d_mc(moffset, matrix_sln) @@ -226,13 +204,11 @@ subroutine dsp_mc(this, moffset, matrix_sln) return end subroutine dsp_mc + !> @brief Allocate and read method for package + !! + !! Method to allocate and read static data for the package. + !< subroutine dsp_ar(this, ibound, thetam) -! ****************************************************************************** -! dsp_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtDspType) :: this @@ -243,7 +219,6 @@ subroutine dsp_ar(this, ibound, thetam) character(len=*), parameter :: fmtdsp = & "(1x,/1x,'DSP-- DISPERSION PACKAGE, VERSION 1, 1/24/2018', & &' INPUT READ FROM UNIT ', i0, //)" -! ------------------------------------------------------------------------------ ! ! -- dsp pointers to arguments that were passed in this%ibound => ibound @@ -253,19 +228,14 @@ subroutine dsp_ar(this, ibound, thetam) return end subroutine dsp_ar + !> @brief Advance method for the package + !< subroutine dsp_ad(this) -! ****************************************************************************** -! dsp_ad -- Advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper ! -- dummy class(GwtDspType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- xt3d ! TODO: might consider adding a new mf6 level set pointers method, and @@ -295,13 +265,11 @@ subroutine dsp_ad(this) return end subroutine dsp_ad + !> @brief Fill coefficient method for package + !! + !! Method to calculate and fill coefficients for the package. + !< subroutine dsp_fc(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, cnew) -! ****************************************************************************** -! dsp_fc -- Calculate coefficients and fill amat and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtDspType) :: this @@ -315,7 +283,6 @@ subroutine dsp_fc(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, cnew) ! -- local integer(I4B) :: n, m, idiag, idiagm, ipos, isympos, isymcon real(DP) :: dnm -! ------------------------------------------------------------------------------ ! if (this%ixt3d > 0) then call this%xt3d%xt3d_fc(kiter, matrix_sln, idxglo, rhs, cnew) @@ -348,13 +315,11 @@ subroutine dsp_fc(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, cnew) return end subroutine dsp_fc + !> @ brief Calculate flows for package + !! + !! Method to calculate dispersion contribution to flowja + !< subroutine dsp_cq(this, cnew, flowja) -! ****************************************************************************** -! dsp_cq -- Calculate dispersion contribution to flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtDspType) :: this @@ -363,7 +328,6 @@ subroutine dsp_cq(this, cnew, flowja) ! -- local integer(I4B) :: n, m, ipos, isympos real(DP) :: dnm -! ------------------------------------------------------------------------------ ! ! -- Calculate dispersion and add to flowja if (this%ixt3d > 0) then @@ -385,20 +349,17 @@ subroutine dsp_cq(this, cnew, flowja) return end subroutine dsp_cq + !> @ brief Allocate scalar variables for package + !! + !! Method to allocate scalar variables for the package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use ConstantsModule, only: DZERO ! -- dummy class(GwtDspType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in NumericalPackageType call this%NumericalPackageType%allocate_scalars() @@ -441,13 +402,11 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @ brief Allocate arrays for package + !! + !! Method to allocate arrays for the package. + !< subroutine allocate_arrays(this, nodes) -! ****************************************************************************** -! allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use ConstantsModule, only: DZERO @@ -455,7 +414,6 @@ subroutine allocate_arrays(this, nodes) class(GwtDspType) :: this integer(I4B), intent(in) :: nodes ! -- local -! ------------------------------------------------------------------------------ ! ! -- Allocate call mem_allocate(this%alh, nodes, 'ALH', trim(this%memoryPath)) @@ -483,13 +441,11 @@ subroutine allocate_arrays(this, nodes) return end subroutine allocate_arrays + !> @ brief Deallocate memory + !! + !! Method to deallocate memory for the package. + !< subroutine dsp_da(this) -! ****************************************************************************** -! dsp_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate use MemoryManagerExtModule, only: memorylist_remove @@ -497,7 +453,6 @@ subroutine dsp_da(this) ! -- dummy class(GwtDspType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- Deallocate input memory call memorylist_remove(this%name_model, 'DSP', idm_context) @@ -561,15 +516,13 @@ subroutine log_options(this, found) write (this%iout, '(4x,a,i0)') 'XT3D formulation [0=INACTIVE, 1=ACTIVE, & &3=ACTIVE RHS] set to: ', this%ixt3d write (this%iout, '(1x,a,/)') 'End Setting DSP Options' + ! -- Return + return end subroutine log_options + !> @brief Update simulation mempath options + !< subroutine source_options(this) -! ****************************************************************************** -! source_options -- update simulation mempath options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules !use KindModule, only: LGP use MemoryManagerExtModule, only: mem_set_value @@ -578,7 +531,6 @@ subroutine source_options(this) class(GwtDspType) :: this ! -- locals type(GwtDspParamFoundType) :: found -! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values call mem_set_value(this%ixt3doff, 'XT3D_OFF', this%input_mempath, & @@ -636,13 +588,9 @@ subroutine log_griddata(this, found) end subroutine log_griddata + !> @brief Update DSP simulation data from input mempath + !< subroutine source_griddata(this) -! ****************************************************************************** -! source_griddata -- update dsp simulation data from input mempath -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: count_errors, store_error use MemoryManagerModule, only: mem_reallocate, mem_reassignptr @@ -656,7 +604,6 @@ subroutine source_griddata(this) type(GwtDspParamFoundType) :: found integer(I4B), dimension(:), pointer, contiguous :: map ! -- formats -! ------------------------------------------------------------------------------ ! ! -- set map map => null() @@ -725,13 +672,9 @@ subroutine source_griddata(this) return end subroutine source_griddata + !> @brief Calculate dispersion coefficients + !< subroutine calcdispellipse(this) -! ****************************************************************************** -! calcdispellipse -- Calculate dispersion coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtDspType) :: this @@ -742,7 +685,6 @@ subroutine calcdispellipse(this) real(DP) :: al, at1, at2 real(DP) :: qzoqsquared real(DP) :: dstar -! ------------------------------------------------------------------------------ ! ! -- loop through and calculate dispersion coefficients and angles nodes = size(this%d11) @@ -844,13 +786,9 @@ subroutine calcdispellipse(this) return end subroutine calcdispellipse + !> @brief Calculate dispersion coefficients + !< subroutine calcdispcoef(this) -! ****************************************************************************** -! calcdispcoef -- Calculate dispersion coefficients -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use GwfNpfModule, only: hyeff_calc ! -- dummy @@ -864,7 +802,6 @@ subroutine calcdispcoef(this) real(DP) :: satn, satm, topn, topm, botn, botm real(DP) :: hwva, cond, cn, cm, denom real(DP) :: anm, amn, thksatn, thksatm, sill_top, sill_bot, tpn, tpm -! ------------------------------------------------------------------------------ ! ! -- set iavgmeth = 1 to use arithmetic averaging for effective dispersion iavgmeth = 1 diff --git a/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 b/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 index 0f9e3c29e1d..8b7a4e74332 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDspInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -35,7 +36,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -51,7 +53,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -67,7 +70,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -83,7 +87,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -99,7 +104,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -115,7 +121,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -131,7 +138,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -147,7 +155,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -178,7 +187,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterTransport/gwt1fmi1.f90 b/src/Model/GroundWaterTransport/gwt1fmi1.f90 deleted file mode 100644 index cf5680e1868..00000000000 --- a/src/Model/GroundWaterTransport/gwt1fmi1.f90 +++ /dev/null @@ -1,1570 +0,0 @@ -module GwtFmiModule - - use KindModule, only: DP, I4B - use ConstantsModule, only: DONE, DZERO, DHALF, LINELENGTH, LENBUDTXT, & - LENPACKAGENAME - use SimModule, only: store_error, store_error_unit - use SimVariablesModule, only: errmsg - use NumericalPackageModule, only: NumericalPackageType - use BaseDisModule, only: DisBaseType - use ListModule, only: ListType - use BudgetFileReaderModule, only: BudgetFileReaderType - use HeadFileReaderModule, only: HeadFileReaderType - use PackageBudgetModule, only: PackageBudgetType - use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr_bfr - use MatrixBaseModule - - implicit none - private - public :: GwtFmiType - public :: fmi_cr - - integer(I4B), parameter :: NBDITEMS = 2 - character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt - data budtxt/' FLOW-ERROR', ' FLOW-CORRECTION'/ - - type :: DataAdvancedPackageType - real(DP), dimension(:), contiguous, pointer :: concpack => null() - real(DP), dimension(:), contiguous, pointer :: qmfrommvr => null() - end type - - type :: BudObjPtrArray - type(BudgetObjectType), pointer :: ptr - end type BudObjPtrArray - - type, extends(NumericalPackageType) :: GwtFmiType - - logical, pointer :: flows_from_file => null() !< if .false., then flows come from GWF through GWF-GWT exg - integer(I4B), dimension(:), pointer, contiguous :: iatp => null() !< advanced transport package applied to gwfpackages - type(ListType), pointer :: gwfbndlist => null() !< list of gwf stress packages - integer(I4B), pointer :: iflowsupdated => null() !< flows were updated for this time step - integer(I4B), pointer :: iflowerr => null() !< add the flow error correction - real(DP), dimension(:), pointer, contiguous :: flowcorrect => null() !< mass flow correction - integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to GWT ibound - real(DP), dimension(:), pointer, contiguous :: gwfflowja => null() !< pointer to the GWF flowja array - real(DP), dimension(:, :), pointer, contiguous :: gwfspdis => null() !< pointer to npf specific discharge array - real(DP), dimension(:), pointer, contiguous :: gwfhead => null() !< pointer to the GWF head array - real(DP), dimension(:), pointer, contiguous :: gwfsat => null() !< pointer to the GWF saturation array - integer(I4B), dimension(:), pointer, contiguous :: ibdgwfsat0 => null() !< mark cells with saturation = 0 to exclude from dispersion - real(DP), dimension(:), pointer, contiguous :: gwfstrgss => null() !< pointer to flow model QSTOSS - real(DP), dimension(:), pointer, contiguous :: gwfstrgsy => null() !< pointer to flow model QSTOSY - integer(I4B), pointer :: igwfstrgss => null() !< indicates if gwfstrgss is available - integer(I4B), pointer :: igwfstrgsy => null() !< indicates if gwfstrgsy is available - integer(I4B), pointer :: iubud => null() !< unit number GWF budget file - integer(I4B), pointer :: iuhds => null() !< unit number GWF head file - integer(I4B), pointer :: iumvr => null() !< unit number GWF mover budget file - integer(I4B), pointer :: nflowpack => null() !< number of GWF flow packages - integer(I4B), dimension(:), pointer, contiguous :: igwfmvrterm => null() !< flag to indicate that gwf package is a mover term - type(BudgetFileReaderType) :: bfr !< budget file reader - type(HeadFileReaderType) :: hfr !< head file reader - type(PackageBudgetType), dimension(:), allocatable :: gwfpackages !< used to get flows between a package and gwf - type(BudgetObjectType), pointer :: mvrbudobj => null() !< pointer to the mover budget budget object - type(DataAdvancedPackageType), & - dimension(:), pointer, contiguous :: datp => null() - character(len=16), dimension(:), allocatable :: flowpacknamearray !< array of boundary package names (e.g. LAK-1, SFR-3, etc.) - type(BudObjPtrArray), dimension(:), allocatable :: aptbudobj !< flow budget objects for the advanced packages - contains - - procedure :: fmi_df - procedure :: fmi_ar - procedure :: fmi_rp - procedure :: fmi_ad - procedure :: fmi_fc - procedure :: fmi_cq - procedure :: fmi_bd - procedure :: fmi_ot_flow - procedure :: fmi_da - procedure :: allocate_scalars - procedure :: allocate_arrays - procedure :: gwfsatold - procedure :: read_options - procedure :: read_packagedata - procedure :: initialize_bfr - procedure :: advance_bfr - procedure :: finalize_bfr - procedure :: initialize_hfr - procedure :: advance_hfr - procedure :: finalize_hfr - procedure :: initialize_gwfterms_from_bfr - procedure :: initialize_gwfterms_from_gwfbndlist - procedure :: allocate_gwfpackages - procedure :: deallocate_gwfpackages - procedure :: get_package_index - procedure :: set_aptbudobj_pointer - - end type GwtFmiType - -contains - - subroutine fmi_cr(fmiobj, name_model, inunit, iout) -! ****************************************************************************** -! fmi_cr -- Create a new FMI object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy - type(GwtFmiType), pointer :: fmiobj - character(len=*), intent(in) :: name_model - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ - ! - ! -- Create the object - allocate (fmiobj) - ! - ! -- create name and memory path - call fmiobj%set_names(1, name_model, 'FMI', 'FMI') - ! - ! -- Allocate scalars - call fmiobj%allocate_scalars() - ! - ! -- if inunit == 0, then there is no file to read, but it still needs - ! to be active in order to manage pointers to gwf model - !if (inunit == 0) inunit = 1 - ! - ! -- Set variables - fmiobj%inunit = inunit - fmiobj%iout = iout - ! - ! -- Initialize block parser - call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout) - ! - ! -- Return - return - end subroutine fmi_cr - - subroutine fmi_df(this, dis, inssm) -! ****************************************************************************** -! fmi_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use SimModule, only: store_error - ! -- dummy - class(GwtFmiType) :: this - class(DisBaseType), pointer, intent(in) :: dis - integer(I4B), intent(in) :: inssm - ! -- local - ! -- formats - character(len=*), parameter :: fmtfmi = & - "(1x,/1x,'FMI -- FLOW MODEL INTERFACE, VERSION 1, 8/29/2017', & - &' INPUT READ FROM UNIT ', i0, //)" - character(len=*), parameter :: fmtfmi0 = & - &"(1x,/1x,'FMI -- FLOW MODEL INTERFACE, VERSION 1, 8/29/2017')" -! ------------------------------------------------------------------------------ - ! - ! --print a message identifying the FMI package. - if (this%iout > 0) then - if (this%inunit /= 0) then - write (this%iout, fmtfmi) this%inunit - else - write (this%iout, fmtfmi0) - if (this%flows_from_file) then - write (this%iout, '(a)') ' FLOWS ARE ASSUMED TO BE ZERO.' - else - write (this%iout, '(a)') ' FLOWS PROVIDED BY A GWF MODEL IN THIS & - &SIMULATION' - end if - end if - end if - ! - ! -- store pointers to arguments that were passed in - this%dis => dis - ! - ! -- Read fmi options - if (this%inunit /= 0) then - call this%read_options() - end if - ! - ! -- Read packagedata options - if (this%inunit /= 0 .and. this%flows_from_file) then - call this%read_packagedata() - call this%initialize_gwfterms_from_bfr() - end if - ! - ! -- If GWF-GWT exchange is active, then setup gwfterms from bndlist - if (.not. this%flows_from_file) then - call this%initialize_gwfterms_from_gwfbndlist() - end if - ! - ! -- Make sure that ssm is on if there are any boundary packages - if (inssm == 0) then - if (this%nflowpack > 0) then - call store_error('Flow model has boundary packages, but there & - &is no SSM package. The SSM package must be activated.', & - terminate=.TRUE.) - end if - end if - ! - ! -- Return - return - end subroutine fmi_df - - subroutine fmi_ar(this, ibound) -! ****************************************************************************** -! fmi_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use SimModule, only: store_error - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), dimension(:), pointer, contiguous :: ibound - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ - ! - ! -- store pointers to arguments that were passed in - this%ibound => ibound - ! - ! -- Allocate arrays - call this%allocate_arrays(this%dis%nodes) - ! - ! -- Return - return - end subroutine fmi_ar - - subroutine fmi_rp(this, inmvr) -! ****************************************************************************** -! fmi_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use TdisModule, only: kper, kstp - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: inmvr - ! -- local - ! -- formats -! ------------------------------------------------------------------------------ - ! - ! --Check to make sure MVT Package is active if mvr flows are available. - ! This cannot be checked until RP because exchange doesn't set a pointer - ! to mvrbudobj until exg_ar(). - if (kper * kstp == 1) then - if (associated(this%mvrbudobj) .and. inmvr == 0) then - write (errmsg, '(a)') 'GWF water mover is active but the GWT MVT & - &package has not been specified. activate GWT MVT package.' - call store_error(errmsg, terminate=.TRUE.) - end if - if (.not. associated(this%mvrbudobj) .and. inmvr > 0) then - write (errmsg, '(a)') 'GWF water mover terms are not available & - &but the GWT MVT package has been activated. Activate GWF-GWT & - &exchange or specify GWFMOVER in FMI PACKAGEDATA.' - call store_error(errmsg, terminate=.TRUE.) - end if - end if - ! - ! -- Return - return - end subroutine fmi_rp - - subroutine fmi_ad(this, cnew) -! ****************************************************************************** -! fmi_ad -- advance -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: DHDRY - ! -- dummy - class(GwtFmiType) :: this - real(DP), intent(inout), dimension(:) :: cnew - ! -- local - integer(I4B) :: n - integer(I4B) :: m - integer(I4B) :: ipos - real(DP) :: crewet, tflow, flownm - character(len=15) :: nodestr - character(len=*), parameter :: fmtdry = & - &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE & - &WITH DRY CONCENTRATION = ', G13.5)" - character(len=*), parameter :: fmtrewet = & - &"(/1X,'DRY CELL REACTIVATED AT ', a,& - &' WITH STARTING CONCENTRATION =',G13.5)" -! ------------------------------------------------------------------------------ - ! - ! -- Set flag to indicated that flows are being updated. For the case where - ! flows may be reused (only when flows are read from a file) then set - ! the flag to zero to indicated that flows were not updated - this%iflowsupdated = 1 - ! - ! -- If reading flows from a budget file, read the next set of records - if (this%iubud /= 0) then - call this%advance_bfr() - end if - ! - ! -- If reading heads from a head file, read the next set of records - if (this%iuhds /= 0) then - call this%advance_hfr() - end if - ! - ! -- If mover flows are being read from file, read the next set of records - if (this%iumvr /= 0) then - call this%mvrbudobj%bfr_advance(this%dis, this%iout) - end if - ! - ! -- If advanced package flows are being read from file, read the next set of records - if (this%flows_from_file .and. this%inunit /= 0) then - do n = 1, size(this%aptbudobj) - call this%aptbudobj(n)%ptr%bfr_advance(this%dis, this%iout) - end do - end if - ! - ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry - do n = 1, this%dis%nodes - ! - ! -- Calculate the ibound-like array that has 0 if saturation - ! is zero and 1 otherwise - if (this%gwfsat(n) > DZERO) then - this%ibdgwfsat0(n) = 1 - else - this%ibdgwfsat0(n) = 0 - end if - ! - ! -- Check if active transport cell is inactive for flow - if (this%ibound(n) > 0) then - if (this%gwfhead(n) == DHDRY) then - ! -- transport cell should be made inactive - this%ibound(n) = 0 - cnew(n) = DHDRY - call this%dis%noder_to_string(n, nodestr) - write (this%iout, fmtdry) trim(nodestr), DHDRY - end if - end if - ! - ! -- Convert dry transport cell to active if flow has rewet - if (cnew(n) == DHDRY) then - if (this%gwfhead(n) /= DHDRY) then - ! - ! -- obtain weighted concentration - crewet = DZERO - tflow = DZERO - do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 - m = this%dis%con%ja(ipos) - flownm = this%gwfflowja(ipos) - if (flownm > 0) then - if (this%ibound(m) /= 0) then - crewet = crewet + cnew(m) * flownm - tflow = tflow + this%gwfflowja(ipos) - end if - end if - end do - if (tflow > DZERO) then - crewet = crewet / tflow - else - crewet = DZERO - end if - ! - ! -- cell is now wet - this%ibound(n) = 1 - cnew(n) = crewet - call this%dis%noder_to_string(n, nodestr) - write (this%iout, fmtrewet) trim(nodestr), crewet - end if - end if - end do - ! - ! -- Return - return - end subroutine fmi_ad - - subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) -! ****************************************************************************** -! fmi_fc -- Calculate coefficients and fill matrix and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - !use BndModule, only: BndType, GetBndFromList - ! -- dummy - class(GwtFmiType) :: this - integer, intent(in) :: nodes - real(DP), intent(in), dimension(nodes) :: cold - integer(I4B), intent(in) :: nja - class(MatrixBaseType), pointer :: matrix_sln - integer(I4B), intent(in), dimension(nja) :: idxglo - real(DP), intent(inout), dimension(nodes) :: rhs - ! -- local - integer(I4B) :: n, idiag, idiag_sln -! ------------------------------------------------------------------------------ - ! - ! -- Calculate the flow imbalance error and make a correction for it - if (this%iflowerr /= 0) then - ! - ! -- Correct the transport solution for the flow imbalance by adding - ! the flow residual to the diagonal - do n = 1, nodes - idiag = this%dis%con%ia(n) - idiag_sln = idxglo(idiag) - call matrix_sln%add_value_pos(idiag_sln, -this%gwfflowja(idiag)) - end do - end if - ! - ! -- Return - return - end subroutine fmi_fc - - subroutine fmi_cq(this, cnew, flowja) -! ****************************************************************************** -! fmi_cq -- Calculate flow correction -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy - class(GwtFmiType) :: this - real(DP), intent(in), dimension(:) :: cnew - real(DP), dimension(:), contiguous, intent(inout) :: flowja - ! -- local - integer(I4B) :: n - integer(I4B) :: idiag - real(DP) :: rate -! ------------------------------------------------------------------------------ - ! - ! -- If not adding flow error correction, return - if (this%iflowerr /= 0) then - ! - ! -- Accumulate the flow correction term - do n = 1, this%dis%nodes - rate = DZERO - idiag = this%dis%con%ia(n) - if (this%ibound(n) > 0) then - rate = -this%gwfflowja(idiag) * cnew(n) - end if - this%flowcorrect(n) = rate - flowja(idiag) = flowja(idiag) + rate - end do - end if - ! - ! -- Return - return - end subroutine fmi_cq - - subroutine fmi_bd(this, isuppress_output, model_budget) -! ****************************************************************************** -! mst_bd -- Calculate budget terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use TdisModule, only: delt - use BudgetModule, only: BudgetType, rate_accumulator - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: isuppress_output - type(BudgetType), intent(inout) :: model_budget - ! -- local - real(DP) :: rin - real(DP) :: rout -! ------------------------------------------------------------------------------ - ! - ! -- flow correction - if (this%iflowerr /= 0) then - call rate_accumulator(this%flowcorrect, rin, rout) - call model_budget%addentry(rin, rout, delt, budtxt(2), isuppress_output) - end if - ! - ! -- Return - return - end subroutine fmi_bd - - subroutine fmi_ot_flow(this, icbcfl, icbcun) -! ****************************************************************************** -! fmi_ot_flow -- Save budget terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: icbcfl - integer(I4B), intent(in) :: icbcun - ! -- local - integer(I4B) :: ibinun - integer(I4B) :: iprint, nvaluesp, nwidthp - character(len=1) :: cdatafmp = ' ', editdesc = ' ' - real(DP) :: dinact -! ------------------------------------------------------------------------------ - ! - ! -- Set unit number for binary output - if (this%ipakcb < 0) then - ibinun = icbcun - elseif (this%ipakcb == 0) then - ibinun = 0 - else - ibinun = this%ipakcb - end if - if (icbcfl == 0) ibinun = 0 - ! - ! -- Do not save flow corrections if not active - if (this%iflowerr == 0) ibinun = 0 - ! - ! -- Record the storage rates if requested - if (ibinun /= 0) then - iprint = 0 - dinact = DZERO - ! - ! -- flow correction - call this%dis%record_array(this%flowcorrect, this%iout, iprint, -ibinun, & - budtxt(2), cdatafmp, nvaluesp, & - nwidthp, editdesc, dinact) - end if - ! - ! -- Return - return - end subroutine fmi_ot_flow - - subroutine fmi_da(this) -! ****************************************************************************** -! fmi_da -- Deallocate variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_deallocate - ! -- dummy - class(GwtFmiType) :: this -! ------------------------------------------------------------------------------ - ! -- todo: finalize hfr and bfr either here or in a finalize routine - ! - ! -- deallocate any memory stored with gwfpackages - call this%deallocate_gwfpackages() - ! - ! -- deallocate fmi arrays - if (associated(this%datp)) then - deallocate (this%datp) - deallocate (this%gwfpackages) - deallocate (this%flowpacknamearray) - call mem_deallocate(this%iatp) - call mem_deallocate(this%igwfmvrterm) - end if - - deallocate (this%aptbudobj) - call mem_deallocate(this%flowcorrect) - call mem_deallocate(this%ibdgwfsat0) - if (this%flows_from_file) then - call mem_deallocate(this%gwfstrgss) - call mem_deallocate(this%gwfstrgsy) - end if - ! - ! -- special treatment, these could be from mem_checkin - call mem_deallocate(this%gwfhead, 'GWFHEAD', this%memoryPath) - call mem_deallocate(this%gwfsat, 'GWFSAT', this%memoryPath) - call mem_deallocate(this%gwfspdis, 'GWFSPDIS', this%memoryPath) - call mem_deallocate(this%gwfflowja, 'GWFFLOWJA', this%memoryPath) - ! - ! -- deallocate scalars - call mem_deallocate(this%flows_from_file) - call mem_deallocate(this%iflowsupdated) - call mem_deallocate(this%iflowerr) - call mem_deallocate(this%igwfstrgss) - call mem_deallocate(this%igwfstrgsy) - call mem_deallocate(this%iubud) - call mem_deallocate(this%iuhds) - call mem_deallocate(this%iumvr) - call mem_deallocate(this%nflowpack) - ! - ! -- deallocate parent - call this%NumericalPackageType%da() - ! - ! -- Return - return - end subroutine fmi_da - - subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate, mem_setptr - ! -- dummy - class(GwtFmiType) :: this - ! -- local -! ------------------------------------------------------------------------------ - ! - ! -- allocate scalars in NumericalPackageType - call this%NumericalPackageType%allocate_scalars() - ! - ! -- Allocate - call mem_allocate(this%flows_from_file, 'FLOWS_FROM_FILE', this%memoryPath) - call mem_allocate(this%iflowsupdated, 'IFLOWSUPDATED', this%memoryPath) - call mem_allocate(this%iflowerr, 'IFLOWERR', this%memoryPath) - call mem_allocate(this%igwfstrgss, 'IGWFSTRGSS', this%memoryPath) - call mem_allocate(this%igwfstrgsy, 'IGWFSTRGSY', this%memoryPath) - call mem_allocate(this%iubud, 'IUBUD', this%memoryPath) - call mem_allocate(this%iuhds, 'IUHDS', this%memoryPath) - call mem_allocate(this%iumvr, 'IUMVR', this%memoryPath) - call mem_allocate(this%nflowpack, 'NFLOWPACK', this%memoryPath) - ! - ! -- Although not a scalar, allocate the advanced package transport - ! budget object to zero so that it can be dynamically resized later - allocate (this%aptbudobj(0)) - ! - ! -- Initialize - this%flows_from_file = .true. - this%iflowsupdated = 1 - this%iflowerr = 0 - this%igwfstrgss = 0 - this%igwfstrgsy = 0 - this%iubud = 0 - this%iuhds = 0 - this%iumvr = 0 - this%nflowpack = 0 - ! - ! -- Return - return - end subroutine allocate_scalars - - subroutine allocate_arrays(this, nodes) -! ****************************************************************************** -! allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use MemoryManagerModule, only: mem_allocate - !modules - use ConstantsModule, only: DZERO - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: nodes - ! -- local - integer(I4B) :: n -! ------------------------------------------------------------------------------ - ! - ! -- Allocate variables needed for all cases - if (this%iflowerr == 0) then - call mem_allocate(this%flowcorrect, 1, 'FLOWCORRECT', this%memoryPath) - else - call mem_allocate(this%flowcorrect, nodes, 'FLOWCORRECT', this%memoryPath) - end if - do n = 1, size(this%flowcorrect) - this%flowcorrect(n) = DZERO - end do - ! - ! -- Allocate ibdgwfsat0, which is an indicator array marking cells with - ! saturation greater than 0.0 with a value of 1 - call mem_allocate(this%ibdgwfsat0, nodes, 'IBDGWFSAT0', this%memoryPath) - do n = 1, nodes - this%ibdgwfsat0(n) = 1 - end do - ! - ! -- Allocate differently depending on whether or not flows are - ! being read from a file. - if (this%flows_from_file) then - call mem_allocate(this%gwfflowja, this%dis%con%nja, 'GWFFLOWJA', & - this%memoryPath) - call mem_allocate(this%gwfsat, nodes, 'GWFSAT', this%memoryPath) - call mem_allocate(this%gwfhead, nodes, 'GWFHEAD', this%memoryPath) - call mem_allocate(this%gwfspdis, 3, nodes, 'GWFSPDIS', this%memoryPath) - do n = 1, nodes - this%gwfsat(n) = DONE - this%gwfhead(n) = DZERO - this%gwfspdis(:, n) = DZERO - end do - do n = 1, size(this%gwfflowja) - this%gwfflowja(n) = DZERO - end do - ! - ! -- allocate and initialize storage arrays - if (this%igwfstrgss == 0) then - call mem_allocate(this%gwfstrgss, 1, 'GWFSTRGSS', this%memoryPath) - else - call mem_allocate(this%gwfstrgss, nodes, 'GWFSTRGSS', this%memoryPath) - end if - if (this%igwfstrgsy == 0) then - call mem_allocate(this%gwfstrgsy, 1, 'GWFSTRGSY', this%memoryPath) - else - call mem_allocate(this%gwfstrgsy, nodes, 'GWFSTRGSY', this%memoryPath) - end if - do n = 1, size(this%gwfstrgss) - this%gwfstrgss(n) = DZERO - end do - do n = 1, size(this%gwfstrgsy) - this%gwfstrgsy(n) = DZERO - end do - ! - ! -- If there is no fmi package, then there are no flows at all or a - ! connected GWF model, so allocate gwfpackages to zero - if (this%inunit == 0) call this%allocate_gwfpackages(this%nflowpack) - end if - ! - ! -- Return - return - end subroutine allocate_arrays - - function gwfsatold(this, n, delt) result(satold) -! ****************************************************************************** -! gwfsatold -- calculate the groundwater cell head saturation for the end of -! the last time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: n - real(DP), intent(in) :: delt - ! -- result - real(DP) :: satold - ! -- local - real(DP) :: vcell - real(DP) :: vnew - real(DP) :: vold -! ------------------------------------------------------------------------------ - ! - ! -- calculate the value - vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n)) - vnew = vcell * this%gwfsat(n) - vold = vnew - if (this%igwfstrgss /= 0) vold = vold + this%gwfstrgss(n) * delt - if (this%igwfstrgsy /= 0) vold = vold + this%gwfstrgsy(n) * delt - satold = vold / vcell - ! - ! -- Return - return - end function gwfsatold - - subroutine read_options(this) -! ****************************************************************************** -! read_options -- Read Options -! Subroutine: (1) read options from input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH, DEM6 - use InputOutputModule, only: getunit, openfile, urdaux - use SimModule, only: store_error, store_error_unit - ! -- dummy - class(GwtFmiType) :: this - ! -- local - character(len=LINELENGTH) :: keyword - integer(I4B) :: ierr - logical :: isfound, endOfBlock - character(len=*), parameter :: fmtisvflow = & - "(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY FILE & - &WHENEVER ICBCFL IS NOT ZERO AND FLOW IMBALANCE CORRECTION ACTIVE.')" - character(len=*), parameter :: fmtifc = & - &"(4x,'MASS WILL BE ADDED OR REMOVED TO COMPENSATE FOR FLOW IMBALANCE.')" -! ------------------------------------------------------------------------------ - ! - ! -- get options block - call this%parser%GetBlock('OPTIONS', isfound, ierr, blockRequired=.false., & - supportOpenClose=.true.) - ! - ! -- parse options block if detected - if (isfound) then - write (this%iout, '(1x,a)') 'PROCESSING FMI OPTIONS' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case ('SAVE_FLOWS') - this%ipakcb = -1 - write (this%iout, fmtisvflow) - case ('FLOW_IMBALANCE_CORRECTION') - write (this%iout, fmtifc) - this%iflowerr = 1 - case default - write (errmsg, '(a,a)') 'Unknown FMI option: ', & - trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - write (this%iout, '(1x,a)') 'END OF FMI OPTIONS' - end if - ! - ! -- return - return - end subroutine read_options - - subroutine read_packagedata(this) -! ****************************************************************************** -! read_packagedata -- Read PACKAGEDATA block -! Subroutine: (1) read packagedata block from input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use OpenSpecModule, only: ACCESS, FORM - use ConstantsModule, only: LINELENGTH, DEM6, LENPACKAGENAME - use InputOutputModule, only: getunit, openfile, urdaux - use SimModule, only: store_error, store_error_unit - ! -- dummy - class(GwtFmiType) :: this - ! -- local - type(BudgetObjectType), pointer :: budobjptr - character(len=LINELENGTH) :: keyword, fname - character(len=LENPACKAGENAME) :: pname - integer(I4B) :: i - integer(I4B) :: ierr - integer(I4B) :: inunit - integer(I4B) :: iapt - logical :: isfound, endOfBlock - logical :: blockrequired - logical :: exist - type(BudObjPtrArray), dimension(:), allocatable :: tmpbudobj -! ------------------------------------------------------------------------------ - ! - ! -- initialize - iapt = 0 - blockrequired = .true. - ! - ! -- get options block - call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & - blockRequired=blockRequired, & - supportOpenClose=.true.) - ! - ! -- parse options block if detected - if (isfound) then - write (this%iout, '(1x,a)') 'PROCESSING FMI PACKAGEDATA' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - select case (keyword) - case ('GWFBUDGET') - call this%parser%GetStringCaps(keyword) - if (keyword /= 'FILEIN') then - call store_error('GWFBUDGET keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - inunit = getunit() - inquire (file=trim(fname), exist=exist) - if (.not. exist) then - call store_error('Could not find file '//trim(fname)) - call this%parser%StoreErrorUnit() - end if - call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & - ACCESS, 'UNKNOWN') - this%iubud = inunit - call this%initialize_bfr() - case ('GWFHEAD') - call this%parser%GetStringCaps(keyword) - if (keyword /= 'FILEIN') then - call store_error('GWFHEAD keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - inquire (file=trim(fname), exist=exist) - if (.not. exist) then - call store_error('Could not find file '//trim(fname)) - call this%parser%StoreErrorUnit() - end if - inunit = getunit() - call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & - ACCESS, 'UNKNOWN') - this%iuhds = inunit - call this%initialize_hfr() - case ('GWFMOVER') - call this%parser%GetStringCaps(keyword) - if (keyword /= 'FILEIN') then - call store_error('GWFMOVER keyword must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - inunit = getunit() - call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & - ACCESS, 'UNKNOWN') - this%iumvr = inunit - call budgetobject_cr_bfr(this%mvrbudobj, 'MVT', this%iumvr, & - this%iout) - call this%mvrbudobj%fill_from_bfr(this%dis, this%iout) - case default - ! - ! --expand the size of aptbudobj, which stores a pointer to the budobj - allocate (tmpbudobj(iapt)) - do i = 1, size(this%aptbudobj) - tmpbudobj(i)%ptr => this%aptbudobj(i)%ptr - end do - deallocate (this%aptbudobj) - allocate (this%aptbudobj(iapt + 1)) - do i = 1, size(tmpbudobj) - this%aptbudobj(i)%ptr => tmpbudobj(i)%ptr - end do - deallocate (tmpbudobj) - ! - ! -- Open the budget file and start filling it - iapt = iapt + 1 - pname = keyword(1:LENPACKAGENAME) - call this%parser%GetStringCaps(keyword) - if (keyword /= 'FILEIN') then - call store_error('Package name must be followed by '// & - '"FILEIN" then by filename.') - call this%parser%StoreErrorUnit() - end if - call this%parser%GetString(fname) - inunit = getunit() - call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & - ACCESS, 'UNKNOWN') - call budgetobject_cr_bfr(budobjptr, pname, inunit, & - this%iout, colconv2=['GWF ']) - call budobjptr%fill_from_bfr(this%dis, this%iout) - this%aptbudobj(iapt)%ptr => budobjptr - end select - end do - write (this%iout, '(1x,a)') 'END OF FMI PACKAGEDATA' - end if - ! - ! -- return - return - end subroutine read_packagedata - - subroutine set_aptbudobj_pointer(this, name, budobjptr) -! ****************************************************************************** -! set_aptbudobj_pointer -- an advanced transport can pass in a name and a -! pointer budget object, and this routine will look through the budget -! objects managed by FMI and point to the one with the same name, such as -! LAK-1, SFR-1, etc. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - class(GwtFmiType) :: this - ! -- dumm - character(len=*), intent(in) :: name - type(BudgetObjectType), pointer :: budobjptr - ! -- local - integer(I4B) :: i -! ------------------------------------------------------------------------------ - ! - ! -- find and set the pointer - do i = 1, size(this%aptbudobj) - if (this%aptbudobj(i)%ptr%name == name) then - budobjptr => this%aptbudobj(i)%ptr - exit - end if - end do - ! - ! -- return - return - end subroutine set_aptbudobj_pointer - - subroutine initialize_bfr(this) -! ****************************************************************************** -! initialize_bfr -- initalize the budget file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - class(GwtFmiType) :: this - ! -- dummy - integer(I4B) :: ncrbud -! ------------------------------------------------------------------------------ - ! - ! -- Initialize the budget file reader - call this%bfr%initialize(this%iubud, this%iout, ncrbud) - ! - ! -- todo: need to run through the budget terms - ! and do some checking - end subroutine initialize_bfr - - subroutine advance_bfr(this) -! ****************************************************************************** -! advance_bfr -- advance the budget file reader by reading the next chunk -! of information for the current time step and stress period -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use TdisModule, only: kstp, kper - ! -- dummy - class(GwtFmiType) :: this - ! -- local - logical :: success - integer(I4B) :: n - integer(I4B) :: ipos - integer(I4B) :: nu, nr - integer(I4B) :: ip, i - logical :: readnext - ! -- format - character(len=*), parameter :: fmtkstpkper = & - &"(1x,/1x,'FMI READING BUDGET TERMS FOR KSTP ', i0, ' KPER ', i0)" - character(len=*), parameter :: fmtbudkstpkper = & - "(1x,/1x, 'FMI SETTING BUDGET TERMS FOR KSTP ', i0, ' AND KPER ', & - &i0, ' TO BUDGET FILE TERMS FROM KSTP ', i0, ' AND KPER ', i0)" -! ------------------------------------------------------------------------------ - ! - ! -- If the latest record read from the budget file is from a stress - ! -- period with only one time step, reuse that record (do not read a - ! -- new record) if the GWT model is still in that same stress period, - ! -- or if that record is the last one in the budget file. - readnext = .true. - if (kstp * kper > 1) then - if (this%bfr%kstp == 1) then - if (this%bfr%kpernext == kper + 1) then - readnext = .false. - else if (this%bfr%endoffile) then - readnext = .false. - end if - else if (this%bfr%endoffile) then - write (errmsg, '(a)') 'Reached end of GWF budget & - &file before reading sufficient budget information for this & - &GWT simulation.' - call store_error(errmsg) - call store_error_unit(this%iubud) - end if - end if - ! - ! -- Read the next record - if (readnext) then - ! - ! -- Write the current time step and stress period - write (this%iout, fmtkstpkper) kstp, kper - ! - ! -- loop through the budget terms for this stress period - ! i is the counter for gwf flow packages - ip = 1 - do n = 1, this%bfr%nbudterms - call this%bfr%read_record(success, this%iout) - if (.not. success) then - write (errmsg, '(a)') 'GWF budget read not successful' - call store_error(errmsg) - call store_error_unit(this%iubud) - end if - ! - ! -- Ensure kper is same between model and budget file - if (kper /= this%bfr%kper) then - write (errmsg, '(a)') 'Period number in budget file & - &does not match period number in transport model. If there & - &is more than one time step in the budget file for a given stress & - &period, budget file time steps must match GWT model time steps & - &one-for-one in that stress period.' - call store_error(errmsg) - call store_error_unit(this%iubud) - end if - ! - ! -- if budget file kstp > 1, then kstp must match - if (this%bfr%kstp > 1 .and. (kstp /= this%bfr%kstp)) then - write (errmsg, '(a)') 'Time step number in budget file & - &does not match time step number in transport model. If there & - &is more than one time step in the budget file for a given stress & - &period, budget file time steps must match gwt model time steps & - &one-for-one in that stress period.' - call store_error(errmsg) - call store_error_unit(this%iubud) - end if - ! - ! -- parse based on the type of data, and compress all user node - ! numbers into reduced node numbers - select case (trim(adjustl(this%bfr%budtxt))) - case ('FLOW-JA-FACE') - ! - ! -- bfr%flowja contains only reduced connections so there is - ! a one-to-one match with this%gwfflowja - do ipos = 1, size(this%bfr%flowja) - this%gwfflowja(ipos) = this%bfr%flowja(ipos) - end do - case ('DATA-SPDIS') - do i = 1, this%bfr%nlist - nu = this%bfr%nodesrc(i) - nr = this%dis%get_nodenumber(nu, 0) - if (nr <= 0) cycle - this%gwfspdis(1, nr) = this%bfr%auxvar(1, i) - this%gwfspdis(2, nr) = this%bfr%auxvar(2, i) - this%gwfspdis(3, nr) = this%bfr%auxvar(3, i) - end do - case ('DATA-SAT') - do i = 1, this%bfr%nlist - nu = this%bfr%nodesrc(i) - nr = this%dis%get_nodenumber(nu, 0) - if (nr <= 0) cycle - this%gwfsat(nr) = this%bfr%auxvar(1, i) - end do - case ('STO-SS') - do nu = 1, this%dis%nodesuser - nr = this%dis%get_nodenumber(nu, 0) - if (nr <= 0) cycle - this%gwfstrgss(nr) = this%bfr%flow(nu) - end do - case ('STO-SY') - do nu = 1, this%dis%nodesuser - nr = this%dis%get_nodenumber(nu, 0) - if (nr <= 0) cycle - this%gwfstrgsy(nr) = this%bfr%flow(nu) - end do - case default - call this%gwfpackages(ip)%copy_values( & - this%bfr%nlist, & - this%bfr%nodesrc, & - this%bfr%flow, & - this%bfr%auxvar) - do i = 1, this%gwfpackages(ip)%nbound - nu = this%gwfpackages(ip)%nodelist(i) - nr = this%dis%get_nodenumber(nu, 0) - this%gwfpackages(ip)%nodelist(i) = nr - end do - ip = ip + 1 - end select - end do - else - ! - ! -- write message to indicate that flows are being reused - write (this%iout, fmtbudkstpkper) kstp, kper, this%bfr%kstp, this%bfr%kper - ! - ! -- set the flag to indicate that flows were not updated - this%iflowsupdated = 0 - end if - end subroutine advance_bfr - - subroutine finalize_bfr(this) -! ****************************************************************************** -! finalize_bfr -- finalize the budget file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - class(GwtFmiType) :: this - ! -- dummy -! ------------------------------------------------------------------------------ - ! - ! -- Finalize the budget file reader - call this%bfr%finalize() - ! - end subroutine finalize_bfr - - subroutine initialize_hfr(this) -! ****************************************************************************** -! initialize_hfr -- initalize the head file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - class(GwtFmiType) :: this - ! -- dummy -! ------------------------------------------------------------------------------ - ! - ! -- Initialize the budget file reader - call this%hfr%initialize(this%iuhds, this%iout) - ! - ! -- todo: need to run through the head terms - ! and do some checking - end subroutine initialize_hfr - - subroutine advance_hfr(this) -! ****************************************************************************** -! advance_hfr -- advance the head file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use TdisModule, only: kstp, kper - class(GwtFmiType) :: this - integer(I4B) :: nu, nr, i, ilay - integer(I4B) :: ncpl - real(DP) :: val - logical :: readnext - logical :: success - character(len=*), parameter :: fmtkstpkper = & - &"(1x,/1x,'FMI READING HEAD FOR KSTP ', i0, ' KPER ', i0)" - character(len=*), parameter :: fmthdskstpkper = & - "(1x,/1x, 'FMI SETTING HEAD FOR KSTP ', i0, ' AND KPER ', & - &i0, ' TO BINARY FILE HEADS FROM KSTP ', i0, ' AND KPER ', i0)" -! ------------------------------------------------------------------------------ - ! - ! -- If the latest record read from the head file is from a stress - ! -- period with only one time step, reuse that record (do not read a - ! -- new record) if the GWT model is still in that same stress period, - ! -- or if that record is the last one in the head file. - readnext = .true. - if (kstp * kper > 1) then - if (this%hfr%kstp == 1) then - if (this%hfr%kpernext == kper + 1) then - readnext = .false. - else if (this%hfr%endoffile) then - readnext = .false. - end if - else if (this%hfr%endoffile) then - write (errmsg, '(a)') 'Reached end of GWF head & - &file before reading sufficient head information for this & - &GWT simulation.' - call store_error(errmsg) - call store_error_unit(this%iuhds) - end if - end if - ! - ! -- Read the next record - if (readnext) then - ! - ! -- write to list file that heads are being read - write (this%iout, fmtkstpkper) kstp, kper - ! - ! -- loop through the layered heads for this time step - do ilay = 1, this%hfr%nlay - ! - ! -- read next head chunk - call this%hfr%read_record(success, this%iout) - if (.not. success) then - write (errmsg, '(a)') 'GWF head read not successful' - call store_error(errmsg) - call store_error_unit(this%iuhds) - end if - ! - ! -- Ensure kper is same between model and head file - if (kper /= this%hfr%kper) then - write (errmsg, '(a)') 'Period number in head file & - &does not match period number in transport model. If there & - &is more than one time step in the head file for a given stress & - &period, head file time steps must match gwt model time steps & - &one-for-one in that stress period.' - call store_error(errmsg) - call store_error_unit(this%iuhds) - end if - ! - ! -- if head file kstp > 1, then kstp must match - if (this%hfr%kstp > 1 .and. (kstp /= this%hfr%kstp)) then - write (errmsg, '(a)') 'Time step number in head file & - &does not match time step number in transport model. If there & - &is more than one time step in the head file for a given stress & - &period, head file time steps must match gwt model time steps & - &one-for-one in that stress period.' - call store_error(errmsg) - call store_error_unit(this%iuhds) - end if - ! - ! -- fill the head array for this layer and - ! compress into reduced form - ncpl = size(this%hfr%head) - do i = 1, ncpl - nu = (ilay - 1) * ncpl + i - nr = this%dis%get_nodenumber(nu, 0) - val = this%hfr%head(i) - if (nr > 0) this%gwfhead(nr) = val - end do - end do - else - write (this%iout, fmthdskstpkper) kstp, kper, this%hfr%kstp, this%hfr%kper - end if - end subroutine advance_hfr - - subroutine finalize_hfr(this) -! ****************************************************************************** -! finalize_hfr -- finalize the head file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - class(GwtFmiType) :: this - ! -- dummy -! ------------------------------------------------------------------------------ - ! - ! -- Finalize the head file reader - close (this%iuhds) - ! - end subroutine finalize_hfr - - subroutine initialize_gwfterms_from_bfr(this) -! ****************************************************************************** -! initialize_gwfterms_from_bfr -- initalize terms and figure out how many -! different terms and packages are contained within the file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate - use SimModule, only: store_error, store_error_unit, count_errors - ! -- dummy - class(GwtFmiType) :: this - ! -- local - integer(I4B) :: nflowpack - integer(I4B) :: i, ip - integer(I4B) :: naux - logical :: found_flowja - logical :: found_dataspdis - logical :: found_datasat - logical :: found_stoss - logical :: found_stosy - integer(I4B), dimension(:), allocatable :: imap -! ------------------------------------------------------------------------------ - ! - ! -- Calculate the number of gwf flow packages - allocate (imap(this%bfr%nbudterms)) - imap(:) = 0 - nflowpack = 0 - found_flowja = .false. - found_dataspdis = .false. - found_datasat = .false. - found_stoss = .false. - found_stosy = .false. - do i = 1, this%bfr%nbudterms - select case (trim(adjustl(this%bfr%budtxtarray(i)))) - case ('FLOW-JA-FACE') - found_flowja = .true. - case ('DATA-SPDIS') - found_dataspdis = .true. - case ('DATA-SAT') - found_datasat = .true. - case ('STO-SS') - found_stoss = .true. - this%igwfstrgss = 1 - case ('STO-SY') - found_stosy = .true. - this%igwfstrgsy = 1 - case default - nflowpack = nflowpack + 1 - imap(i) = 1 - end select - end do - ! - ! -- allocate gwfpackage arrays (gwfpackages, iatp, datp, ...) - call this%allocate_gwfpackages(nflowpack) - ! - ! -- Copy the package name and aux names from budget file reader - ! to the gwfpackages derived-type variable - ip = 1 - do i = 1, this%bfr%nbudterms - if (imap(i) == 0) cycle - call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), & - this%bfr%budtxtarray(i)) - naux = this%bfr%nauxarray(i) - call this%gwfpackages(ip)%set_auxname(naux, this%bfr%auxtxtarray(1:naux, i)) - ip = ip + 1 - end do - ! - ! -- Copy just the package names for the boundary packages into - ! the flowpacknamearray - ip = 1 - do i = 1, size(imap) - if (imap(i) == 1) then - this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i) - ip = ip + 1 - end if - end do - ! - ! -- Error if specific discharge, saturation or flowja not found - if (.not. found_dataspdis) then - write (errmsg, '(a)') 'Specific discharge not found in & - &budget file. SAVE_SPECIFIC_DISCHARGE and & - &SAVE_FLOWS must be activated in the NPF package.' - call store_error(errmsg) - end if - if (.not. found_datasat) then - write (errmsg, '(a)') 'Saturation not found in & - &budget file. SAVE_SATURATION and & - &SAVE_FLOWS must be activated in the NPF package.' - call store_error(errmsg) - end if - if (.not. found_flowja) then - write (errmsg, '(a)') 'FLOWJA not found in & - &budget file. SAVE_FLOWS must & - &be activated in the NPF package.' - call store_error(errmsg) - end if - if (count_errors() > 0) then - call this%parser%StoreErrorUnit() - end if - ! - ! -- return - return - end subroutine initialize_gwfterms_from_bfr - - subroutine initialize_gwfterms_from_gwfbndlist(this) -! ****************************************************************************** -! initialize_gwfterms_from_gwfbndlist -- flows are coming from a gwf-gwt -! exchange -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use BndModule, only: BndType, GetBndFromList - ! -- dummy - class(GwtFmiType) :: this - ! -- local - integer(I4B) :: ngwfpack - integer(I4B) :: ngwfterms - integer(I4B) :: ip - integer(I4B) :: imover - integer(I4B) :: ntomvr - integer(I4B) :: iterm - character(len=LENPACKAGENAME) :: budtxt - class(BndType), pointer :: packobj => null() -! ------------------------------------------------------------------------------ - ! - ! -- determine size of gwf terms - ngwfpack = this%gwfbndlist%Count() - ! - ! -- Count number of to-mvr terms, but do not include advanced packages - ! as those mover terms are not losses from the cell, but rather flows - ! within the advanced package - ntomvr = 0 - do ip = 1, ngwfpack - packobj => GetBndFromList(this%gwfbndlist, ip) - imover = packobj%imover - if (packobj%isadvpak /= 0) imover = 0 - if (imover /= 0) then - ntomvr = ntomvr + 1 - end if - end do - ! - ! -- Allocate arrays in fmi of size ngwfterms, which is the number of - ! packages plus the number of packages with mover terms. - ngwfterms = ngwfpack + ntomvr - call this%allocate_gwfpackages(ngwfterms) - ! - ! -- Assign values in the fmi package - iterm = 1 - do ip = 1, ngwfpack - ! - ! -- set and store names - packobj => GetBndFromList(this%gwfbndlist, ip) - budtxt = adjustl(packobj%text) - call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) - this%flowpacknamearray(iterm) = packobj%packName - call this%gwfpackages(iterm)%set_auxname(packobj%naux, & - packobj%auxname) - iterm = iterm + 1 - ! - ! -- if this package has a mover associated with it, then add another - ! term that corresponds to the mover flows - imover = packobj%imover - if (packobj%isadvpak /= 0) imover = 0 - if (imover /= 0) then - budtxt = trim(adjustl(packobj%text))//'-TO-MVR' - call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) - this%flowpacknamearray(iterm) = packobj%packName - call this%gwfpackages(iterm)%set_auxname(packobj%naux, & - packobj%auxname) - this%igwfmvrterm(iterm) = 1 - iterm = iterm + 1 - end if - end do - return - end subroutine initialize_gwfterms_from_gwfbndlist - - subroutine allocate_gwfpackages(this, ngwfterms) -! ****************************************************************************** -! allocate_gwfpackages -- gwfpackages is an array of PackageBudget objects. -! This routine allocates gwfpackages to the proper size and initializes some -! member variables. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LENMEMPATH - use MemoryManagerModule, only: mem_allocate - ! -- dummy - class(GwtFmiType) :: this - integer(I4B), intent(in) :: ngwfterms - ! -- local - integer(I4B) :: n - character(len=LENMEMPATH) :: memPath -! ------------------------------------------------------------------------------ - ! - ! -- direct allocate - allocate (this%gwfpackages(ngwfterms)) - allocate (this%flowpacknamearray(ngwfterms)) - allocate (this%datp(ngwfterms)) - ! - ! -- mem_allocate - call mem_allocate(this%iatp, ngwfterms, 'IATP', this%memoryPath) - call mem_allocate(this%igwfmvrterm, ngwfterms, 'IGWFMVRTERM', this%memoryPath) - ! - ! -- initialize - this%nflowpack = ngwfterms - do n = 1, this%nflowpack - this%iatp(n) = 0 - this%igwfmvrterm(n) = 0 - this%flowpacknamearray(n) = '' - ! - ! -- Create a mempath for each individual flow package data set - ! of the form, MODELNAME/FMI-FTn - write (memPath, '(a, i0)') trim(this%memoryPath)//'-FT', n - call this%gwfpackages(n)%initialize(memPath) - end do - ! - ! -- return - return - end subroutine allocate_gwfpackages - - subroutine deallocate_gwfpackages(this) -! ****************************************************************************** -! deallocate_gwfpackages -- memory in the gwfpackages array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy - class(GwtFmiType) :: this - ! -- local - integer(I4B) :: n -! ------------------------------------------------------------------------------ - ! - ! -- initialize - do n = 1, this%nflowpack - call this%gwfpackages(n)%da() - end do - ! - ! -- return - return - end subroutine deallocate_gwfpackages - - subroutine get_package_index(this, name, idx) -! ****************************************************************************** -! get_package_index -- find the package index for package called name -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use BndModule, only: BndType, GetBndFromList - class(GwtFmiType) :: this - character(len=*), intent(in) :: name - integer(I4B), intent(inout) :: idx - ! -- local - integer(I4B) :: ip -! ------------------------------------------------------------------------------ - ! - ! -- Look through all the packages and return the index with name - idx = 0 - do ip = 1, size(this%flowpacknamearray) - if (this%flowpacknamearray(ip) == name) then - idx = ip - exit - end if - end do - if (idx == 0) then - call store_error('Error in get_package_index. Could not find '//name, & - terminate=.TRUE.) - end if - ! - ! -- return - return - end subroutine get_package_index - -end module GwtFmiModule diff --git a/src/Model/GroundWaterTransport/gwt1ic1.f90 b/src/Model/GroundWaterTransport/gwt1ic1.f90 deleted file mode 100644 index e9d872a7137..00000000000 --- a/src/Model/GroundWaterTransport/gwt1ic1.f90 +++ /dev/null @@ -1,114 +0,0 @@ -module GwtIcModule - - use KindModule, only: DP, I4B - use GwfIcModule, only: GwfIcType - use BlockParserModule, only: BlockParserType - use BaseDisModule, only: DisBaseType - - implicit none - private - public :: GwtIcType - public :: ic_cr - - ! -- Most of the GwtIcType functionality comes from GwfIcType - type, extends(GwfIcType) :: GwtIcType - contains - procedure :: read_data - end type GwtIcType - -contains - - subroutine ic_cr(ic, name_model, inunit, iout, dis) -! ****************************************************************************** -! ic_cr -- Create a new initial conditions object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy - type(GwtIcType), pointer :: ic - character(len=*), intent(in) :: name_model - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout - class(DisBaseType), pointer, intent(in) :: dis -! ------------------------------------------------------------------------------ - ! - ! -- Create the object - allocate (ic) - ! - ! -- create name and memory path - call ic%set_names(1, name_model, 'IC', 'IC') - ! - ! -- Allocate scalars - call ic%allocate_scalars() - ! - ic%inunit = inunit - ic%iout = iout - ! - ! -- set pointers - ic%dis => dis - ! - ! -- Initialize block parser - call ic%parser%Initialize(ic%inunit, ic%iout) - ! - ! -- Return - return - end subroutine ic_cr - - subroutine read_data(this) -! ****************************************************************************** -! read_data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error - ! -- dummy - class(GwtIcType) :: this - ! -- local - character(len=LINELENGTH) :: errmsg, keyword - character(len=:), allocatable :: line - integer(I4B) :: istart, istop, lloc, ierr - logical :: isfound, endOfBlock - character(len=24) :: aname(1) - ! -- formats -! ------------------------------------------------------------------------------ - ! - ! -- Setup the label - aname(1) = 'INITIAL CONCENTRATION' - ! - ! -- get griddata block - call this%parser%GetBlock('GRIDDATA', isfound, ierr) - if (isfound) then - write (this%iout, '(1x,a)') 'PROCESSING GRIDDATA' - do - call this%parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call this%parser%GetStringCaps(keyword) - call this%parser%GetRemainingLine(line) - lloc = 1 - select case (keyword) - case ('STRT') - call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, & - this%parser%iuactive, this%strt, & - aname(1)) - case default - write (errmsg, '(a,a)') 'Unknown GRIDDATA tag: ', & - trim(keyword) - call store_error(errmsg) - call this%parser%StoreErrorUnit() - end select - end do - write (this%iout, '(1x,a)') 'END PROCESSING GRIDDATA' - else - call store_error('Required GRIDDATA block not found.') - call this%parser%StoreErrorUnit() - end if - ! - ! -- Return - return - end subroutine read_data - -end module GwtIcModule diff --git a/src/Model/GroundWaterTransport/gwt1ic1idm.f90 b/src/Model/GroundWaterTransport/gwt1ic1idm.f90 new file mode 100644 index 00000000000..a2fa79f8d63 --- /dev/null +++ b/src/Model/GroundWaterTransport/gwt1ic1idm.f90 @@ -0,0 +1,79 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwtIcInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwt_ic_param_definitions + public gwt_ic_aggregate_definitions + public gwt_ic_block_definitions + public GwtIcParamFoundType + public gwt_ic_multi_package + + type GwtIcParamFoundType + logical :: strt = .false. + end type GwtIcParamFoundType + + logical :: gwt_ic_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + gwtic_strt = InputParamDefinitionType & + ( & + 'GWT', & ! component + 'IC', & ! subcomponent + 'GRIDDATA', & ! block + 'STRT', & ! tag name + 'STRT', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwt_ic_param_definitions(*) = & + [ & + gwtic_strt & + ] + + type(InputParamDefinitionType), parameter :: & + gwt_ic_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + gwt_ic_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'GRIDDATA', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module GwtIcInputModule diff --git a/src/Model/GroundWaterTransport/gwt1idm.f90 b/src/Model/GroundWaterTransport/gwt1idm.f90 index e63fd582106..d2289c5c688 100644 --- a/src/Model/GroundWaterTransport/gwt1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -34,7 +35,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -50,7 +52,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -66,7 +69,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -82,7 +86,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -98,7 +103,8 @@ module GwtNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -114,7 +120,8 @@ module GwtNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -130,7 +137,8 @@ module GwtNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +166,8 @@ module GwtNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterTransport/gwt1ist1.f90 b/src/Model/GroundWaterTransport/gwt1ist1.f90 index 99ed8128e4d..ad0a91ee4a0 100644 --- a/src/Model/GroundWaterTransport/gwt1ist1.f90 +++ b/src/Model/GroundWaterTransport/gwt1ist1.f90 @@ -19,7 +19,7 @@ module GwtIstModule LENBUDTXT, DHNOFLO use BndModule, only: BndType use BudgetModule, only: BudgetType - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use GwtMstModule, only: GwtMstType, get_zero_order_decay use OutputControlDataModule, only: OutputControlDataType use MatrixBaseModule @@ -49,7 +49,7 @@ module GwtIstModule !< type, extends(BndType) :: GwtIstType - type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object + type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object type(GwtMstType), pointer :: mst => null() !< pointer to mst object integer(I4B), pointer :: icimout => null() !< unit number for binary cim output @@ -116,7 +116,7 @@ subroutine ist_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: pakname !< name of the package ! -- local type(GwtIstType), pointer :: istobj - type(GwtFmiType), pointer :: fmi + type(TspFmiType), pointer :: fmi type(GwtMstType), pointer :: mst ! ! -- allocate the object and assign values to object variables diff --git a/src/Model/GroundWaterTransport/gwt1lkt1.f90 b/src/Model/GroundWaterTransport/gwt1lkt1.f90 index 98ef40abcd0..e8775deec83 100644 --- a/src/Model/GroundWaterTransport/gwt1lkt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1lkt1.f90 @@ -37,10 +37,10 @@ module GwtLktModule use ConstantsModule, only: DZERO, DONE, LINELENGTH use SimModule, only: store_error use BndModule, only: BndType, GetBndFromList - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use LakModule, only: LakType use ObserveModule, only: ObserveType - use GwtAptModule, only: GwtAptType, apt_process_obsID, & + use TspAptModule, only: TspAptType, apt_process_obsID, & apt_process_obsID12 use MatrixBaseModule @@ -52,7 +52,7 @@ module GwtLktModule character(len=*), parameter :: flowtype = 'LAK' character(len=16) :: text = ' LKT' - type, extends(GwtAptType) :: GwtLktType + type, extends(TspAptType) :: GwtLktType integer(I4B), pointer :: idxbudrain => null() ! index of rainfall terms in flowbudptr integer(I4B), pointer :: idxbudevap => null() ! index of evaporation terms in flowbudptr @@ -92,14 +92,10 @@ module GwtLktModule contains + !> @brief Create a new lkt package + !< subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & - fmi) -! ****************************************************************************** -! mwt_create -- Create a New MWT Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + fmi, eqnsclfac, dvt, dvu, dvua) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -108,10 +104,13 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname - type(GwtFmiType), pointer :: fmi + type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType + character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType + character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType ! -- local type(GwtLktType), pointer :: lktobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (lktobj) @@ -139,17 +138,21 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! the flow packages lktobj%fmi => fmi ! - ! -- return + ! -- Store pointer to governing equation scale factor + lktobj%eqnsclfac => eqnsclfac + ! + ! -- Set labels that will be used in generalized APT class + lktobj%depvartype = dvt + lktobj%depvarunit = dvu + lktobj%depvarunitabbrev = dvua + ! + ! -- Return return end subroutine lkt_create + !> @brief Find corresponding lkt package + !< subroutine find_lkt_package(this) -! ****************************************************************************** -! find corresponding lkt package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -160,7 +163,6 @@ subroutine find_lkt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -270,14 +272,12 @@ subroutine find_lkt_package(this) return end subroutine find_lkt_package + !> @brief Add matrix terms related to LKT + !! + !! This will be called from TspAptType%apt_fc_expanded() + !! in order to add matrix terms specifically for LKT + !< subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! lkt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded() -! in order to add matrix terms specifically for LKT -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this @@ -292,7 +292,6 @@ subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -364,20 +363,15 @@ subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine lkt_fc_expanded + !> @brief Add terms specific to lakes to the explicit lake solve + !< subroutine lkt_solve(this) -! ****************************************************************************** -! lkt_solve -- add terms specific to lakes to the explicit lake solve -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this ! -- local integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -431,21 +425,17 @@ subroutine lkt_solve(this) return end subroutine lkt_solve + !> @brief Function to return the number of budget terms just for this package. + !! + !! This overrides a function in the parent class. + !< function lkt_get_nbudterms(this) result(nbudterms) -! ****************************************************************************** -! lkt_get_nbudterms -- function to return the number of budget terms just for -! this package. This overrides function in parent. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 6 nbudterms = 6 @@ -454,13 +444,9 @@ function lkt_get_nbudterms(this) result(nbudterms) return end function lkt_get_nbudterms + !> @brief Set up the budget object that stores all the lake flows + !< subroutine lkt_setup_budobj(this, idx) -! ****************************************************************************** -! lkt_setup_budobj -- Set up the budget object that stores all the lake flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -469,9 +455,8 @@ subroutine lkt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! - ! -- + ! -- Addition of mass associated with rainfall directly on lake surface text = ' RAINFALL' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist @@ -484,7 +469,8 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- + ! -- Loss of dissolved mass associated with evaporation when a non-zero + ! evaporative concentration is specified text = ' EVAPORATION' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist @@ -497,7 +483,7 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- + ! -- Addition of mass associated with runoff that flows to the lake text = ' RUNOFF' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist @@ -510,7 +496,7 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- + ! -- Addition of mass associated with user-specified inflow to the lake text = ' EXT-INFLOW' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist @@ -523,7 +509,7 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- + ! -- Removal of mass associated with user-specified withdrawal from lake text = ' WITHDRAWAL' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudwdrl)%maxlist @@ -536,7 +522,8 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- + ! -- Removal of heat associated with outflow from lake that leaves + ! model domain text = ' EXT-OUTFLOW' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist @@ -549,17 +536,13 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- return + ! -- Return return end subroutine lkt_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! lkt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this @@ -572,8 +555,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RAIN idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist @@ -583,7 +565,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EVAPORATION idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist @@ -593,7 +575,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- RUNOFF idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist @@ -603,7 +585,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EXT-INFLOW idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist @@ -613,7 +595,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- WITHDRAWAL idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudwdrl)%nlist @@ -623,7 +605,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EXT-OUTFLOW idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist @@ -633,28 +615,23 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - ! - ! -- return + ! -- Return return end subroutine lkt_fill_budobj + !> @brief Allocate scalars specific to the lake mass transport (LKT) + !! package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtLktType) :: this ! -- local -! ------------------------------------------------------------------------------ ! - ! -- allocate scalars in GwtAptType - call this%GwtAptType%allocate_scalars() + ! -- allocate scalars in TspAptType + call this%TspAptType%allocate_scalars() ! ! -- Allocate call mem_allocate(this%idxbudrain, 'IDXBUDRAIN', this%memoryPath) @@ -676,20 +653,16 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate arrays specific to the lake mass transport (LKT) + !! package. + !< subroutine lkt_allocate_arrays(this) -! ****************************************************************************** -! lkt_allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtLktType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrain, this%ncv, 'CONCRAIN', this%memoryPath) @@ -697,8 +670,8 @@ subroutine lkt_allocate_arrays(this) call mem_allocate(this%concroff, this%ncv, 'CONCROFF', this%memoryPath) call mem_allocate(this%conciflw, this%ncv, 'CONCIFLW', this%memoryPath) ! - ! -- call standard GwtApttype allocate arrays - call this%GwtAptType%apt_allocate_arrays() + ! -- call standard TspAptType allocate arrays + call this%TspAptType%apt_allocate_arrays() ! ! -- Initialize do n = 1, this%ncv @@ -713,19 +686,14 @@ subroutine lkt_allocate_arrays(this) return end subroutine lkt_allocate_arrays + !> @brief Deallocate memory + !< subroutine lkt_da(this) -! ****************************************************************************** -! lkt_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtLktType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrain) @@ -741,21 +709,17 @@ subroutine lkt_da(this) call mem_deallocate(this%concroff) call mem_deallocate(this%conciflw) ! - ! -- deallocate scalars in GwtAptType - call this%GwtAptType%bnd_da() + ! -- deallocate scalars in TspAptType + call this%TspAptType%bnd_da() ! ! -- Return return end subroutine lkt_da + !> @brief Rain term + !< subroutine lkt_rain_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_rain_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -767,7 +731,7 @@ subroutine lkt_rain_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry) @@ -776,18 +740,14 @@ subroutine lkt_rain_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine lkt_rain_term + !> @brief Evaporative term + !< subroutine lkt_evap_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_evap_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -800,7 +760,7 @@ subroutine lkt_evap_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry) ! -- note that qbnd is negative for evap @@ -817,18 +777,14 @@ subroutine lkt_evap_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp if (present(hcofval)) hcofval = omega * qbnd ! - ! -- return + ! -- Return return end subroutine lkt_evap_term + !> @brief Runoff term + !< subroutine lkt_roff_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_roff_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -840,7 +796,7 @@ subroutine lkt_roff_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry) @@ -849,18 +805,17 @@ subroutine lkt_roff_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine lkt_roff_term + !> @brief Inflow Term + !! + !! Accounts for mass flowing into a lake from a connected stream, for + !! example. + !< subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_iflw_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -872,7 +827,7 @@ subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry) @@ -881,18 +836,17 @@ subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine lkt_iflw_term + !> @brief Specified withdrawal term + !! + !! Accounts for mass associated with a withdrawal of water from a lake + !! or group of lakes. + !< subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_wdrl_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -904,7 +858,7 @@ subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudwdrl)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudwdrl)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudwdrl)%flow(ientry) @@ -913,18 +867,17 @@ subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine lkt_wdrl_term + !> @brief Outflow term + !! + !! Accounts for the mass leaving a lake, for example, mass exiting a + !! lake via a flow into a draining stream channel. + !< subroutine lkt_outf_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! lkt_outf_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType) :: this integer(I4B), intent(in) :: ientry @@ -936,7 +889,7 @@ subroutine lkt_outf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry) @@ -945,25 +898,21 @@ subroutine lkt_outf_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine lkt_outf_term + !> @brief Defined observation types + !! + !! Store the observation type supported by the APT package and overide + !! BndType%bnd_df_obs + !< subroutine lkt_df_obs(this) -! ****************************************************************************** -! lkt_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -1030,13 +979,13 @@ subroutine lkt_df_obs(this) call this%obs%StoreObsType('ext-outflow', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID ! + ! -- Return return end subroutine lkt_df_obs !> @brief Process package specific obs - !! - !! Method to process specific observations for this package. - !! + !! + !! Method to process specific observations for this package. !< subroutine lkt_rp_obs(this, obsrv, found) ! -- dummy @@ -1066,16 +1015,13 @@ subroutine lkt_rp_obs(this, obsrv, found) found = .false. end select ! + ! -- Return return end subroutine lkt_rp_obs + !> @brief Calculate observation value and pass it back to APT + !< subroutine lkt_bd_obs(this, obstypeid, jj, v, found) -! ****************************************************************************** -! lkt_bd_obs -- calculate observation value and pass it back to APT -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtLktType), intent(inout) :: this character(len=*), intent(in) :: obstypeid @@ -1084,7 +1030,6 @@ subroutine lkt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -1116,16 +1061,13 @@ subroutine lkt_bd_obs(this, obstypeid, jj, v, found) found = .false. end select ! + ! -- Return return end subroutine lkt_bd_obs + !> @brief Sets the stress period attributes for keyword use. + !< subroutine lkt_set_stressperiod(this, itemno, keyword, found) -! ****************************************************************************** -! lkt_set_stressperiod -- Set a stress period attribute for using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy class(GwtLktType), intent(inout) :: this @@ -1138,7 +1080,6 @@ subroutine lkt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RAINFALL ! EVAPORATION @@ -1200,7 +1141,7 @@ subroutine lkt_set_stressperiod(this, itemno, keyword, found) ! 999 continue ! - ! -- return + ! -- Return return end subroutine lkt_set_stressperiod diff --git a/src/Model/GroundWaterTransport/gwt1mst1.f90 b/src/Model/GroundWaterTransport/gwt1mst1.f90 index f962a5f2bef..48842e211b5 100644 --- a/src/Model/GroundWaterTransport/gwt1mst1.f90 +++ b/src/Model/GroundWaterTransport/gwt1mst1.f90 @@ -17,7 +17,7 @@ module GwtMstModule use MatrixBaseModule use NumericalPackageModule, only: NumericalPackageType use BaseDisModule, only: DisBaseType - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType implicit none public :: GwtMstType @@ -60,7 +60,7 @@ module GwtMstModule ! ! -- misc integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound - type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object + type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object contains @@ -100,7 +100,7 @@ subroutine mst_cr(mstobj, name_model, inunit, iout, fmi) character(len=*), intent(in) :: name_model !< name of the model integer(I4B), intent(in) :: inunit !< unit number of WEL package input file integer(I4B), intent(in) :: iout !< unit number of model listing file - type(GwtFmiType), intent(in), target :: fmi !< fmi package for this GWT model + type(TspFmiType), intent(in), target :: fmi !< fmi package for this GWT model ! ! -- Create the object allocate (mstobj) diff --git a/src/Model/GroundWaterTransport/gwt1mwt1.f90 b/src/Model/GroundWaterTransport/gwt1mwt1.f90 index 15137d3a5c6..842a051235f 100644 --- a/src/Model/GroundWaterTransport/gwt1mwt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1mwt1.f90 @@ -38,10 +38,10 @@ module GwtMwtModule use ConstantsModule, only: DZERO, LINELENGTH use SimModule, only: store_error use BndModule, only: BndType, GetBndFromList - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use MawModule, only: MawType use ObserveModule, only: ObserveType - use GwtAptModule, only: GwtAptType, apt_process_obsID, & + use TspAptModule, only: TspAptType, apt_process_obsID, & apt_process_obsID12 use MatrixBaseModule @@ -53,7 +53,7 @@ module GwtMwtModule character(len=*), parameter :: flowtype = 'MAW' character(len=16) :: text = ' MWT' - type, extends(GwtAptType) :: GwtMwtType + type, extends(TspAptType) :: GwtMwtType integer(I4B), pointer :: idxbudrate => null() ! index of well rate terms in flowbudptr integer(I4B), pointer :: idxbudfwrt => null() ! index of flowing well rate terms in flowbudptr @@ -85,14 +85,10 @@ module GwtMwtModule contains + !> Create new MWT package + !< subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & - fmi) -! ****************************************************************************** -! mwt_create -- Create a New MWT Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + fmi, eqnsclfac, dvt, dvu, dvua) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -101,10 +97,13 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname - type(GwtFmiType), pointer :: fmi + type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType + character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType + character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType ! -- local type(GwtMwtType), pointer :: mwtobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (mwtobj) @@ -132,17 +131,21 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! the flow packages mwtobj%fmi => fmi ! - ! -- return + ! -- Store pointer to governing equation scale factor + mwtobj%eqnsclfac => eqnsclfac + ! + ! -- Set labels that will be used in generalized APT class + mwtobj%depvartype = dvt + mwtobj%depvarunit = dvu + mwtobj%depvarunitabbrev = dvua + ! + ! -- Return return end subroutine mwt_create + !> @brief find corresponding mwt package + !< subroutine find_mwt_package(this) -! ****************************************************************************** -! find corresponding mwt package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -153,7 +156,6 @@ subroutine find_mwt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -257,14 +259,12 @@ subroutine find_mwt_package(this) return end subroutine find_mwt_package + !> @brief Add matrix terms related to MWT + !! + !! This routine is called from TspAptType%apt_fc_expanded() in + !! order to add matrix terms specifically for MWT + !< subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! mwt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded() -! in order to add matrix terms specifically for this package -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this @@ -279,7 +279,6 @@ subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add puping rate contribution if (this%idxbudrate /= 0) then @@ -329,21 +328,16 @@ subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine mwt_fc_expanded + !> @ brief Add terms specific to multi-aquifer wells to the explicit multi- + !! aquifer well solute transport solve + !< subroutine mwt_solve(this) -! ****************************************************************************** -! mwt_solve -- add terms specific to multi-aquifer wells to the explicit multi- -! aquifer well solve -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType) :: this ! -- local integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add well pumping contribution if (this%idxbudrate /= 0) then @@ -381,21 +375,17 @@ subroutine mwt_solve(this) return end subroutine mwt_solve + !> @brief Function to return the number of budget terms just for this package + !! + !! This overrides a function in the parent class. + !< function mwt_get_nbudterms(this) result(nbudterms) -! ****************************************************************************** -! mwt_get_nbudterms -- function to return the number of budget terms just for -! this package. This overrides function in parent. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this - ! -- return + ! -- Return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 4 nbudterms = 1 @@ -407,14 +397,9 @@ function mwt_get_nbudterms(this) result(nbudterms) return end function mwt_get_nbudterms + !> @brief Set up the budget object that stores all the mwt flows + !< subroutine mwt_setup_budobj(this, idx) -! ****************************************************************************** -! mwt_setup_budobj -- Set up the budget object that stores all the multi- -! aquifer well flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -423,7 +408,6 @@ subroutine mwt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! ! -- text = ' RATE' @@ -437,7 +421,6 @@ subroutine mwt_setup_budobj(this, idx) this%packName, & maxlist, .false., .false., & naux) - ! ! -- if (this%idxbudfwrt /= 0) then @@ -453,7 +436,6 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! ! -- if (this%idxbudrtmv /= 0) then @@ -469,7 +451,6 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! ! -- if (this%idxbudfrtm /= 0) then @@ -485,19 +466,14 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- return + ! -- Return return end subroutine mwt_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! mwt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this @@ -510,8 +486,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RATE idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist @@ -521,7 +496,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- FW-RATE if (this%idxbudfwrt /= 0) then idx = idx + 1 @@ -533,7 +508,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- RATE-TO-MVR if (this%idxbudrtmv /= 0) then idx = idx + 1 @@ -545,7 +520,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- FW-RATE-TO-MVR if (this%idxbudfrtm /= 0) then idx = idx + 1 @@ -557,28 +532,23 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - ! - ! -- return + ! -- Return return end subroutine mwt_fill_budobj + !> @brief Allocate scalars specific to the streamflow mass transport (SFT) + !! package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtMwtType) :: this ! -- local -! ------------------------------------------------------------------------------ ! - ! -- allocate scalars in GwtAptType - call this%GwtAptType%allocate_scalars() + ! -- allocate scalars in TspAptType + call this%TspAptType%allocate_scalars() ! ! -- Allocate call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath) @@ -596,26 +566,22 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate arrays specific to the streamflow mass transport (SFT) + !! package. + !< subroutine mwt_allocate_arrays(this) -! ****************************************************************************** -! mwt_allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtMwtType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrate, this%ncv, 'CONCRATE', this%memoryPath) ! - ! -- call standard GwtApttype allocate arrays - call this%GwtAptType%apt_allocate_arrays() + ! -- call standard TspAptType allocate arrays + call this%TspAptType%apt_allocate_arrays() ! ! -- Initialize do n = 1, this%ncv @@ -627,19 +593,14 @@ subroutine mwt_allocate_arrays(this) return end subroutine mwt_allocate_arrays + !> @brief Deallocate memory + !< subroutine mwt_da(this) -! ****************************************************************************** -! mwt_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtMwtType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrate) @@ -650,21 +611,17 @@ subroutine mwt_da(this) ! -- deallocate time series call mem_deallocate(this%concrate) ! - ! -- deallocate scalars in GwtAptType - call this%GwtAptType%bnd_da() + ! -- deallocate scalars in TspAptType + call this%TspAptType%bnd_da() ! ! -- Return return end subroutine mwt_da + !> @brief Rate term associated with pumping (or injection) + !< subroutine mwt_rate_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! mwt_rate_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType) :: this integer(I4B), intent(in) :: ientry @@ -677,7 +634,7 @@ subroutine mwt_rate_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: h, r -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry) ! -- note that qbnd is negative for extracting well @@ -695,18 +652,15 @@ subroutine mwt_rate_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = r if (present(hcofval)) hcofval = h ! - ! -- return + ! -- Return return end subroutine mwt_rate_term + !> @brief Transport matrix term(s) associcated with a flowing- + !! well rate term associated with pumping (or injection) + !< subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! mwt_fwrt_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType) :: this integer(I4B), intent(in) :: ientry @@ -718,7 +672,7 @@ subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry) @@ -727,18 +681,17 @@ subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine mwt_fwrt_term + !> @brief Rate-to-mvr term associated with pumping (or injection) + !! + !! Pumped water that is made available to the MVR package for transfer to + !! another advanced package + !< subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! mwt_rtmv_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType) :: this integer(I4B), intent(in) :: ientry @@ -750,7 +703,7 @@ subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry) @@ -759,18 +712,17 @@ subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine mwt_rtmv_term + !> @brief Flowing well rate-to-mvr term (or injection) + !! + !! Pumped water that is made available to the MVR package for transfer to + !! another advanced package + !< subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! mwt_frtm_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType) :: this integer(I4B), intent(in) :: ientry @@ -782,7 +734,7 @@ subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry) @@ -791,25 +743,21 @@ subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine mwt_frtm_term + !> @brief Observations + !! + !! Store the observation type supported by the APT package and overide + !! BndType%bnd_df_obs + !< subroutine mwt_df_obs(this) -! ****************************************************************************** -! mwt_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -864,13 +812,13 @@ subroutine mwt_df_obs(this) call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID ! + ! -- Return return end subroutine mwt_df_obs !> @brief Process package specific obs - !! - !! Method to process specific observations for this package. - !! + !! + !! Method to process specific observations for this package. !< subroutine mwt_rp_obs(this, obsrv, found) ! -- dummy @@ -893,16 +841,13 @@ subroutine mwt_rp_obs(this, obsrv, found) found = .false. end select ! + ! -- Return return end subroutine mwt_rp_obs + !> @brief Calculate observation value and pass it back to APT + !< subroutine mwt_bd_obs(this, obstypeid, jj, v, found) -! ****************************************************************************** -! mwt_bd_obs -- calculate observation value and pass it back to APT -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtMwtType), intent(inout) :: this character(len=*), intent(in) :: obstypeid @@ -911,7 +856,6 @@ subroutine mwt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -935,16 +879,14 @@ subroutine mwt_bd_obs(this, obstypeid, jj, v, found) found = .false. end select ! + ! -- Return return end subroutine mwt_bd_obs + !> @brief Sets the stress period attributes for keyword use. + !< subroutine mwt_set_stressperiod(this, itemno, keyword, found) -! ****************************************************************************** -! mwt_set_stressperiod -- Set a stress period attribute for using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy class(GwtMwtType), intent(inout) :: this @@ -957,7 +899,6 @@ subroutine mwt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RATE ! @@ -982,7 +923,7 @@ subroutine mwt_set_stressperiod(this, itemno, keyword, found) ! 999 continue ! - ! -- return + ! -- Return return end subroutine mwt_set_stressperiod diff --git a/src/Model/GroundWaterTransport/gwt1sft1.f90 b/src/Model/GroundWaterTransport/gwt1sft1.f90 index fe310f5eb42..fc6ffafc171 100644 --- a/src/Model/GroundWaterTransport/gwt1sft1.f90 +++ b/src/Model/GroundWaterTransport/gwt1sft1.f90 @@ -36,10 +36,10 @@ module GwtSftModule use ConstantsModule, only: DZERO, DONE, LINELENGTH use SimModule, only: store_error use BndModule, only: BndType, GetBndFromList - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use SfrModule, only: SfrType use ObserveModule, only: ObserveType - use GwtAptModule, only: GwtAptType, apt_process_obsID, & + use TspAptModule, only: TspAptType, apt_process_obsID, & apt_process_obsID12 use MatrixBaseModule @@ -51,7 +51,7 @@ module GwtSftModule character(len=*), parameter :: flowtype = 'SFR' character(len=16) :: text = ' SFT' - type, extends(GwtAptType) :: GwtSftType + type, extends(TspAptType) :: GwtSftType integer(I4B), pointer :: idxbudrain => null() ! index of rainfall terms in flowbudptr integer(I4B), pointer :: idxbudevap => null() ! index of evaporation terms in flowbudptr @@ -89,14 +89,10 @@ module GwtSftModule contains + !> @brief Create a new sft package + !< subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & - fmi) -! ****************************************************************************** -! sft_create -- Create a New SFT Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + fmi, eqnsclfac, dvt, dvu, dvua) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -105,10 +101,13 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname - type(GwtFmiType), pointer :: fmi + type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType + character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType + character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType ! -- local type(GwtSftType), pointer :: sftobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (sftobj) @@ -123,30 +122,34 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum packobj%ncolbnd = 1 packobj%iscloc = 1 - + ! ! -- Store pointer to flow model interface. When the GwfGwt exchange is ! created, it sets fmi%bndlist so that the GWT model has access to all ! the flow packages sftobj%fmi => fmi ! - ! -- return + ! -- Store pointer to governing equation scale factor + sftobj%eqnsclfac => eqnsclfac + ! + ! -- Set labels that will be used in generalized APT class + sftobj%depvartype = dvt + sftobj%depvarunit = dvu + sftobj%depvarunitabbrev = dvua + ! + ! -- Return return end subroutine sft_create + !> @brief Find corresponding sft package + !< subroutine find_sft_package(this) -! ****************************************************************************** -! find corresponding sft package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -157,7 +160,6 @@ subroutine find_sft_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -264,14 +266,12 @@ subroutine find_sft_package(this) return end subroutine find_sft_package + !> @brief Add matrix terms related to SFT + !! + !! This will be called from TspAptType%apt_fc_expanded() + !! in order to add matrix terms specifically for SFT + !< subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! sft_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded() -! in order to add matrix terms specifically for SFT -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this @@ -286,7 +286,6 @@ subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -347,20 +346,15 @@ subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine sft_fc_expanded + !> @brief Add terms specific to sft to the explicit sft solve + !< subroutine sft_solve(this) -! ****************************************************************************** -! sft_solve -- add terms specific to sfr to the explicit sfr solve -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this ! -- local integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -406,36 +400,28 @@ subroutine sft_solve(this) return end subroutine sft_solve + !> @brief Function to return the number of budget terms just for this package. + !! + !! This overrides a function in the parent class. + !< function sft_get_nbudterms(this) result(nbudterms) -! ****************************************************************************** -! sft_get_nbudterms -- function to return the number of budget terms just for -! this package. This overrides function in parent. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! - ! -- Number of budget terms is 6 + ! -- Number of budget terms is 5 nbudterms = 5 ! ! -- Return return end function sft_get_nbudterms + !> @brief Set up the budget object that stores all the sft flows + !< subroutine sft_setup_budobj(this, idx) -! ****************************************************************************** -! sft_setup_budobj -- Set up the budget object that stores all the sfr flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -444,7 +430,6 @@ subroutine sft_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! ! -- text = ' RAINFALL' @@ -515,13 +500,9 @@ subroutine sft_setup_budobj(this, idx) return end subroutine sft_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! sft_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this @@ -534,8 +515,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RAIN idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist @@ -545,7 +525,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EVAPORATION idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist @@ -555,7 +535,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- RUNOFF idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist @@ -565,7 +545,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EXT-INFLOW idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist @@ -575,7 +555,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- EXT-OUTFLOW idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist @@ -585,28 +565,23 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - ! - ! -- return + ! -- Return return end subroutine sft_fill_budobj + !> @brief Allocate scalars specific to the streamflow energy transport (SFE) + !! package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtSftType) :: this ! -- local -! ------------------------------------------------------------------------------ ! - ! -- allocate scalars in GwtAptType - call this%GwtAptType%allocate_scalars() + ! -- allocate scalars in TspAptType + call this%TspAptType%allocate_scalars() ! ! -- Allocate call mem_allocate(this%idxbudrain, 'IDXBUDRAIN', this%memoryPath) @@ -626,20 +601,16 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate arrays specific to the streamflow energy transport (SFE) + !! package. + !< subroutine sft_allocate_arrays(this) -! ****************************************************************************** -! sft_allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtSftType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrain, this%ncv, 'CONCRAIN', this%memoryPath) @@ -647,8 +618,8 @@ subroutine sft_allocate_arrays(this) call mem_allocate(this%concroff, this%ncv, 'CONCROFF', this%memoryPath) call mem_allocate(this%conciflw, this%ncv, 'CONCIFLW', this%memoryPath) ! - ! -- call standard GwtApttype allocate arrays - call this%GwtAptType%apt_allocate_arrays() + ! -- call standard TspAptType allocate arrays + call this%TspAptType%apt_allocate_arrays() ! ! -- Initialize do n = 1, this%ncv @@ -658,24 +629,18 @@ subroutine sft_allocate_arrays(this) this%conciflw(n) = DZERO end do ! - ! ! -- Return return end subroutine sft_allocate_arrays + !> @brief Deallocate memory + !< subroutine sft_da(this) -! ****************************************************************************** -! sft_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtSftType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrain) @@ -690,21 +655,17 @@ subroutine sft_da(this) call mem_deallocate(this%concroff) call mem_deallocate(this%conciflw) ! - ! -- deallocate scalars in GwtAptType - call this%GwtAptType%bnd_da() + ! -- deallocate scalars in TspAptType + call this%TspAptType%bnd_da() ! ! -- Return return end subroutine sft_da + !> @brief Rain term + !< subroutine sft_rain_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! sft_rain_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this integer(I4B), intent(in) :: ientry @@ -716,7 +677,7 @@ subroutine sft_rain_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry) @@ -725,18 +686,14 @@ subroutine sft_rain_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine sft_rain_term + !> @brief Evaporative term + !< subroutine sft_evap_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! sft_evap_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this integer(I4B), intent(in) :: ientry @@ -749,7 +706,7 @@ subroutine sft_evap_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry) ! -- note that qbnd is negative for evap @@ -766,18 +723,14 @@ subroutine sft_evap_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp if (present(hcofval)) hcofval = omega * qbnd ! - ! -- return + ! -- Return return end subroutine sft_evap_term + !> @brief Runoff term + !< subroutine sft_roff_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! sft_roff_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this integer(I4B), intent(in) :: ientry @@ -789,7 +742,7 @@ subroutine sft_roff_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry) @@ -798,18 +751,18 @@ subroutine sft_roff_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine sft_roff_term + !> @brief Inflow Term + !! + !! Accounts for mass added via streamflow entering into a stream channel; + !! for example, energy entering the model domain via a specified flow in a + !! stream channel. + !< subroutine sft_iflw_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! sft_iflw_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this integer(I4B), intent(in) :: ientry @@ -821,7 +774,7 @@ subroutine sft_iflw_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry) @@ -830,18 +783,17 @@ subroutine sft_iflw_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -rrate if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine sft_iflw_term + !> @brief Outflow term + !! + !! Accounts for the mass leaving a stream channel; for example, mass exiting the + !! model domain via a flow in a stream channel flowing out of the active domain. + !< subroutine sft_outf_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! sft_outf_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType) :: this integer(I4B), intent(in) :: ientry @@ -853,7 +805,7 @@ subroutine sft_outf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry) @@ -862,25 +814,21 @@ subroutine sft_outf_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine sft_outf_term + !> @brief Observations + !! + !! Store the observation type supported by the APT package and overide + !! BndType%bnd_df_obs + !< subroutine sft_df_obs(this) -! ****************************************************************************** -! sft_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -942,13 +890,13 @@ subroutine sft_df_obs(this) call this%obs%StoreObsType('ext-outflow', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID ! + ! -- Return return end subroutine sft_df_obs !> @brief Process package specific obs - !! - !! Method to process specific observations for this package. - !! + !! + !! Method to process specific observations for this package. !< subroutine sft_rp_obs(this, obsrv, found) ! -- dummy @@ -975,16 +923,13 @@ subroutine sft_rp_obs(this, obsrv, found) found = .false. end select ! + ! -- Return return end subroutine sft_rp_obs + !> @brief Calculate observation value and pass it back to APT + !< subroutine sft_bd_obs(this, obstypeid, jj, v, found) -! ****************************************************************************** -! sft_bd_obs -- calculate observation value and pass it back to APT -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtSftType), intent(inout) :: this character(len=*), intent(in) :: obstypeid @@ -993,7 +938,6 @@ subroutine sft_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -1021,16 +965,13 @@ subroutine sft_bd_obs(this, obstypeid, jj, v, found) found = .false. end select ! + ! -- Return return end subroutine sft_bd_obs + !> @brief Sets the stress period attributes for keyword use. + !< subroutine sft_set_stressperiod(this, itemno, keyword, found) -! ****************************************************************************** -! sft_set_stressperiod -- Set a stress period attribute for using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy class(GwtSftType), intent(inout) :: this @@ -1043,7 +984,6 @@ subroutine sft_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RAINFALL ! EVAPORATION @@ -1105,7 +1045,7 @@ subroutine sft_set_stressperiod(this, itemno, keyword, found) ! 999 continue ! - ! -- return + ! -- Return return end subroutine sft_set_stressperiod diff --git a/src/Model/GroundWaterTransport/gwt1src1.f90 b/src/Model/GroundWaterTransport/gwt1src1.f90 index 1565c40ef09..0314413ce72 100644 --- a/src/Model/GroundWaterTransport/gwt1src1.f90 +++ b/src/Model/GroundWaterTransport/gwt1src1.f90 @@ -1,7 +1,7 @@ module GwtSrcModule ! use KindModule, only: DP, I4B - use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE + use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, LENVARNAME use BndModule, only: BndType use ObsModule, only: DefaultObsIdProcessor use TimeSeriesLinkModule, only: TimeSeriesLinkType, & @@ -18,7 +18,11 @@ module GwtSrcModule character(len=16) :: text = ' SRC' ! type, extends(BndType) :: GwtSrcType + + character(len=LENVARNAME) :: depvartype = '' !< stores string of dependent variable type, depending on model type + contains + procedure :: allocate_scalars => src_allocate_scalars procedure :: bnd_cf => src_cf procedure :: bnd_fc => src_fc @@ -29,19 +33,17 @@ module GwtSrcModule procedure, public :: bnd_df_obs => src_df_obs ! -- methods for time series procedure, public :: bnd_rp_ts => src_rp_ts + end type GwtSrcType contains - subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! src_create -- Create a New Src Package -! Subroutine: (1) create new-style package -! (2) point bndobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a source loading package + !! + !! This subroutine points bndobj to the newly created package + !< + subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + depvartype) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -50,9 +52,9 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname + character(len=LENVARNAME), intent(in) :: depvartype ! -- local type(GwtSrcType), pointer :: srcobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (srcobj) @@ -75,43 +77,38 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%ncolbnd = 1 packobj%iscloc = 1 ! + ! -- Store the appropriate label based on the dependent variable + srcobj%depvartype = depvartype + ! ! -- return return end subroutine src_create + !> @brief Deallocate memory + !< subroutine src_da(this) -! ****************************************************************************** -! src_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtSrcType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate parent package call this%BndType%bnd_da() ! ! -- scalars ! - ! -- return + ! -- Return return end subroutine src_da + !> @brief Allocate scalars + !! + !! Allocate scalars specific to this source loading package + !< subroutine src_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtSrcType) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_scalars() @@ -120,38 +117,26 @@ subroutine src_allocate_scalars(this) ! ! -- Set values ! - ! -- return + ! -- Return return end subroutine src_allocate_scalars - subroutine src_cf(this, reset_mover) -! ****************************************************************************** -! src_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no sources -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Formulate the HCOF and RHS terms + !! + !! This subroutine: + !! - calculates hcof and rhs terms + !! - skip if no sources + !< + subroutine src_cf(this) ! -- dummy class(GwtSrcType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node real(DP) :: q - logical :: lrm -! ------------------------------------------------------------------------------ ! ! -- Return if no sources if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each source entry do i = 1, this%nbound node = this%nodelist(i) @@ -164,16 +149,15 @@ subroutine src_cf(this, reset_mover) this%rhs(i) = -q end do ! + ! -- Return return end subroutine src_cf + !> @brief Add matrix terms related to specified mass source loading + !! + !! Copy rhs and hcof into solution rhs and amat + !< subroutine src_fc(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! src_fc -- Copy rhs and hcof into solution rhs and amat -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(GwtSrcType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -182,7 +166,6 @@ subroutine src_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, n, ipos -! -------------------------------------------------------------------------- ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -203,20 +186,19 @@ subroutine src_fc(this, rhs, ia, idxglo, matrix_sln) end if end do ! - ! -- return + ! -- Return return end subroutine src_fc + !> @brief Define list labels + !! + !! Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(GwtSrcType), intent(inout) :: this -! ------------------------------------------------------------------------------ + ! -- local ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -235,42 +217,41 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel ! -- Procedures related to observations + !> @brief Support function for specified mass source loading observations + !! + !! This function: + !! - returns true because SRC package supports observations. + !! - overrides BndType%bnd_obs_supported() + !< logical function src_obs_supported(this) - ! ****************************************************************************** - ! src_obs_supported - ! -- Return true because SRC package supports observations. - ! -- Overrides BndType%bnd_obs_supported() - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none + ! -- dummy class(GwtSrcType) :: this - ! ------------------------------------------------------------------------------ + ! src_obs_supported = .true. + ! + ! -- Return return end function src_obs_supported + !> @brief Define observations + !! + !! This subroutine: + !! - stores observation types supported by SRC package. + !! - overrides BndType%bnd_df_obs + !< subroutine src_df_obs(this) - ! ****************************************************************************** - ! src_df_obs (implements bnd_df_obs) - ! -- Store observation type supported by SRC package. - ! -- Overrides BndType%bnd_df_obs - ! ****************************************************************************** - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------------ implicit none ! -- dummy class(GwtSrcType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ + ! call this%obs%StoreObsType('src', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! @@ -279,17 +260,17 @@ subroutine src_df_obs(this) call this%obs%StoreObsType('to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! - ! -- return + ! -- Return return end subroutine src_df_obs - ! -- Procedure related to time series - + !> @brief Procedure related to time series + !! + !! Assign tsLink%Text appropriately for all time series in use by package. + !! In the SRC package only the SMASSRATE variable can be controlled by time + !! series. + !< subroutine src_rp_ts(this) - ! -- Assign tsLink%Text appropriately for - ! all time series in use by package. - ! In the SRC package only the SMASSRATE variable - ! can be controlled by time series. ! -- dummy class(GwtSrcType), intent(inout) :: this ! -- local @@ -306,6 +287,7 @@ subroutine src_rp_ts(this) end if end do ! + ! -- Return return end subroutine src_rp_ts diff --git a/src/Model/GroundWaterTransport/gwt1uzt1.f90 b/src/Model/GroundWaterTransport/gwt1uzt1.f90 index c6be55aec38..4006062fb28 100644 --- a/src/Model/GroundWaterTransport/gwt1uzt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1uzt1.f90 @@ -30,10 +30,10 @@ module GwtUztModule use ConstantsModule, only: DZERO, DONE, LINELENGTH use SimModule, only: store_error use BndModule, only: BndType, GetBndFromList - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use UzfModule, only: UzfType use ObserveModule, only: ObserveType - use GwtAptModule, only: GwtAptType, apt_process_obsID, & + use TspAptModule, only: TspAptType, apt_process_obsID, & apt_process_obsID12 use MatrixBaseModule implicit none @@ -44,7 +44,7 @@ module GwtUztModule character(len=*), parameter :: flowtype = 'UZF' character(len=16) :: text = ' UZT' - type, extends(GwtAptType) :: GwtUztType + type, extends(TspAptType) :: GwtUztType integer(I4B), pointer :: idxbudinfl => null() ! index of uzf infiltration terms in flowbudptr integer(I4B), pointer :: idxbudrinf => null() ! index of rejected infiltration terms in flowbudptr @@ -77,14 +77,10 @@ module GwtUztModule contains + !> @brief Create a new UZT package + !< subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & - fmi) -! ****************************************************************************** -! uzt_create -- Create a New UZT Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + fmi, eqnsclfac, dvt, dvu, dvua) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -93,10 +89,13 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & integer(I4B), intent(in) :: iout character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname - type(GwtFmiType), pointer :: fmi + type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType + character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType + character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType ! -- local type(GwtUztType), pointer :: uztobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (uztobj) @@ -111,30 +110,34 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id packobj%ibcnum = ibcnum packobj%ncolbnd = 1 packobj%iscloc = 1 - + ! ! -- Store pointer to flow model interface. When the GwfGwt exchange is ! created, it sets fmi%bndlist so that the GWT model has access to all ! the flow packages uztobj%fmi => fmi ! - ! -- return + ! -- Store pointer to governing equation scale factor + uztobj%eqnsclfac => eqnsclfac + ! + ! -- Set labels that will be used in generalized APT class + uztobj%depvartype = dvt + uztobj%depvarunit = dvu + uztobj%depvarunitabbrev = dvua + ! + ! -- Return return end subroutine uzt_create + !> @brief Find corresponding uzt package + !< subroutine find_uzt_package(this) -! ****************************************************************************** -! find corresponding uzt package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -145,7 +148,6 @@ subroutine find_uzt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -249,14 +251,12 @@ subroutine find_uzt_package(this) return end subroutine find_uzt_package + !> @brief Add matrix terms related to UZT + !! + !! This will be called from TspAptType%apt_fc_expanded() + !! in order to add matrix terms specifically for this package + !< subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! uzt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded() -! in order to add matrix terms specifically for this package -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this @@ -271,7 +271,6 @@ subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add infiltration contribution if (this%idxbudinfl /= 0) then @@ -321,21 +320,17 @@ subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine uzt_fc_expanded + !> @brief Explicit solve + !! + !! Add terms specific to the unsaturated zone to the explicit unsaturated- + !! zone solve subroutine uzt_solve(this) -! ****************************************************************************** -! uzt_solve -- add terms specific to the unsaturated zone to the explicit -! unsaturated-zone solve -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType) :: this ! -- local integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add infiltration contribution if (this%idxbudinfl /= 0) then @@ -373,21 +368,17 @@ subroutine uzt_solve(this) return end subroutine uzt_solve + !> @brief Function that returns the number of budget terms for this package + !! + !! This overrides function in parent. + !< function uzt_get_nbudterms(this) result(nbudterms) -! ****************************************************************************** -! uzt_get_nbudterms -- function to return the number of budget terms just for -! this package. This overrides function in parent. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 4 nbudterms = 0 @@ -400,14 +391,9 @@ function uzt_get_nbudterms(this) result(nbudterms) return end function uzt_get_nbudterms + !> @brief Set up the budget object that stores all the unsaturated-zone flows + !< subroutine uzt_setup_budobj(this, idx) -! ****************************************************************************** -! uzt_setup_budobj -- Set up the budget object that stores all the unsaturated- -! zone flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -416,9 +402,8 @@ subroutine uzt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! - ! -- + ! -- Infiltration flux text = ' INFILTRATION' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist @@ -430,9 +415,8 @@ subroutine uzt_setup_budobj(this, idx) this%packName, & maxlist, .false., .false., & naux) - ! - ! -- + ! -- Rejected infiltration flux (and subsequently removed from the model) if (this%idxbudrinf /= 0) then text = ' REJ-INF' idx = idx + 1 @@ -446,9 +430,8 @@ subroutine uzt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- + ! -- Evapotranspiration flux originating from the unsaturated zone if (this%idxbuduzet /= 0) then text = ' UZET' idx = idx + 1 @@ -462,9 +445,8 @@ subroutine uzt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- + ! -- Rejected infiltration flux that is transferred to the MVR/MVT packages if (this%idxbudritm /= 0) then text = ' INF-REJ-TO-MVR' idx = idx + 1 @@ -478,19 +460,13 @@ subroutine uzt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- return + ! -- Return return end subroutine uzt_setup_budobj + !> @brief Copy flow terms into this%budobj subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! uzt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this @@ -503,8 +479,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- INFILTRATION idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist @@ -514,7 +489,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) call this%budobj%budterm(idx)%update_term(n1, n2, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - + ! ! -- REJ-INF if (this%idxbudrinf /= 0) then idx = idx + 1 @@ -526,7 +501,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- UZET if (this%idxbuduzet /= 0) then idx = idx + 1 @@ -538,7 +513,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- REJ-INF-TO-MVR if (this%idxbudritm /= 0) then idx = idx + 1 @@ -550,28 +525,24 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - ! - ! -- return + ! -- Return return end subroutine uzt_fill_budobj + !> @brief Allocate scalar variables for package + !! + !! Method to allocate scalar variables for the package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtUztType) :: this ! -- local -! ------------------------------------------------------------------------------ ! - ! -- allocate scalars in GwtAptType - call this%GwtAptType%allocate_scalars() + ! -- allocate scalars in TspAptType + call this%TspAptType%allocate_scalars() ! ! -- Allocate call mem_allocate(this%idxbudinfl, 'IDXBUDINFL', this%memoryPath) @@ -589,27 +560,24 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate arrays for package + !! + !! Method to allocate arrays for the package. + !< subroutine uzt_allocate_arrays(this) -! ****************************************************************************** -! uzt_allocate_arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(GwtUztType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concinfl, this%ncv, 'CONCINFL', this%memoryPath) call mem_allocate(this%concuzet, this%ncv, 'CONCUZET', this%memoryPath) ! - ! -- call standard GwtApttype allocate arrays - call this%GwtAptType%apt_allocate_arrays() + ! -- call standard TspAptType allocate arrays + call this%TspAptType%apt_allocate_arrays() ! ! -- Initialize do n = 1, this%ncv @@ -617,24 +585,20 @@ subroutine uzt_allocate_arrays(this) this%concuzet(n) = DZERO end do ! - ! ! -- Return return end subroutine uzt_allocate_arrays + !> @brief Deallocate memory + !! + !! Method to deallocate memory for the package. + !< subroutine uzt_da(this) -! ****************************************************************************** -! uzt_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtUztType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudinfl) @@ -646,21 +610,20 @@ subroutine uzt_da(this) call mem_deallocate(this%concinfl) call mem_deallocate(this%concuzet) ! - ! -- deallocate scalars in GwtAptType - call this%GwtAptType%bnd_da() + ! -- deallocate scalars in TspAptType + call this%TspAptType%bnd_da() ! ! -- Return return end subroutine uzt_da + !> @brief Infiltration term + !! + !! Accounts for mass added to the subsurface via infiltration. For example, + !! mass entering the model domain via rainfall or irrigation. + !< subroutine uzt_infl_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! uzt_infl_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType) :: this integer(I4B), intent(in) :: ientry @@ -673,7 +636,7 @@ subroutine uzt_infl_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: h, r -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry) ! -- note that qbnd is negative for negative infiltration @@ -691,18 +654,19 @@ subroutine uzt_infl_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = r if (present(hcofval)) hcofval = h ! - ! -- return + ! -- Return return end subroutine uzt_infl_term + !> @brief Rejected infiltration term + !! + !! Accounts for mass that is added to the model from specifying an + !! infiltration rate and concentration, but is subsequently removed from + !! the model as that portion of the infiltration that is rejected (and + !! NOT transferred to another advanced package via the MVR/MVT packages). + !< subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! uzt_rinf_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType) :: this integer(I4B), intent(in) :: ientry @@ -714,7 +678,7 @@ subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry) @@ -723,18 +687,17 @@ subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine uzt_rinf_term + !> @brief Evapotranspiration from the unsaturated-zone term + !! + !! Accounts for mass removed as a result of evapotranspiration from the + !! unsaturated zone. + !< subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! uzt_uzet_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType) :: this integer(I4B), intent(in) :: ientry @@ -747,7 +710,7 @@ subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry) ! -- note that qbnd is negative for uzet @@ -764,18 +727,19 @@ subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp if (present(hcofval)) hcofval = omega * qbnd ! - ! -- return + ! -- Return return end subroutine uzt_uzet_term + !> @brief Rejected infiltration to MVR/MVT term + !! + !! Accounts for energy that is added to the model from specifying an + !! infiltration rate and temperature, but does not infiltrate into the + !! subsurface. This subroutine is called when the rejected infiltration + !! is transferred to another advanced package via the MVR/MVT packages. + !< subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) -! ****************************************************************************** -! uzt_ritm_term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType) :: this integer(I4B), intent(in) :: ientry @@ -787,7 +751,7 @@ subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry) @@ -796,25 +760,22 @@ subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, & if (present(rhsval)) rhsval = DZERO if (present(hcofval)) hcofval = qbnd ! - ! -- return + ! -- Return return end subroutine uzt_ritm_term + !> @brief Define UZT Observation + !! + !! This subroutine: + !! - Stores observation types supported by the parent APT package. + !! - Overrides BndType%bnd_df_obs + !< subroutine uzt_df_obs(this) -! ****************************************************************************** -! uzt_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -870,13 +831,13 @@ subroutine uzt_df_obs(this) call this%obs%StoreObsType('rej-inf-to-mvr', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID ! + ! -- Return return end subroutine uzt_df_obs !> @brief Process package specific obs - !! - !! Method to process specific observations for this package. - !! + !! + !! Method to process specific observations for this package. !< subroutine uzt_rp_obs(this, obsrv, found) ! -- dummy @@ -902,13 +863,9 @@ subroutine uzt_rp_obs(this, obsrv, found) return end subroutine uzt_rp_obs + !> @brief Calculate observation value and pass it back to APT + !< subroutine uzt_bd_obs(this, obstypeid, jj, v, found) -! ****************************************************************************** -! uzt_bd_obs -- calculate observation value and pass it back to APT -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtUztType), intent(inout) :: this character(len=*), intent(in) :: obstypeid @@ -917,7 +874,6 @@ subroutine uzt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -941,16 +897,13 @@ subroutine uzt_bd_obs(this, obstypeid, jj, v, found) found = .false. end select ! + ! -- Return return end subroutine uzt_bd_obs + !> @brief Sets the stress period attributes for keyword use. + !< subroutine uzt_set_stressperiod(this, itemno, keyword, found) -! ****************************************************************************** -! uzt_set_stressperiod -- Set a stress period attribute for using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy class(GwtUztType), intent(inout) :: this @@ -963,7 +916,6 @@ subroutine uzt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! INFILTRATION ! UZET @@ -1000,7 +952,7 @@ subroutine uzt_set_stressperiod(this, itemno, keyword, found) ! 999 continue ! - ! -- return + ! -- Return return end subroutine uzt_set_stressperiod diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90 index 1ec95293e16..9bda0f770f8 100644 --- a/src/Model/ModelUtilities/BoundaryPackage.f90 +++ b/src/Model/ModelUtilities/BoundaryPackage.f90 @@ -120,6 +120,7 @@ module BndModule procedure :: bnd_rp procedure :: bnd_ad procedure :: bnd_ck + procedure :: bnd_reset procedure :: bnd_cf procedure :: bnd_fc procedure :: bnd_fn @@ -187,7 +188,7 @@ subroutine bnd_df(this, neq, dis) ! ! -- Create time series managers call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout) ! ! -- create obs package call obs_cr(this%obs, this%inobspkg) @@ -364,7 +365,8 @@ subroutine bnd_rp(this) call this%TasManager%Reset(this%packName) ! ! -- Read data as a list - call this%dis%read_list(this%parser%iuactive, this%iout, & + call this%dis%read_list(this%parser%line_reader, & + this%parser%iuactive, this%iout, & this%iprpak, nlist, this%inamedbound, & this%iauxmultcol, this%nodelist, & this%bound, this%auxvar, this%auxname, & @@ -444,6 +446,17 @@ subroutine bnd_ck(this) return end subroutine bnd_ck + !> @ brief Reset bnd package before formulating + !< + subroutine bnd_reset(this) + class(BndType) :: this !< BndType object + + if (this%imover == 1) then + call this%pakmvrobj%reset() + end if + + end subroutine bnd_reset + !> @ brief Formulate the package hcof and rhs terms. !! !! Formulate the hcof and rhs terms for the package that will be @@ -452,10 +465,9 @@ end subroutine bnd_ck !! boundary package. !! !< - subroutine bnd_cf(this, reset_mover) + subroutine bnd_cf(this) ! -- modules class(BndType) :: this !< BndType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover ! ! -- bnd has no cf routine ! diff --git a/src/Model/ModelUtilities/BoundaryPackageExt.f90 b/src/Model/ModelUtilities/BoundaryPackageExt.f90 new file mode 100644 index 00000000000..16d6e7e3975 --- /dev/null +++ b/src/Model/ModelUtilities/BoundaryPackageExt.f90 @@ -0,0 +1,779 @@ +!> @brief This module contains the extended boundary package +!! +!! This module contains the extended boundary type that itself +!! should be extended by model boundary packages that have been +!! updated to source static and dynamic input data from the +!! input context. +!! +!< +module BndExtModule + + use KindModule, only: DP, LGP, I4B + use ConstantsModule, only: LENMEMPATH, LENBOUNDNAME, LENAUXNAME, LINELENGTH + use ObsModule, only: obs_cr + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors, store_error_filename + use BndModule, only: BndType + use GeomUtilModule, only: get_node, get_ijk + + implicit none + + private + public :: BndExtType + + !> @ brief BndExtType + !! + !! Generic extended boundary package type. This derived type can be + !! overriden to define concrete boundary package types that source + !! all input from the input context. + !< + type, extends(BndType) :: BndExtType + ! -- characters + ! -- scalars + integer(I4B), pointer :: iper + ! -- arrays + integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() + contains + procedure :: bnd_df => bndext_df + procedure :: bnd_rp => bndext_rp + procedure :: bnd_da => bndext_da + procedure :: allocate_scalars => bndext_allocate_scalars + procedure :: allocate_arrays => bndext_allocate_arrays + procedure :: source_options + procedure :: source_dimensions + procedure :: log_options + procedure :: nodelist_update + procedure :: check_cellid + procedure :: write_list + procedure :: bound_value + end type BndExtType + + !> @ brief BndExtFoundType + !! + !! This type is used to simplify the tracking of common parameters + !! that are sourced from the input context. + !< + type BndExtFoundType + logical :: naux = .false. + logical :: ipakcb = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: boundnames = .false. + logical :: auxmultname = .false. + logical :: inewton = .false. + logical :: auxiliary = .false. + logical :: maxbound = .false. + end type BndExtFoundType + +contains + + !> @ brief Define boundary package options and dimensions + !! + !! Define base boundary package options and dimensions for + !! a model boundary package. + !! + !< + subroutine bndext_df(this, neq, dis) + ! -- modules + use BaseDisModule, only: DisBaseType + use TimeArraySeriesManagerModule, only: TimeArraySeriesManagerType, & + tasmanager_cr + use TimeSeriesManagerModule, only: TimeSeriesManagerType, tsmanager_cr + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(inout) :: neq !< number of equations + class(DisBaseType), pointer :: dis !< discretization object + ! + ! -- set pointer to dis object for the model + this%dis => dis + ! + ! -- Create time series managers + ! -- Not in use by this type but BndType uses and deallocates + call tsmanager_cr(this%TsManager, this%iout) + call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout) + ! + ! -- create obs package + call obs_cr(this%obs, this%inobspkg) + ! + ! -- Write information to model list file + write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%input_mempath +1 format(1X, /1X, a, ' -- ', a, ' PACKAGE, VERSION 8, 2/22/2014', & + ' INPUT READ FROM MEMPATH: ', a) + ! + ! -- source options + call this%source_options() + ! + ! -- Define time series managers + call this%tsmanager%tsmanager_df() + call this%tasmanager%tasmanager_df() + ! + ! -- source dimensions + call this%source_dimensions() + ! + ! -- update package moffset for packages that add rows + if (this%npakeq > 0) then + this%ioffset = neq - this%dis%nodes + end if + ! + ! -- update neq + neq = neq + this%npakeq + ! + ! -- Store information needed for observations + if (this%bnd_obs_supported()) then + call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis) + call this%bnd_df_obs() + end if + ! + ! -- return + return + end subroutine bndext_df + + subroutine bndext_rp(this) + ! -- modules + use TdisModule, only: kper + use MemoryManagerModule, only: mem_deallocate, mem_reallocate + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + ! -- local variables + logical(LGP) :: found + integer(I4B) :: n + ! + if (this%iper /= kper) return + ! + ! -- copy nbound from input context + call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, & + found) + ! + ! -- convert cellids to node numbers + call this%nodelist_update() + ! + ! -- update boundname string list + if (this%inamedbound /= 0) then + do n = 1, size(this%boundname_cst) + this%boundname(n) = this%boundname_cst(n) + end do + end if + ! + ! -- return + return + end subroutine bndext_rp + + !> @ brief Deallocate package memory + !< + subroutine bndext_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate, mem_setptr + ! -- dummy variables + class(BndExtType) :: this !< BndExtType object + ! + ! -- deallocate checkin paths + call mem_deallocate(this%cellid, 'CELLID', this%memoryPath) + call mem_deallocate(this%boundname_cst, 'BOUNDNAME_IDM', this%memoryPath) + call mem_deallocate(this%auxvar, 'AUXVAR_IDM', this%memoryPath) + ! + ! -- reassign pointers for base class _da + call mem_setptr(this%boundname_cst, 'BOUNDNAME_CST', this%memoryPath) + call mem_setptr(this%auxvar, 'AUXVAR', this%memoryPath) + ! + ! -- scalars + nullify (this%iper) + ! + ! -- deallocate + call this%BndType%bnd_da() + ! + ! -- return + return + end subroutine bndext_da + + !> @ brief Allocate package scalars + !! + !! Allocate and initialize base boundary package scalars. This method + !! only needs to be overridden if additional scalars are defined + !! for a specific package. + !! + !< + subroutine bndext_allocate_scalars(this) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use MemoryManagerExtModule, only: mem_set_value + use MemoryHelperModule, only: create_mem_path + use SimVariablesModule, only: idm_context + ! -- dummy variables + class(BndExtType) :: this !< BndExtType object + ! -- local variables + character(len=LENMEMPATH) :: input_mempath + ! + ! -- set memory path + input_mempath = create_mem_path(this%name_model, this%packName, idm_context) + ! + ! -- allocate base BndType scalars + call this%BndType%allocate_scalars() + ! + ! -- set pointers to period input data scalars + call mem_setptr(this%iper, 'IPER', input_mempath) + ! + ! -- return + return + end subroutine bndext_allocate_scalars + + !> @ brief Allocate package arrays + !! + !! Allocate and initialize base boundary package arrays. This method + !! only needs to be overridden if additional arrays are defined + !! for a specific package. + !! + !< + subroutine bndext_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_deallocate, mem_setptr, mem_checkin + ! -- dummy variables + class(BndExtType) :: this !< BndExtType object + ! -- local variables + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist !< package nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar !< package aux variable array + ! + ! -- allocate base BndType arrays + call this%BndType%allocate_arrays(nodelist, auxvar) + ! + ! -- set input context pointers + call mem_setptr(this%cellid, 'CELLID', this%input_mempath) + call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%input_mempath) + ! + ! -- checkin input context pointers + call mem_checkin(this%cellid, 'CELLID', this%memoryPath, & + 'CELLID', this%input_mempath) + call mem_checkin(this%boundname_cst, LENBOUNDNAME, 'BOUNDNAME_IDM', & + this%memoryPath, 'BOUNDNAME', this%input_mempath) + ! + if (present(auxvar)) then + ! no-op + else + ! -- set auxvar input context pointer + call mem_setptr(this%auxvar, 'AUXVAR', this%input_mempath) + ! + ! -- checkin auxvar input context pointer + call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, & + 'AUXVAR', this%input_mempath) + end if + ! + ! -- return + return + end subroutine bndext_allocate_arrays + + !> @ brief Source package options from input context + !< + subroutine source_options(this) + ! -- modules + use MemoryManagerModule, only: mem_reallocate, mem_setptr !, get_isize + use MemoryManagerExtModule, only: mem_set_value + use InputOutputModule, only: GetUnit, openfile + use CharacterStringModule, only: CharacterStringType + use SourceCommonModule, only: filein_fname + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + ! -- local variables + type(BndExtFoundType) :: found + character(len=LENAUXNAME) :: sfacauxname + integer(I4B) :: n + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%naux, 'NAUX', this%input_mempath, found%naux) + call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb) + call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak) + call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow) + call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, & + found%boundnames) + call mem_set_value(sfacauxname, 'AUXMULTNAME', this%input_mempath, & + found%auxmultname) + call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton) + ! + ! -- log found options + call this%log_options(found, sfacauxname) + ! + ! -- reallocate aux arrays if aux variables provided + if (found%naux .and. this%naux > 0) then + call mem_reallocate(this%auxname, LENAUXNAME, this%naux, & + 'AUXNAME', this%memoryPath) + call mem_reallocate(this%auxname_cst, LENAUXNAME, this%naux, & + 'AUXNAME_CST', this%memoryPath) + call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, & + found%auxiliary) + ! + do n = 1, this%naux + this%auxname(n) = this%auxname_cst(n) + end do + end if + ! + ! -- save flows option active + if (found%ipakcb) this%ipakcb = -1 + ! + ! -- auxmultname provided + if (found%auxmultname) this%iauxmultcol = -1 + ! + ! + ! -- enforce 0 or 1 OBS6_FILENAME entries in option block + if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', & + this%input_mempath, this%input_fname)) then + this%obs%active = .true. + this%obs%inUnitObs = GetUnit() + call openfile(this%obs%inUnitObs, this%iout, this%obs%inputFilename, 'OBS') + end if + ! + ! -- no newton specified + if (found%inewton) this%inewton = 0 + ! + ! -- AUXMULTNAME was specified, so find column of auxvar that will be multiplier + if (this%iauxmultcol < 0) then + ! + ! -- Error if no aux variable specified + if (this%naux == 0) then + write (errmsg, '(a,2(1x,a))') & + 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), & + 'but no AUX variables specified.' + call store_error(errmsg) + end if + ! + ! -- Assign mult column + this%iauxmultcol = 0 + do n = 1, this%naux + if (sfacauxname == this%auxname(n)) then + this%iauxmultcol = n + exit + end if + end do + ! + ! -- Error if aux variable cannot be found + if (this%iauxmultcol == 0) then + write (errmsg, '(a,2(1x,a))') & + 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), & + 'but no AUX variable found with this name.' + call store_error(errmsg) + end if + end if + ! + ! -- terminate if errors were detected + if (count_errors() > 0) then + call store_error_filename(this%input_fname) + end if + ! + ! -- return + return + end subroutine source_options + + !> @ brief Log package options + !< + subroutine log_options(this, found, sfacauxname) + ! -- modules + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + type(BndExtFoundType), intent(in) :: found + character(len=*), intent(in) :: sfacauxname + ! -- local variables + ! -- format + character(len=*), parameter :: fmtflow = & + &"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')" + character(len=*), parameter :: fmttas = & + &"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)" + character(len=*), parameter :: fmtts = & + &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)" + character(len=*), parameter :: fmtnme = & + &"(a, i0, a)" + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' BASE OPTIONS' + ! + if (found%ipakcb) then + write (this%iout, fmtflow) + end if + ! + if (found%iprpak) then + write (this%iout, '(4x,a)') & + 'LISTS OF '//trim(adjustl(this%text))//' CELLS WILL BE PRINTED.' + end if + ! + if (found%iprflow) then + write (this%iout, '(4x,a)') trim(adjustl(this%text))// & + ' FLOWS WILL BE PRINTED TO LISTING FILE.' + end if + ! + if (found%boundnames) then + write (this%iout, '(4x,a)') trim(adjustl(this%text))// & + ' BOUNDARIES HAVE NAMES IN LAST COLUMN.' + end if + ! + if (found%auxmultname) then + write (this%iout, '(4x,a,a)') & + 'AUXILIARY MULTIPLIER NAME: ', sfacauxname + end if + ! + if (found%inewton) then + write (this%iout, '(4x,a)') & + 'NEWTON-RAPHSON method disabled for unconfined cells' + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' BASE OPTIONS' + ! + ! -- return + return + end subroutine log_options + + !> @ brief Source package dimensions from input context + !< + subroutine source_dimensions(this) + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + ! -- local variables + type(BndExtFoundType) :: found + ! + ! -- open dimensions logging block + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & + ' BASE DIMENSIONS' + ! + ! -- update defaults with idm sourced values + call mem_set_value(this%maxbound, 'MAXBOUND', this%input_mempath, & + found%maxbound) + ! + write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' BASE DIMENSIONS' + ! + ! -- verify dimensions were set + if (this%maxbound <= 0) then + write (errmsg, '(a)') 'MAXBOUND must be an integer greater than zero.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + ! -- Call define_listlabel to construct the list label that is written + ! when PRINT_INPUT option is used. + call this%define_listlabel() + ! + ! -- return + return + end subroutine source_dimensions + + !> @ brief Update package nodelist + !! + !! Convert period updated cellids to node numbers. + !! + !< + subroutine nodelist_update(this) + ! -- modules + use SimVariablesModule, only: errmsg + ! -- dummy + class(BndExtType) :: this !< BndExtType object + ! -- local + integer(I4B), dimension(:), pointer :: cellid + integer(I4B) :: n, nodeu, noder + character(len=LINELENGTH) :: nodestr + ! + ! -- update nodelist + do n = 1, this%nbound + ! + ! -- set cellid + cellid => this%cellid(:, n) + ! + ! -- ensure cellid is valid, store an error otherwise + call this%check_cellid(n, cellid, this%dis%mshape, this%dis%ndim) + ! + ! -- Determine user node number + if (this%dis%ndim == 1) then + nodeu = cellid(1) + elseif (this%dis%ndim == 2) then + nodeu = get_node(cellid(1), 1, cellid(2), & + this%dis%mshape(1), 1, & + this%dis%mshape(2)) + else + nodeu = get_node(cellid(1), cellid(2), cellid(3), & + this%dis%mshape(1), & + this%dis%mshape(2), & + this%dis%mshape(3)) + end if + ! + ! -- update the nodelist + if (this%dis%nodes < this%dis%nodesuser) then + ! -- convert user to reduced node numbers + noder = this%dis%get_nodenumber(nodeu, 0) + if (noder <= 0) then + call this%dis%nodeu_to_string(nodeu, nodestr) + write (errmsg, *) & + ' Cell is outside active grid domain: '// & + trim(adjustl(nodestr)) + call store_error(errmsg) + end if + this%nodelist(n) = noder + else + this%nodelist(n) = nodeu + end if + end do + ! + ! -- exit if errors were found + if (count_errors() > 0) then + write (errmsg, *) count_errors(), ' errors encountered.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + ! -- return + return + end subroutine nodelist_update + + !> @ brief Check for valid cellid + !< + subroutine check_cellid(this, ii, cellid, mshape, ndim) + ! -- modules + use SimVariablesModule, only: errmsg + ! -- dummy + class(BndExtType) :: this !< BndExtType object + ! -- local + integer(I4B), intent(in) :: ii + integer(I4B), dimension(:), intent(in) :: cellid !< cellid + integer(I4B), dimension(:), intent(in) :: mshape !< model shape + integer(I4B), intent(in) :: ndim !< size of mshape + character(len=20) :: cellstr, mshstr + character(len=*), parameter :: fmterr = & + "('List entry ',i0,' contains cellid ',a,' but this cellid is invalid & + &for model with shape ', a)" + character(len=*), parameter :: fmtndim1 = & + "('(',i0,')')" + character(len=*), parameter :: fmtndim2 = & + "('(',i0,',',i0,')')" + character(len=*), parameter :: fmtndim3 = & + "('(',i0,',',i0,',',i0,')')" + select case (ndim) + case (1) + ! + if (cellid(1) < 1 .or. cellid(1) > mshape(1)) then + write (cellstr, fmtndim1) cellid(1) + write (mshstr, fmtndim1) mshape(1) + write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr)) + call store_error(errmsg) + end if + ! + case (2) + ! + if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. & + cellid(2) < 1 .or. cellid(2) > mshape(2)) then + write (cellstr, fmtndim2) cellid(1), cellid(2) + write (mshstr, fmtndim2) mshape(1), mshape(2) + write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr)) + call store_error(errmsg) + end if + ! + case (3) + ! + if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. & + cellid(2) < 1 .or. cellid(2) > mshape(2) .or. & + cellid(3) < 1 .or. cellid(3) > mshape(3)) then + write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3) + write (mshstr, fmtndim3) mshape(1), mshape(2), mshape(3) + write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr)) + call store_error(errmsg) + end if + ! + case default + end select + ! + ! -- return + return + end subroutine check_cellid + + !> @ brief Log package list input + !! + !! Log period list based input. This routine requires a package specific + !! bound_value() routine to report accurate bound values. + !! + !< + subroutine write_list(this) + ! -- modules + use ConstantsModule, only: LINELENGTH, LENBOUNDNAME, & + TABLEFT, TABCENTER, DZERO + use InputOutputModule, only: ulstlb + use TableModule, only: TableType, table_cr + ! -- dummy + class(BndExtType) :: this !< BndExtType object + ! -- local + character(len=10) :: cpos + character(len=LINELENGTH) :: tag + character(len=LINELENGTH), allocatable, dimension(:) :: words + integer(I4B) :: ntabrows + integer(I4B) :: ntabcols + integer(I4B) :: ipos + integer(I4B) :: ii, jj, i, j, k, nod + integer(I4B) :: ldim + integer(I4B) :: naux + type(TableType), pointer :: inputtab => null() + ! -- formats + character(len=LINELENGTH) :: fmtlstbn +! ------------------------------------------------------------------------------ + ! + ! -- Determine sizes + ldim = this%ncolbnd + naux = size(this%auxvar, 1) + ! + ! -- dimension table + ntabrows = this%nbound + ! + ! -- start building format statement to parse this%label, which + ! contains the column headers (except for boundname and auxnames) + ipos = index(this%listlabel, 'NO.') + if (ipos /= 0) then + write (cpos, '(i10)') ipos + 3 + fmtlstbn = '(a'//trim(adjustl(cpos)) + else + fmtlstbn = '(a7' + end if + ! -- sequence number, layer, row, and column. + if (size(this%dis%mshape) == 3) then + ntabcols = 4 + fmtlstbn = trim(fmtlstbn)//',a7,a7,a7' + ! + ! -- sequence number, layer, and cell2d. + else if (size(this%dis%mshape) == 2) then + ntabcols = 3 + fmtlstbn = trim(fmtlstbn)//',a7,a7' + ! + ! -- sequence number and node. + else + ntabcols = 2 + fmtlstbn = trim(fmtlstbn)//',a7' + end if + ! + ! -- Add fields for non-optional real values + ntabcols = ntabcols + ldim + do i = 1, ldim + fmtlstbn = trim(fmtlstbn)//',a16' + end do + ! + ! -- Add field for boundary name + if (this%inamedbound == 1) then + ntabcols = ntabcols + 1 + fmtlstbn = trim(fmtlstbn)//',a16' + end if + ! + ! -- Add fields for auxiliary variables + ntabcols = ntabcols + naux + do i = 1, naux + fmtlstbn = trim(fmtlstbn)//',a16' + end do + fmtlstbn = trim(fmtlstbn)//')' + ! + ! -- allocate words + allocate (words(ntabcols)) + ! + ! -- parse this%listlabel into words + read (this%listlabel, fmtlstbn) (words(i), i=1, ntabcols) + ! + ! -- initialize the input table object + call table_cr(inputtab, ' ', ' ') + call inputtab%table_df(ntabrows, ntabcols, this%iout) + ! + ! -- add the columns + ipos = 1 + call inputtab%initialize_column(words(ipos), 10, alignment=TABCENTER) + ! + ! -- discretization + do i = 1, size(this%dis%mshape) + ipos = ipos + 1 + call inputtab%initialize_column(words(ipos), 7, alignment=TABCENTER) + end do + ! + ! -- non-optional variables + do i = 1, ldim + ipos = ipos + 1 + call inputtab%initialize_column(words(ipos), 16, alignment=TABCENTER) + end do + ! + ! -- boundname + if (this%inamedbound == 1) then + ipos = ipos + 1 + tag = 'BOUNDNAME' + call inputtab%initialize_column(tag, LENBOUNDNAME, alignment=TABLEFT) + end if + ! + ! -- aux variables + do i = 1, naux + call inputtab%initialize_column(this%auxname(i), 16, alignment=TABCENTER) + end do + ! + ! -- Write the table + do ii = 1, this%nbound + call inputtab%add_term(ii) + ! + ! -- discretization + if (size(this%dis%mshape) == 3) then + nod = this%nodelist(ii) + call get_ijk(nod, this%dis%mshape(2), this%dis%mshape(3), & + this%dis%mshape(1), i, j, k) + call inputtab%add_term(k) + call inputtab%add_term(i) + call inputtab%add_term(j) + else if (size(this%dis%mshape) == 2) then + nod = this%nodelist(ii) + call get_ijk(nod, 1, this%dis%mshape(2), this%dis%mshape(1), i, j, k) + call inputtab%add_term(k) + call inputtab%add_term(j) + else + nod = this%nodelist(ii) + call inputtab%add_term(nod) + end if + ! + ! -- non-optional variables + do jj = 1, ldim + call inputtab%add_term(this%bound_value(jj, ii)) + end do + ! + ! -- boundname + if (this%inamedbound == 1) then + call inputtab%add_term(this%boundname(ii)) + end if + ! + ! -- aux variables + do jj = 1, naux + call inputtab%add_term(this%auxvar(jj, ii)) + end do + end do + ! + ! -- deallocate the local variables + call inputtab%table_da() + deallocate (inputtab) + nullify (inputtab) + deallocate (words) + ! + ! -- return + return + end subroutine write_list + + !> @ brief Return a bound value + !! + !! Return a bound value associated with an ncolbnd index + !! and row. This function should be overridden in the + !! derived package class. + !! + !< + function bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DNODATA + ! -- dummy variables + class(BndExtType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! + ! -- override this return value by redefining this + ! routine in the derived package. + bndval = DNODATA + ! + ! -- return + return + end function bound_value + +end module BndExtModule diff --git a/src/Model/ModelUtilities/Connections.f90 b/src/Model/ModelUtilities/Connections.f90 index 9dfaec39fae..2092b3a6e53 100644 --- a/src/Model/ModelUtilities/Connections.f90 +++ b/src/Model/ModelUtilities/Connections.f90 @@ -3,9 +3,10 @@ module ConnectionsModule use ArrayReadersModule, only: ReadArray use KindModule, only: DP, I4B use ConstantsModule, only: LENMODELNAME, LENMEMPATH - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use SimVariablesModule, only: errmsg use BlockParserModule, only: BlockParserType + use GeomUtilModule, only: get_node implicit none private @@ -35,7 +36,9 @@ module ConnectionsModule integer(I4B), dimension(:), pointer, contiguous :: iausr => null() !< (size:nodesusr+1) integer(I4B), dimension(:), pointer, contiguous :: jausr => null() !< (size:nja) type(BlockParserType) :: parser !< block parser + contains + procedure :: con_da procedure :: allocate_scalars procedure :: allocate_arrays @@ -52,18 +55,13 @@ module ConnectionsModule contains + !> @brief Deallocate connection variables + !< subroutine con_da(this) -! ****************************************************************************** -! con_da -- Deallocate connection variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(ConnectionsType) :: this -! ------------------------------------------------------------------------------ ! ! -- Strings deallocate (this%name_model) @@ -103,28 +101,23 @@ subroutine con_da(this) call mem_deallocate(this%cl1) call mem_deallocate(this%cl2) ! - ! -- return + ! -- Return return end subroutine con_da + !> @brief Allocate scalars for ConnectionsType + !< subroutine allocate_scalars(this, name_model) -! ****************************************************************************** -! allocate_scalars -- Allocate scalars for ConnectionsType -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use MemoryHelperModule, only: create_mem_path ! -- dummy class(ConnectionsType) :: this character(len=*), intent(in) :: name_model -! ------------------------------------------------------------------------------ ! ! -- allocate allocate (this%name_model) - + ! this%memoryPath = create_mem_path(name_model, 'CON') call mem_allocate(this%nodes, 'NODES', this%memoryPath) call mem_allocate(this%nja, 'NJA', this%memoryPath) @@ -140,17 +133,12 @@ subroutine allocate_scalars(this, name_model) return end subroutine allocate_scalars + !> @brief Allocate arrays for ConnectionsType + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Allocate arrays for ConnectionsType -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use MemoryManagerModule, only: mem_allocate ! -- dummy class(ConnectionsType) :: this -! ------------------------------------------------------------------------------ ! ! -- allocate space for connection arrays call mem_allocate(this%ia, this%nodes + 1, 'IA', this%memoryPath) @@ -173,13 +161,9 @@ subroutine allocate_arrays(this) return end subroutine allocate_arrays + !> @brief Finalize connection data + !< subroutine con_finalize(this, ihctemp, cl12temp, hwvatemp, angldegx) -! ****************************************************************************** -! con_finalize -- Finalize connection data -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, DONE, DHALF, DPIO180, DNODATA use SimModule, only: store_error, count_errors, store_error_unit @@ -220,7 +204,6 @@ subroutine con_finalize(this, ihctemp, cl12temp, hwvatemp, angldegx) data aname(4)/' CL12'/ data aname(5)/' HWVA'/ data aname(6)/' ANGLDEGX'/ -! ------------------------------------------------------------------------------ ! ! -- Convert any negative ja numbers to positive do ii = 1, this%nja @@ -341,14 +324,10 @@ subroutine con_finalize(this, ihctemp, cl12temp, hwvatemp, angldegx) return end subroutine con_finalize + !> @brief Read and process IAC and JA from an an input block called + !! CONNECTIONDATA + !< subroutine read_connectivity_from_block(this, name_model, nodes, nja, iout) -! ****************************************************************************** -! read_connectivity_from_block -- Read and process IAC and JA from an -! an input block called CONNECTIONDATA -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors @@ -377,7 +356,6 @@ subroutine read_connectivity_from_block(this, name_model, nodes, nja, iout) ! -- data data aname(1)/' IAC'/ data aname(2)/' JA'/ -! ------------------------------------------------------------------------------ ! ! -- Allocate and initialize dimensions call this%allocate_scalars(name_model) @@ -456,7 +434,7 @@ subroutine read_connectivity_from_block(this, name_model, nodes, nja, iout) m = this%ja(ii) if (n /= this%ja(this%isym(ii))) then write (line, fmtsymerr) aname(2), ii, this%isym(ii) - call sim_message(line) + call write_message(line) call this%parser%StoreErrorUnit() end if end do @@ -470,14 +448,9 @@ subroutine read_connectivity_from_block(this, name_model, nodes, nja, iout) return end subroutine read_connectivity_from_block + !> @brief Using a vector of cell lengths, calculate the cl1 and cl2 arrays. + !< subroutine set_cl1_cl2_from_fleng(this, fleng) -! ****************************************************************************** -! set_cl1_cl2_from_fleng -- Using a vector of cell lengths, -! calculate the cl1 and cl2 arrays. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF ! -- dummy @@ -485,7 +458,6 @@ subroutine set_cl1_cl2_from_fleng(this, fleng) real(DP), dimension(:), intent(in) :: fleng ! -- local integer(I4B) :: n, m, ii -! ------------------------------------------------------------------------------ ! ! -- Fill symmetric arrays cl1 and cl2 from fleng of the node do n = 1, this%nodes @@ -500,20 +472,15 @@ subroutine set_cl1_cl2_from_fleng(this, fleng) return end subroutine set_cl1_cl2_from_fleng + !> @brief Construct the connectivity arrays for a structured + !! three-dimensional grid. + !< subroutine disconnections(this, name_model, nodes, ncol, nrow, nlay, & nrsize, delr, delc, top, bot, nodereduced, & nodeuser) -! ****************************************************************************** -! disconnections -- Construct the connectivity arrays for a structured -! three-dimensional grid. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO, DTHREE, DTWO, DPI use SparseModule, only: sparsematrix - use InputOutputModule, only: get_node ! -- dummy class(ConnectionsType) :: this character(len=*), intent(in) :: name_model @@ -534,7 +501,6 @@ subroutine disconnections(this, name_model, nodes, ncol, nrow, nlay, & type(sparsematrix) :: sparse integer(I4B) :: i, j, k, kk, ierror, isympos, nodesuser integer(I4B) :: nr, mr -! ------------------------------------------------------------------------------ ! ! -- Allocate scalars call this%allocate_scalars(name_model) @@ -749,20 +715,14 @@ subroutine disconnections(this, name_model, nodes, ncol, nrow, nlay, & return end subroutine disconnections + !> @brief Construct the connectivity arrays using cell disv information + !< subroutine disvconnections(this, name_model, nodes, ncpl, nlay, nrsize, & nvert, vertex, iavert, javert, cellxy, & top, bot, nodereduced, nodeuser) -! ****************************************************************************** -! disvconnections -- Construct the connectivity arrays using cell disv -! information. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO, DTHREE, DTWO, DPI use SparseModule, only: sparsematrix - use InputOutputModule, only: get_node use DisvGeom, only: DisvGeomType use MemoryManagerModule, only: mem_reallocate ! -- dummy @@ -786,7 +746,6 @@ subroutine disvconnections(this, name_model, nodes, ncpl, nlay, nrsize, & type(sparsematrix) :: sparse, vertcellspm integer(I4B) :: n, m, ipos, i, j, ierror, nodesuser type(DisvGeomType) :: cell1, cell2 -! ------------------------------------------------------------------------------ ! ! -- Allocate scalars call this%allocate_scalars(name_model) @@ -857,17 +816,13 @@ subroutine disvconnections(this, name_model, nodes, ncpl, nlay, nrsize, & return end subroutine disvconnections + !> @brief Construct the connectivity arrays using disu information. Grid + !! may be reduced + !< subroutine disuconnections(this, name_model, nodes, nodesuser, nrsize, & nodereduced, nodeuser, iainp, jainp, & ihcinp, cl12inp, hwvainp, angldegxinp, & iangledegx) -! ****************************************************************************** -! disuconnections -- Construct the connectivity arrays using disu -! information. Grid may be reduced -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DHALF, DZERO, DTHREE, DTWO, DPI use SparseModule, only: sparsematrix @@ -895,7 +850,6 @@ subroutine disuconnections(this, name_model, nodes, nodesuser, nrsize, & integer(I4B) :: nr, nu, mr, mu, ipos, iposr, ierror integer(I4B), dimension(:), allocatable :: rowmaxnnz type(sparsematrix) :: sparse -! ------------------------------------------------------------------------------ ! ! -- Allocate scalars call this%allocate_scalars(name_model) @@ -997,14 +951,10 @@ subroutine disuconnections(this, name_model, nodes, nodesuser, nrsize, & return end subroutine disuconnections + !> @brief Fill iausr and jausr if reduced grid, otherwise point them to ia + !! and ja. + !< subroutine iajausr(this, nrsize, nodesuser, nodereduced, nodeuser) -! ****************************************************************************** -! iajausr -- Fill iausr and jausr if reduced grid, otherwise point them -! to ia and ja. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_reallocate, mem_deallocate, mem_setptr ! -- dummy @@ -1015,7 +965,6 @@ subroutine iajausr(this, nrsize, nodesuser, nodereduced, nodeuser) integer(I4B), dimension(:), intent(in) :: nodeuser ! -- local integer(I4B) :: n, nr, ipos -! ------------------------------------------------------------------------------ ! ! -- If reduced system, then need to build iausr and jausr, otherwise point ! them to ia and ja. @@ -1054,19 +1003,17 @@ subroutine iajausr(this, nrsize, nodesuser, nodereduced, nodeuser) return end subroutine iajausr + !> @brief Get the index in the JA array corresponding to the connection + !! between two nodes of interest. + !! + !! Node1 is used as the index in the IA array, and IA(Node1) is the row index + !! in the (nodes x nodes) matrix represented by the compressed sparse row + !! format. + !! + !! -1 is returned if either node number is invalid. + !! 0 is returned if the two nodes are not connected. + !< function getjaindex(this, node1, node2) -! ****************************************************************************** -! Get the index in the JA array corresponding to the connection between -! two nodes of interest. Node1 is used as the index in the IA array, and -! IA(Node1) is the row index in the (nodes x nodes) matrix represented by -! the compressed sparse row format. -! -! -1 is returned if either node number is invalid. -! 0 is returned if the two nodes are not connected. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: getjaindex ! -- dummy @@ -1074,7 +1021,6 @@ function getjaindex(this, node1, node2) integer(I4B), intent(in) :: node1, node2 ! nodes of interest ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- error checking if (node1 < 1 .or. node1 > this%nodes .or. node2 < 1 .or. & @@ -1103,13 +1049,9 @@ function getjaindex(this, node1, node2) return end function getjaindex + !> @brief Function to fill the isym array + !< subroutine fillisym(neq, nja, ia, ja, isym) -! ****************************************************************************** -! fillisym -- function to fill the isym array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B), intent(in) :: neq integer(I4B), intent(in) :: nja @@ -1118,7 +1060,6 @@ subroutine fillisym(neq, nja, ia, ja, isym) integer(I4B), intent(in), dimension(neq + 1) :: ia integer(I4B), intent(in), dimension(nja) :: ja integer(I4B) :: n, m, ii, jj -! ------------------------------------------------------------------------------ ! do n = 1, neq do ii = ia(n), ia(n + 1) - 1 @@ -1141,13 +1082,9 @@ subroutine fillisym(neq, nja, ia, ja, isym) return end subroutine fillisym + !> @brief Function to fill the jas array + !< subroutine filljas(neq, nja, ia, ja, isym, jas) -! ****************************************************************************** -! fillisym -- function to fill the jas array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B), intent(in) :: neq integer(I4B), intent(in) :: nja @@ -1157,7 +1094,6 @@ subroutine filljas(neq, nja, ia, ja, isym, jas) integer(I4B), intent(inout), dimension(nja) :: jas ! -- local integer(I4B) :: n, m, ii, ipos -! ------------------------------------------------------------------------------ ! ! -- set diagonal to zero and fill upper ipos = 1 @@ -1186,17 +1122,12 @@ subroutine filljas(neq, nja, ia, ja, isym, jas) return end subroutine filljas + !> @brief Routine to make cell connections from vertices + !< subroutine vertexconnect(nodes, nrsize, maxnnz, nlay, ncpl, sparse, & vertcellspm, cell1, cell2, nodereduced) -! ****************************************************************************** -! vertexconnect -- routine to make cell connections from vertices -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix - use InputOutputModule, only: get_node use DisvGeom, only: DisvGeomType ! -- dummy integer(I4B), intent(in) :: nodes @@ -1211,7 +1142,6 @@ subroutine vertexconnect(nodes, nrsize, maxnnz, nlay, ncpl, sparse, & ! -- local integer(I4B), dimension(:), allocatable :: rowmaxnnz integer(I4B) :: i, j, k, kk, nr, mr, j1, j2, icol1, icol2, nvert -! ------------------------------------------------------------------------------ ! ! -- Allocate and fill the ia and ja arrays allocate (rowmaxnnz(nodes)) @@ -1284,25 +1214,22 @@ subroutine vertexconnect(nodes, nrsize, maxnnz, nlay, ncpl, sparse, & end do end do ! - ! -- return + ! -- Return return end subroutine vertexconnect + !> @brief routine to set a value in the mask array (which has the same shape + !! as this%ja) + !< subroutine set_mask(this, ipos, maskval) -! ****************************************************************************** -! set_mask -- routine to set a value in the mask array -! (which has the same shape as this%ja) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use MemoryManagerModule, only: mem_allocate + ! -- dummy class(ConnectionsType) :: this integer(I4B), intent(in) :: ipos integer(I4B), intent(in) :: maskval - ! local + ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! if we still point to this%ja, we first need to allocate space if (associated(this%mask, this%ja)) then @@ -1316,23 +1243,18 @@ subroutine set_mask(this, ipos, maskval) ! -- set the mask value this%mask(ipos) = maskVal ! - ! -- return + ! -- Return return end subroutine set_mask + !> @brief Convert an iac array into an ia array + !< subroutine iac_to_ia(iac, ia) -! ****************************************************************************** -! iac_to_ia -- convert an iac array into an ia array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B), dimension(:), contiguous, pointer, intent(in) :: iac integer(I4B), dimension(:), contiguous, intent(inout) :: ia ! -- local integer(I4B) :: n, nodes -! ------------------------------------------------------------------------------ ! ! -- Convert iac to ia nodes = size(iac) @@ -1349,7 +1271,7 @@ subroutine iac_to_ia(iac, ia) end do ia(1) = 1 ! - ! -- return + ! -- Return return end subroutine iac_to_ia diff --git a/src/Model/ModelUtilities/DiscretizationBase.f90 b/src/Model/ModelUtilities/DiscretizationBase.f90 index dd03ac8faa3..927b49c6926 100644 --- a/src/Model/ModelUtilities/DiscretizationBase.f90 +++ b/src/Model/ModelUtilities/DiscretizationBase.f90 @@ -1,16 +1,17 @@ module BaseDisModule - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LENMODELNAME, LENAUXNAME, LINELENGTH, & DZERO, LENMEMPATH, DPIO180 use SmoothingModule, only: sQuadraticSaturation use ConnectionsModule, only: ConnectionsType - use InputOutputModule, only: URWORD, ubdsv1 + use InputOutputModule, only: URWORD, ubdsv1, ubdsvd use SimVariablesModule, only: errmsg use SimModule, only: count_errors, store_error, & store_error_unit use BlockParserModule, only: BlockParserType use MemoryManagerModule, only: mem_allocate + use MemoryManagerExtModule, only: mem_set_value use MemoryHelperModule, only: create_mem_path use TdisModule, only: kstp, kper, pertim, totim, delt use TimeSeriesManagerModule, only: TimeSeriesManagerType @@ -24,8 +25,8 @@ module BaseDisModule type :: DisBaseType character(len=LENMEMPATH) :: memoryPath !< path for memory allocation + character(len=LENMEMPATH) :: input_mempath = '' !< input context mempath character(len=LENMODELNAME), pointer :: name_model => null() !< name of the model - character(len=LENMEMPATH), pointer :: input_mempath => null() !< input context mempath character(len=LINELENGTH), pointer :: input_fname => null() !< input file name integer(I4B), pointer :: inunit => null() !< unit number for input file integer(I4B), pointer :: iout => null() !< unit number for output file @@ -86,6 +87,7 @@ module BaseDisModule procedure :: allocate_arrays procedure :: get_ncpl procedure :: get_cell_volume + procedure :: get_polyverts procedure :: write_grb ! procedure :: read_int_array @@ -107,36 +109,21 @@ module BaseDisModule procedure, public :: nlarray_to_nodelist procedure, public :: highest_active procedure, public :: get_area + procedure, public :: get_area_factor end type DisBaseType contains + !> @brief Define the discretization subroutine dis_df(this) -! ****************************************************************************** -! dis_df -- Read discretization information from DISU input file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy class(DisBaseType) :: this -! ------------------------------------------------------------------------------ - ! - call store_error('Program error: DisBaseType method dis_df not & - &implemented.', terminate=.TRUE.) - ! - ! -- Return - return + call store_error('Programmer error: dis_df must be overridden', & + terminate=.true.) end subroutine dis_df + !> @brief Add connections to sparse cell connectivity matrix subroutine dis_ac(this, moffset, sparse) -! ****************************************************************************** -! dis_ac -- Add connections to sparse based on cell connectivity -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix ! -- dummy @@ -145,7 +132,6 @@ subroutine dis_ac(this, moffset, sparse) type(sparsematrix), intent(inout) :: sparse ! -- local integer(I4B) :: i, j, ipos, iglo, jglo -! ------------------------------------------------------------------------------ ! do i = 1, this%nodes do ipos = this%con%ia(i), this%con%ia(i + 1) - 1 @@ -155,20 +141,10 @@ subroutine dis_ac(this, moffset, sparse) call sparse%addconnection(iglo, jglo, 1) end do end do - ! - ! -- Return - return end subroutine dis_ac + !> @brief Map cell connections in the numerical solution coefficient matrix. subroutine dis_mc(this, moffset, idxglo, matrix_sln) -! ****************************************************************************** -! dis_mc -- Map the positions of cell connections in the numerical solution -! coefficient matrix. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: moffset @@ -176,7 +152,6 @@ subroutine dis_mc(this, moffset, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, j, ipos, iglo, jglo -! ------------------------------------------------------------------------------ ! do i = 1, this%nodes iglo = i + moffset @@ -186,26 +161,16 @@ subroutine dis_mc(this, moffset, idxglo, matrix_sln) idxglo(ipos) = matrix_sln%get_position(iglo, jglo) end do end do - ! - ! -- Return - return end subroutine dis_mc + !> @brief Allocate and setup variables, and write binary grid file. subroutine dis_ar(this, icelltype) -! ****************************************************************************** -! dis_ar -- Called from AR procedure. Only task is to write binary grid file. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(DisBaseType) :: this integer(I4B), dimension(:), intent(in) :: icelltype ! -- local integer(I4B), dimension(:), allocatable :: ict integer(I4B) :: nu, nr -! ------------------------------------------------------------------------------ ! ! -- Expand icelltype to full grid; fill with 0 if cell is excluded allocate (ict(this%nodesuser)) @@ -219,49 +184,25 @@ subroutine dis_ar(this, icelltype) end do ! if (this%nogrb == 0) call this%write_grb(ict) - ! - ! -- Return - return end subroutine dis_ar + !> @brief Write a binary grid file subroutine write_grb(this, icelltype) -! ****************************************************************************** -! write_grb -- Called from AR procedure. Only task is to write binary grid file. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- dummy class(DisBaseType) :: this integer(I4B), dimension(:), intent(in) :: icelltype - ! -- local -! ------------------------------------------------------------------------------ - ! - ! - call store_error('Program error: DisBaseType method write_grb not & - &implemented.', terminate=.TRUE.) - ! - ! -- Return - return + call store_error('Programmer error: write_grb must be overridden', & + terminate=.true.) end subroutine write_grb + !> @brier Deallocate variables subroutine dis_da(this) -! ****************************************************************************** -! dis_da -- Deallocate discretization object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(DisBaseType) :: this -! ------------------------------------------------------------------------------ ! ! -- Strings deallocate (this%name_model) - deallocate (this%input_mempath) deallocate (this%input_fname) ! ! -- Scalars @@ -292,225 +233,113 @@ subroutine dis_da(this) ! -- Connections call this%con%con_da() deallocate (this%con) - ! - ! -- Return - return end subroutine dis_da + !> @brief Convert a user nodenumber to a string (nodenumber), (k,j), or (k,i,j) subroutine nodeu_to_string(this, nodeu, str) -! ****************************************************************************** -! nodeu_to_string -- Convert user node number to a string in the form of -! (nodenumber) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: nodeu character(len=*), intent(inout) :: str - ! -- local -! ------------------------------------------------------------------------------ - ! - call store_error('Program error: DisBaseType method nodeu_to_string not & - &implemented.', terminate=.TRUE.) - ! - ! -- return - return + + call store_error('Programmer error: nodeu_to_string must be overridden', & + terminate=.true.) end subroutine nodeu_to_string + !> @brief Convert a user nodenumber to an array (nodenumber), (k,j), or (k,i,j) subroutine nodeu_to_array(this, nodeu, arr) -! ****************************************************************************** -! nodeu_to_array -- Convert user node number to cellid and fill array with -! (nodenumber) or (k,j) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: nodeu integer(I4B), dimension(:), intent(inout) :: arr - ! -- local -! ------------------------------------------------------------------------------ - ! - call store_error('Program error: DisBaseType method nodeu_to_array not & - &implemented.', terminate=.TRUE.) - ! - ! -- return - return + + call store_error('Programmer error: nodeu_to_array must be overridden', & + terminate=.true.) end subroutine nodeu_to_array + !> @brief Convert a reduced nodenumber to a user node number function get_nodeuser(this, noder) result(nodenumber) -! ****************************************************************************** -! get_nodeuser -- Return the user nodenumber from the reduced node number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return - integer(I4B) :: nodenumber - ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: noder -! ------------------------------------------------------------------------------ - ! + integer(I4B) :: nodenumber + if (this%nodes < this%nodesuser) then nodenumber = this%nodeuser(noder) else nodenumber = noder end if - ! - ! -- return - return end function get_nodeuser function get_nodenumber_idx1(this, nodeu, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber -- Return a nodenumber from the user specified node number -! with an option to perform a check. This subroutine -! can be overridden by child classes to perform mapping -! to a model node number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error - ! -- dummy class(DisBaseType), intent(in) :: this integer(I4B), intent(in) :: nodeu integer(I4B), intent(in) :: icheck - ! -- local integer(I4B) :: nodenumber -! ------------------------------------------------------------------------------ - ! + nodenumber = 0 - call store_error('Program error: get_nodenumber_idx1 not implemented.', & - terminate=.TRUE.) - ! - ! -- return - return + call store_error('Programmer error: get_nodenumber_idx1 must be overridden', & + terminate=.true.) end function get_nodenumber_idx1 function get_nodenumber_idx2(this, k, j, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber_idx2 -- This function should never be called. It must be -! overridden by a child class. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use SimModule, only: store_error - ! -- dummy class(DisBaseType), intent(in) :: this integer(I4B), intent(in) :: k, j integer(I4B), intent(in) :: icheck integer(I4B) :: nodenumber -! ------------------------------------------------------------------------------ - ! + nodenumber = 0 - call store_error('Program error: get_nodenumber_idx2 not implemented.', & - terminate=.TRUE.) - ! - ! -- Return - return + call store_error('Programmer error: get_nodenumber_idx2 must be overridden', & + terminate=.true.) end function get_nodenumber_idx2 function get_nodenumber_idx3(this, k, i, j, icheck) result(nodenumber) -! ****************************************************************************** -! get_nodenumber_idx3 -- This function will not be invoked for an unstructured -! model, but it may be from a Discretization3dType model. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - use SimModule, only: store_error - ! -- dummy class(DisBaseType), intent(in) :: this integer(I4B), intent(in) :: k, i, j integer(I4B), intent(in) :: icheck integer(I4B) :: nodenumber -! ------------------------------------------------------------------------------ - ! + nodenumber = 0 - call store_error('Program error: get_nodenumber_idx3 not implemented.', & - terminate=.TRUE.) - ! - ! -- Return - return + call store_error('Programmer error: get_nodenumber_idx3 must be overridden', & + terminate=.true.) end function get_nodenumber_idx3 + !> @brief Get normal vector components between the cell and a given neighbor. + !! The normal points outward from the shared face between noden and nodem. subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, & ipos) -! ****************************************************************************** -! connection_normal -- calculate the normal vector components for reduced -! nodenumber cell (noden) and its shared face with cell nodem. ihc is the -! horizontal connection flag. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use SimModule, only: store_error - ! -- dummy class(DisBaseType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp integer(I4B), intent(in) :: ipos -! ------------------------------------------------------------------------------ - ! - call store_error('Program error: connection_normal not implemented.', & - terminate=.TRUE.) - ! - ! -- return - return + + call store_error('Programmer error: connection_normal must be overridden', & + terminate=.true.) end subroutine connection_normal + !> @brief Get unit vector components between the cell and a given neighbor. + !! Saturation must be provided to compute cell center vertical coordinates. + !! Also return the straight-line connection length. subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, & xcomp, ycomp, zcomp, conlen) -! ****************************************************************************** -! connection_vector -- calculate the unit vector components from reduced -! nodenumber cell (noden) to its neighbor cell (nodem). The saturation for -! for these cells are also required so that the vertical position of the cell -! cell centers can be calculated. ihc is the horizontal flag. Also return -! the straight-line connection length. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use SimModule, only: store_error - ! -- dummy class(DisBaseType) :: this - integer(I4B), intent(in) :: noden - integer(I4B), intent(in) :: nodem + integer(I4B), intent(in) :: noden !< cell (reduced nn) + integer(I4B), intent(in) :: nodem !< neighbor (reduced nn) logical, intent(in) :: nozee real(DP), intent(in) :: satn real(DP), intent(in) :: satm - integer(I4B), intent(in) :: ihc + integer(I4B), intent(in) :: ihc !< horizontal connection flag real(DP), intent(inout) :: xcomp real(DP), intent(inout) :: ycomp real(DP), intent(inout) :: zcomp real(DP), intent(inout) :: conlen - ! -- local -! ------------------------------------------------------------------------------ - ! - call store_error('Program error: connection_vector not implemented.', & - terminate=.TRUE.) - ! - ! -- return - return + + call store_error('Programmer error: connection_vector must be overridden', & + terminate=.true.) end subroutine connection_vector - !> @brief get the x,y for a node transformed into - !! 'global coordinates' using xorigin, yorigin, angrot, - !< analogously to how flopy does this. + !> @brief Get global (x, y) coordinates from cell-local coordinates. subroutine dis_transform_xy(x, y, xorigin, yorigin, angrot, xglo, yglo) real(DP), intent(in) :: x !< the cell-x coordinate to transform real(DP), intent(in) :: y !< the cell-y coordinate to transform @@ -535,44 +364,31 @@ subroutine dis_transform_xy(x, y, xorigin, yorigin, angrot, xglo, yglo) ! then _translate_ xglo = xglo + xorigin yglo = yglo + yorigin - end subroutine dis_transform_xy - !> @brief return discretization type - !< + !> @brief Get the discretization type (DIS, DISV, or DISU) subroutine get_dis_type(this, dis_type) class(DisBaseType), intent(in) :: this character(len=*), intent(out) :: dis_type - ! suppress warning dis_type = "Not implemented" - - call store_error('Program error: get_dis_type not implemented.', & - terminate=.TRUE.) - + call store_error('Programmer error: get_dis_type must be overridden', & + terminate=.true.) end subroutine get_dis_type - subroutine allocate_scalars(this, name_model) -! ****************************************************************************** -! allocate_scalars -- Allocate and initialize scalar variables in this class -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate + !> @brief Allocate and initialize scalar variables + subroutine allocate_scalars(this, name_model, input_mempath) ! -- dummy class(DisBaseType) :: this character(len=*), intent(in) :: name_model - ! -- local -! ------------------------------------------------------------------------------ + character(len=*), intent(in) :: input_mempath + logical(LGP) :: found ! ! -- Create memory path this%memoryPath = create_mem_path(name_model, 'DIS') ! ! -- Allocate allocate (this%name_model) - allocate (this%input_mempath) allocate (this%input_fname) ! call mem_allocate(this%inunit, 'INUNIT', this%memoryPath) @@ -591,7 +407,7 @@ subroutine allocate_scalars(this, name_model) ! ! -- Initialize this%name_model = name_model - this%input_mempath = '' + this%input_mempath = input_mempath this%input_fname = '' this%inunit = 0 this%iout = 0 @@ -607,23 +423,15 @@ subroutine allocate_scalars(this, name_model) this%njas = 0 this%lenuni = 0 ! - ! -- Return - return + ! -- update input filename + call mem_set_value(this%input_fname, 'INPUT_FNAME', & + this%input_mempath, found) end subroutine allocate_scalars + !> @brief Allocate and initialize arrays subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Read discretization information from file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use MemoryManagerModule, only: mem_allocate - ! -- dummy class(DisBaseType) :: this integer :: isize -! ------------------------------------------------------------------------------ ! ! -- Allocate call mem_allocate(this%mshape, this%ndim, 'MSHAPE', this%memoryPath) @@ -646,23 +454,16 @@ subroutine allocate_arrays(this) ! -- Allocate the arrays call mem_allocate(this%dbuff, isize, 'DBUFF', this%name_model) call mem_allocate(this%ibuff, isize, 'IBUFF', this%name_model) - ! - ! -- Return - return end subroutine allocate_arrays + !> @brief Convert a string to a user nodenumber. + !! + !! If DIS or DISV, read indices. If DISU, read user node number directly. + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !< function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & flag_string, allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_string -- Receive a string and convert the string to a user -! nodenumber. The model is unstructured; just read user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType) :: this integer(I4B), intent(inout) :: lloc @@ -674,33 +475,22 @@ function nodeu_from_string(this, lloc, istart, istop, in, iout, line, & logical, optional, intent(in) :: flag_string logical, optional, intent(in) :: allow_zero integer(I4B) :: nodeu - ! -- local -! ------------------------------------------------------------------------------ - ! - ! + nodeu = 0 - call store_error('Program error: DisBaseType method nodeu_from_string & - ¬ implemented.', terminate=.TRUE.) - ! - ! -- return - return + call store_error('Programmer error: nodeu_from_string must be overridden', & + terminate=.true.) end function nodeu_from_string + !> @brief Convert a cellid string to a user nodenumber. + !! + !! If flag_string is present and true, the first token may be + !! non-numeric (e.g. boundary name). In this case, return -2. + !! + !! If allow_zero is present and true, and all indices are zero, the + !! result can be zero. If allow_zero is false, a zero in any index is an error. + !< function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & allow_zero) result(nodeu) -! ****************************************************************************** -! nodeu_from_cellid -- Receive cellid as a string and convert the string to a -! user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! If allow_zero argument is present and true, if all indices equal zero, the -! result can be zero. If allow_zero is false, a zero in any index causes an -! error. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType) :: this character(len=*), intent(inout) :: cellid @@ -709,28 +499,21 @@ function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, & logical, optional, intent(in) :: flag_string logical, optional, intent(in) :: allow_zero integer(I4B) :: nodeu -! ------------------------------------------------------------------------------ - ! + nodeu = 0 - call store_error('Program error: DisBaseType method nodeu_from_cellid & - ¬ implemented.', terminate=.TRUE.) - ! - ! -- return - return + call store_error('Programmer error: nodeu_from_cellid must be overridden', & + terminate=.true.) end function nodeu_from_cellid + !> @brief Convert a string to a reduced nodenumber. + !! + !! If the model is unstructured; just read user nodenumber. + !! If flag_string argument is present and true, the first token in string + !! is allowed to be a string (e.g. boundary name). In this case, if a string + !! is encountered, return value as -2. + !< function noder_from_string(this, lloc, istart, istop, in, iout, line, & flag_string) result(noder) -! ****************************************************************************** -! noder_from_string -- Receive a string and convert the string to a reduced -! nodenumber. The model is unstructured; just read user nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType) :: this integer(I4B), intent(inout) :: lloc @@ -745,7 +528,6 @@ function noder_from_string(this, lloc, istart, istop, in, iout, line, & integer(I4B) :: nodeu character(len=LINELENGTH) :: nodestr logical :: flag_string_local -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then flag_string_local = flag_string @@ -768,26 +550,18 @@ function noder_from_string(this, lloc, istart, istop, in, iout, line, & trim(adjustl(nodestr)) call store_error(errmsg) end if - ! - ! -- return - return end function noder_from_string + !> @brief Convert cellid string to reduced nodenumber + !! + !! If flag_string argument is present and true, the first token in string + !! is allowed to be a string (e.g. boundary name). In this case, if a string + !! is encountered, return value as -2. + !! If allow_zero argument is present and true, if all indices equal zero, the + !! result can be zero. If allow_zero is false, a zero in any index is an error. + !< function noder_from_cellid(this, cellid, inunit, iout, flag_string, & allow_zero) result(noder) -! ****************************************************************************** -! noder_from_cellid -- Receive cellid as a string and convert it to a reduced -! nodenumber. -! If flag_string argument is present and true, the first token in string -! is allowed to be a string (e.g. boundary name). In this case, if a string -! is encountered, return value as -2. -! If allow_zero argument is present and true, if all indices equal zero, the -! result can be zero. If allow_zero is false, a zero in any index causes an -! error. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: noder ! -- dummy @@ -802,7 +576,6 @@ function noder_from_cellid(this, cellid, inunit, iout, flag_string, & logical :: allowzerolocal character(len=LINELENGTH) :: nodestr logical :: flag_string_local -! ------------------------------------------------------------------------------ ! if (present(flag_string)) then flag_string_local = flag_string @@ -831,61 +604,28 @@ function noder_from_cellid(this, cellid, inunit, iout, flag_string, & trim(adjustl(nodestr)) call store_error(errmsg) end if - ! - ! -- return - return end function noder_from_cellid + !> @brief Indicates whether the grid discretization supports layers. logical function supports_layers(this) -! ****************************************************************************** -! supports_layers -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy class(DisBaseType) :: this -! ------------------------------------------------------------------------------ - ! - ! supports_layers = .false. - call store_error('Program error: DisBaseType method supports_layers not & - &implemented.', terminate=.TRUE.) - return + call store_error('Programmer error: supports_layers must be overridden', & + terminate=.true.) end function supports_layers + !> @brief Return number of cells per layer. + !! This is nodes for a DISU grid, as there are no layers. function get_ncpl(this) -! ****************************************************************************** -! get_ncpl -- Return number of cells per layer. This is nodes -! for a DISU grid, as there are no layers. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return integer(I4B) :: get_ncpl - ! -- dummy class(DisBaseType) :: this -! ------------------------------------------------------------------------------ - ! - ! get_ncpl = 0 - call store_error('Program error: DisBaseType method get_ncpl not & - &implemented.', terminate=.TRUE.) - ! - ! -- Return - return + call store_error('Programmer error: get_ncpl must be overridden', & + terminate=.true.) end function get_ncpl + !> @brief Return volume of cell n based on x value passed. function get_cell_volume(this, n, x) -! ****************************************************************************** -! get_cell_volume -- Return volume of cell n based on x value passed. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return real(DP) :: get_cell_volume ! -- dummy @@ -897,27 +637,30 @@ function get_cell_volume(this, n, x) real(DP) :: bt real(DP) :: sat real(DP) :: thick -! ------------------------------------------------------------------------------ - ! + get_cell_volume = DZERO tp = this%top(n) bt = this%bot(n) sat = sQuadraticSaturation(tp, bt, x) thick = (tp - bt) * sat get_cell_volume = this%area(n) * thick - ! - ! -- Return - return end function get_cell_volume + !> @brief Get a 2D array of polygon vertices, listed in + !! clockwise order beginning with the lower left corner. + subroutine get_polyverts(this, ic, polyverts, closed) + class(DisBaseType), intent(inout) :: this + integer(I4B), intent(in) :: ic !< cell number (reduced) + real(DP), allocatable, intent(out) :: polyverts(:, :) !< polygon vertices (column-major indexing) + logical(LGP), intent(in), optional :: closed !< whether to close the polygon, duplicating a vertex + + errmsg = 'Programmer error: get_polyverts must be overridden' + call store_error(errmsg, terminate=.true.) + end subroutine + + !> @brief Read an integer array subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & iarray, aname) -! ****************************************************************************** -! read_int_array -- Read a GWF integer array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -928,24 +671,14 @@ subroutine read_int_array(this, line, lloc, istart, istop, iout, in, & integer(I4B), intent(in) :: iout integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: iarray character(len=*), intent(in) :: aname - ! - ! -- store error - errmsg = 'Programmer error: read_int_array needs to be overridden & - &in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! - ! -- return - return + + errmsg = 'Programmer error: read_int_array must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine read_int_array + !> @brief Read a double precision array subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & darray, aname) -! ****************************************************************************** -! read_dbl_array -- Read a GWF double precision array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType), intent(inout) :: this character(len=*), intent(inout) :: line @@ -956,23 +689,13 @@ subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, & integer(I4B), intent(in) :: iout real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray character(len=*), intent(in) :: aname - ! - ! -- str=ore error message - errmsg = 'Programmer error: read_dbl_array needs to be overridden & - &in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! - ! -- return - return + + errmsg = 'Programmer error: read_dbl_array must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine read_dbl_array + !> @brief Fill an integer array subroutine fill_int_array(this, ibuff1, ibuff2) -! ****************************************************************************** -! fill_dbl_array -- Fill a GWF integer array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType), intent(inout) :: this integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ibuff1 @@ -980,24 +703,16 @@ subroutine fill_int_array(this, ibuff1, ibuff2) ! -- local integer(I4B) :: nodeu integer(I4B) :: noder -! ------------------------------------------------------------------------------ + do nodeu = 1, this%nodesuser noder = this%get_nodenumber(nodeu, 0) if (noder <= 0) cycle ibuff2(noder) = ibuff1(nodeu) end do - ! - ! -- return - return end subroutine fill_int_array + !> @brief Fill a double precision array subroutine fill_dbl_array(this, buff1, buff2) -! ****************************************************************************** -! fill_dbl_array -- Fill a GWF double precision array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous, intent(in) :: buff1 @@ -1005,33 +720,28 @@ subroutine fill_dbl_array(this, buff1, buff2) ! -- local integer(I4B) :: nodeu integer(I4B) :: noder -! ------------------------------------------------------------------------------ + do nodeu = 1, this%nodesuser noder = this%get_nodenumber(nodeu, 0) if (noder <= 0) cycle buff2(noder) = buff1(nodeu) end do - ! - ! -- return - return end subroutine fill_dbl_array - subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & - iauxmultcol, nodelist, rlist, auxvar, auxname, & - boundname, label, pkgname, tsManager, iscloc, & + !> @brief Read a list using the list reader. + !! + !! Convert user node numbers to reduced numbers. + !! Terminate if any nodenumbers are within an inactive domain. + !! Set up time series and multiply by iauxmultcol if it exists. + !! Write the list to iout if iprpak is set. + !< + subroutine read_list(this, line_reader, in, iout, iprpak, nlist, & + inamedbound, iauxmultcol, nodelist, rlist, auxvar, & + auxname, boundname, label, pkgname, tsManager, iscloc, & indxconvertflux) -! ****************************************************************************** -! read_list -- Read a list using the list reader object. -! Convert user node numbers to reduced numbers. -! Terminate if any nodenumbers are within an inactive domain. -! Set up time series and multiply by iauxmultcol if it exists. -! Write the list to iout if iprpak is set. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, LINELENGTH + use LongLineReaderModule, only: LongLineReaderType use ListReaderModule, only: ListReaderType use SimModule, only: store_error, store_error_unit, count_errors use InputOutputModule, only: urword @@ -1039,6 +749,7 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & use TimeSeriesManagerModule, only: read_value_or_time_series ! -- dummy class(DisBaseType) :: this + type(LongLineReaderType), intent(inout) :: line_reader integer(I4B), intent(in) :: in integer(I4B), intent(in) :: iout integer(I4B), intent(in) :: iprpak @@ -1051,8 +762,6 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & character(len=LENAUXNAME), dimension(:), intent(inout) :: auxname character(len=LENBOUNDNAME), dimension(:), pointer, contiguous, & intent(inout) :: boundname - !character(len=:), dimension(:), pointer, contiguous, intent(inout) :: auxname - !character(len=:), dimension(:), pointer, contiguous, intent(inout) :: boundname character(len=*), intent(in) :: label character(len=*), intent(in) :: pkgName type(TimeSeriesManagerType) :: tsManager @@ -1067,11 +776,11 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & type(ListReaderType) :: lstrdobj type(TimeSeriesLinkType), pointer :: tsLinkBnd => null() type(TimeSeriesLinkType), pointer :: tsLinkAux => null() -! ------------------------------------------------------------------------------ ! ! -- Read the list - call lstrdobj%read_list(in, iout, nlist, inamedbound, this%mshape, & - nodelist, rlist, auxvar, auxname, boundname, label) + call lstrdobj%read_list(line_reader, in, iout, nlist, inamedbound, & + this%mshape, nodelist, rlist, auxvar, auxname, & + boundname, label) ! ! -- Go through all locations where a text string was found instead of ! a double precision value and make time-series links to rlist @@ -1167,21 +876,15 @@ subroutine read_list(this, in, iout, iprpak, nlist, inamedbound, & call store_error_unit(in) end if end if - ! - ! -- return end subroutine read_list + !> @brief Read a 2d double array into col icolbnd of darray. + !! + !! For cells that are outside of the active domain, + !! do not copy the array value into darray. + !< subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & icolbnd, aname, inunit, iout) -! ****************************************************************************** -! read_layer_array -- Read a 2d double array into col icolbnd of darray. -! For cells that are outside of the active domain, -! do not copy the array value into darray. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: ncolbnd @@ -1192,65 +895,36 @@ subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, & character(len=*), intent(in) :: aname integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout - ! - ! - errmsg = 'Programmer error: read_layer_array needs to be overridden & - &in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! - ! -- return + + errmsg = 'Programmer error: read_layer_array must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine read_layer_array + !> @brief Record a double precision array. + !! + !! The array is written to a formatted or unformatted external file + !! depending on the arguments. subroutine record_array(this, darray, iout, iprint, idataun, aname, & cdatafmp, nvaluesp, nwidthp, editdesc, dinact) -! ****************************************************************************** -! record_array -- Record a double precision array. The array will be -! printed to an external file and/or written to an unformatted external file -! depending on the argument specifications. -! ****************************************************************************** -! -! SPECIFICATIONS: -! darray is the double precision array to record -! iout is the unit number for ascii output -! iprint is a flag indicating whether or not to print the array -! idataun is the unit number to which the array will be written in binary -! form; if negative then do not write by layers, write entire array -! aname is the text descriptor of the array -! cdatafmp is the fortran format for writing the array -! nvaluesp is the number of values per line for printing -! nwidthp is the width of the number for printing -! editdesc is the format type (I, G, F, S, E) -! dinact is the double precision value to use for cells that are excluded -! from the model domain -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType), intent(inout) :: this - real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray - integer(I4B), intent(in) :: iout - integer(I4B), intent(in) :: iprint - integer(I4B), intent(in) :: idataun - character(len=*), intent(in) :: aname - character(len=*), intent(in) :: cdatafmp - integer(I4B), intent(in) :: nvaluesp - integer(I4B), intent(in) :: nwidthp - character(len=*), intent(in) :: editdesc - real(DP), intent(in) :: dinact - ! - ! -- - errmsg = 'Programmer error: record_array needs to be overridden & - &in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! + real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record + integer(I4B), intent(in) :: iout !< ascii output unit number + integer(I4B), intent(in) :: iprint !< whether to print the array + integer(I4B), intent(in) :: idataun !< binary output unit number + character(len=*), intent(in) :: aname !< text descriptor + character(len=*), intent(in) :: cdatafmp !< write format + integer(I4B), intent(in) :: nvaluesp !< values per line + integer(I4B), intent(in) :: nwidthp !< number width + character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E) + real(DP), intent(in) :: dinact !< double precision value for cells excluded from model domain + + errmsg = 'Programmer error: record_array must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine record_array + !> @brief Record a connection-based double precision array subroutine record_connection_array(this, flowja, ibinun, iout) -! ****************************************************************************** -! record_connection_array -- Record a connection-based double precision -! array for either a structured or an unstructured grid. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType) :: this real(DP), dimension(:), intent(in) :: flowja @@ -1260,74 +934,42 @@ subroutine record_connection_array(this, flowja, ibinun, iout) character(len=16), dimension(1) :: text ! -- data data text(1)/' FLOW-JA-FACE'/ -! ------------------------------------------------------------------------------ - ! + ! -- write full ja array call ubdsv1(kstp, kper, text(1), ibinun, flowja, size(flowja), 1, 1, & iout, delt, pertim, totim) - ! - ! -- return - return end subroutine record_connection_array + !> @brief Convert reduced node number to string (nodenumber), (k,j) or (k,i,j) subroutine noder_to_string(this, noder, str) -! ****************************************************************************** -! noder_to_string -- Convert reduced node number to a string in the form of -! (nodenumber) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: noder character(len=*), intent(inout) :: str ! -- local integer(I4B) :: nodeu -! ------------------------------------------------------------------------------ - ! + nodeu = this%get_nodeuser(noder) call this%nodeu_to_string(nodeu, str) - ! - ! -- return - return end subroutine noder_to_string + !> @brief Convert reduced node number to array (nodenumber), (k,j) or (k,i,j) subroutine noder_to_array(this, noder, arr) -! ****************************************************************************** -! noder_to_array -- Convert reduced node number to cellid and fill array with -! (nodenumber) or (k,j) or (k,i,j) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: noder integer(I4B), dimension(:), intent(inout) :: arr ! -- local integer(I4B) :: nodeu -! ------------------------------------------------------------------------------ - ! + nodeu = this%get_nodeuser(noder) call this%nodeu_to_array(nodeu, arr) - ! - ! -- return - return end subroutine noder_to_array + !> @brief Record list header for imeth=6 subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & dstmodel, dstpackage, naux, auxtxt, & ibdchn, nlist, iout) -! ****************************************************************************** -! record_srcdst_list_header -- Record list header for imeth=6 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy class(DisBaseType) :: this character(len=16), intent(in) :: text character(len=16), intent(in) :: textmodel @@ -1339,26 +981,14 @@ subroutine record_srcdst_list_header(this, text, textmodel, textpackage, & integer(I4B), intent(in) :: ibdchn integer(I4B), intent(in) :: nlist integer(I4B), intent(in) :: iout - ! - ! -- - errmsg = 'Programmer error: record_srcdst_list_header needs to be & - &overridden in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! - ! -- return - return + + errmsg = 'Programmer error: record_srcdst_list_header must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine record_srcdst_list_header + !> @brief Record list header subroutine record_srcdst_list_entry(this, ibdchn, noder, noder2, q, & naux, aux, olconv, olconv2) -! ****************************************************************************** -! record_srcdst_list_header -- Record list header -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use InputOutputModule, only: ubdsvd ! -- dummy class(DisBaseType) :: this integer(I4B), intent(in) :: ibdchn @@ -1374,13 +1004,12 @@ subroutine record_srcdst_list_entry(this, ibdchn, noder, noder2, q, & logical :: lconv2 integer(I4B) :: nodeu integer(I4B) :: nodeu2 -! ------------------------------------------------------------------------------ ! ! -- Use ubdsvb to write list header if (present(olconv)) then lconv = olconv else - lconv = .TRUE. + lconv = .true. end if if (lconv) then nodeu = this%get_nodeuser(noder) @@ -1390,7 +1019,7 @@ subroutine record_srcdst_list_entry(this, ibdchn, noder, noder2, q, & if (present(olconv2)) then lconv2 = olconv2 else - lconv2 = .TRUE. + lconv2 = .true. end if if (lconv2) then nodeu2 = this%get_nodeuser(noder2) @@ -1398,49 +1027,26 @@ subroutine record_srcdst_list_entry(this, ibdchn, noder, noder2, q, & nodeu2 = noder2 end if call ubdsvd(ibdchn, nodeu, nodeu2, q, naux, aux) - ! - ! -- return - return end subroutine record_srcdst_list_entry - subroutine nlarray_to_nodelist(this, nodelist, maxbnd, nbound, aname, & - inunit, iout) -! ****************************************************************************** -! nlarray_to_nodelist -- Read an integer array into nodelist. For structured -! model, integer array is layer number; for unstructured -! model, integer array is node number. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - use SimModule, only: store_error - use ConstantsModule, only: LINELENGTH - ! -- dummy + !> @brief Convert an integer array to nodelist. + !! + !! For DIS/DISV, the array is layer number, for DISU it's node number. + !< + subroutine nlarray_to_nodelist(this, darray, nodelist, maxbnd, nbound, aname) class(DisBaseType) :: this integer(I4B), intent(in) :: maxbnd + integer(I4B), dimension(:), pointer, contiguous :: darray integer(I4B), dimension(maxbnd), intent(inout) :: nodelist integer(I4B), intent(inout) :: nbound character(len=*), intent(in) :: aname - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout - ! - ! -- - errmsg = 'Programmer error: nlarray_to_nodelist needs to be & - &overridden in any DIS type that extends DisBaseType' - call store_error(errmsg, terminate=.TRUE.) - ! - ! -- return - return + + errmsg = 'Programmer error: nlarray_to_nodelist must be overridden' + call store_error(errmsg, terminate=.true.) end subroutine nlarray_to_nodelist + !> @brief Find the first highest active cell beneath cell n subroutine highest_active(this, n, ibound) -! ****************************************************************************** -! highest_active -- Find the first highest active cell beneath cell n -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(DisBaseType) :: this integer(I4B), intent(inout) :: n @@ -1448,7 +1054,6 @@ subroutine highest_active(this, n, ibound) ! -- locals integer(I4B) :: m, ii, iis logical done, bottomcell -! ------------------------------------------------------------------------------ ! ! -- Loop through connected cells until the highest active one (including a ! constant head cell) is found. Return that cell as n. @@ -1476,30 +1081,43 @@ subroutine highest_active(this, n, ibound) end do cloop if (bottomcell) done = .true. end do - ! - ! -- return - return end subroutine highest_active + !> @brief Return the cell area for the given node function get_area(this, node) result(area) -! ****************************************************************************** -! get_area -- Return the cell area for this node -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return + class(DisBaseType) :: this + integer(I4B), intent(in) :: node !< reduced node number real(DP) :: area + + area = this%area(node) + end function get_area + + !> @ brief Calculate the area factor for the cell connection + !! + !! Function calculates the area factor for the cell connection. The sum of + !! all area factors for all cell connections to overlying or underlying + !! cells cells will be 1. + !! + !! TODO: confirm that this works for cells that are only partially covered + !! by overlying or underlying cells. + !< + function get_area_factor(this, node, idx_conn) result(area_factor) + ! -- return + real(DP) :: area_factor !< connection cell area factor ! -- dummy class(DisBaseType) :: this - integer(I4B), intent(in) :: node -! ------------------------------------------------------------------------------ + integer(I4B), intent(in) :: node !< cell node number + integer(I4B), intent(in) :: idx_conn !< connection index + ! -- local + real(DP) :: area_node + real(DP) :: area_conn ! - ! -- Return the cell area - area = this%area(node) + ! -- calculate the cell area fraction + area_node = this%area(node) + area_conn = this%con%hwva(idx_conn) ! - ! -- return - return - end function get_area + ! -- return the cell area factor + area_factor = area_conn / area_node + end function get_area_factor end module BaseDisModule diff --git a/src/Model/ModelUtilities/DisvGeom.f90 b/src/Model/ModelUtilities/DisvGeom.f90 index 581ad424b88..e935afad6fd 100644 --- a/src/Model/ModelUtilities/DisvGeom.f90 +++ b/src/Model/ModelUtilities/DisvGeom.f90 @@ -1,13 +1,14 @@ module DisvGeom use KindModule, only: DP, I4B - use InputOutputModule, only: get_node, get_jk + use GeomUtilModule, only: get_node, get_jk implicit none private public :: DisvGeomType public :: line_unit_vector type DisvGeomType + integer(I4B) :: k integer(I4B) :: j integer(I4B) :: nodeusr @@ -26,7 +27,9 @@ module DisvGeom real(DP), pointer, dimension(:, :) :: cellxy_grid => null() integer(I4B), pointer, dimension(:, :) :: nodereduced => null() ! nodered = nodereduced(nodeusr) integer(I4B), pointer, dimension(:) :: nodeuser => null() ! nodeusr = nodesuser(nodered) + contains + procedure :: init generic :: set => set_kj, set_nodered procedure :: set_kj @@ -37,12 +40,16 @@ module DisvGeom procedure :: connection_vector procedure :: shares_edge procedure :: get_area + end type DisvGeomType contains + !> @brief Initialize + !< subroutine init(this, nlay, ncpl, nodes, top_grid, bot_grid, iavert, & javert, vertex_grid, cellxy_grid, nodereduced, nodeuser) + ! -- dummy class(DisvGeomType) :: this integer(I4B), intent(in) :: nlay integer(I4B), intent(in) :: ncpl @@ -57,6 +64,7 @@ subroutine init(this, nlay, ncpl, nodes, top_grid, bot_grid, iavert, & integer(I4B), dimension(nodes), target :: nodeuser ! -- local integer(I4B) :: nodesuser + ! this%nlay = nlay this%ncpl = ncpl this%nodes = nodes @@ -69,6 +77,7 @@ subroutine init(this, nlay, ncpl, nodes, top_grid, bot_grid, iavert, & this%nodereduced => nodereduced this%nodeuser => nodeuser nodesuser = ncpl * nlay + ! if (nodes < nodesuser) then this%reduced = .true. else @@ -76,10 +85,14 @@ subroutine init(this, nlay, ncpl, nodes, top_grid, bot_grid, iavert, & end if end subroutine init + !> @brief Set node IDs + !< subroutine set_kj(this, k, j) + ! -- dummy class(DisvGeomType) :: this integer(I4B), intent(in) :: k integer(I4B), intent(in) :: j + ! this%k = k this%j = j this%nodeusr = get_node(k, 1, j, this%nlay, 1, this%ncpl) @@ -89,25 +102,39 @@ subroutine set_kj(this, k, j) this%nodered = this%nodeusr end if call this%cell_setup() + ! + ! -- Return return end subroutine set_kj + !> @brief Set reduced node number + !< subroutine set_nodered(this, nodered) + ! -- dummy class(DisvGeomType) :: this integer(I4B), intent(in) :: nodered + ! this%nodered = nodered + ! if (this%reduced) then this%nodeusr = this%nodeuser(nodered) else this%nodeusr = nodered end if + ! call get_jk(this%nodeusr, this%ncpl, this%nlay, this%j, this%k) call this%cell_setup() + ! + ! -- Return return end subroutine set_nodered + !> @brief Set top and bottom elevations of grid cell + !< subroutine cell_setup(this) + ! -- dummy class(DisvGeomType) :: this + ! this%top = this%top_grid(this%nodered) this%bot = this%bot_grid(this%nodered) end subroutine cell_setup @@ -115,6 +142,7 @@ end subroutine cell_setup subroutine cprops(this, cell2, hwva, cl1, cl2, ax, ihc) ! -- module use ConstantsModule, only: DZERO, DHALF, DONE + ! -- dummy class(DisvGeomType) :: this type(DisvGeomType) :: cell2 real(DP), intent(out) :: hwva @@ -177,12 +205,14 @@ subroutine cprops(this, cell2, hwva, cl1, cl2, ax, ihc) ax = anglex(x1, y1, x2, y2) end if end if + ! + ! -- Return return end subroutine cprops + !> @brief Return the x and y components of an outward normal facing vector + !< subroutine edge_normal(this, cell2, xcomp, ycomp) - ! return the x and y components of an outward normal - ! facing vector ! -- module use ConstantsModule, only: DZERO, DHALF, DONE ! -- dummy @@ -208,14 +238,17 @@ subroutine edge_normal(this, cell2, xcomp, ycomp) y2 = this%vertex_grid(2, ivert2) ! call line_unit_normal(x1, y1, x2, y2, xcomp, ycomp) + ! + ! -- Return return end subroutine edge_normal + !> @brief Return the x y and z components of a unit vector that points from + !! from the center of this to the center of cell2, and the straight-line + !! connection length + !< subroutine connection_vector(this, cell2, nozee, satn, satm, xcomp, & ycomp, zcomp, conlen) - ! return the x y and z components of a unit vector that points - ! from the center of this to the center of cell2, and the - ! straight-line connection length ! -- module use ConstantsModule, only: DZERO, DHALF, DONE ! -- dummy @@ -245,22 +278,23 @@ subroutine connection_vector(this, cell2, nozee, satn, satm, xcomp, & ! call line_unit_vector(x1, y1, z1, x2, y2, z2, xcomp, ycomp, zcomp, & conlen) + ! + ! -- Return return end subroutine connection_vector + !> @brief Return true if this shares a horizontal edge with cell2 + !< function shares_edge(this, cell2) result(l) -! ****************************************************************************** -! shares_edge -- Return true if this shares a horizontal edge with cell2 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(DisvGeomType) :: this type(DisvGeomType) :: cell2 + ! -- return logical l + ! -- local integer(I4B) :: istart1, istop1, istart2, istop2 integer(I4B) :: ivert1, ivert2 -! ------------------------------------------------------------------------------ + ! istart1 = this%iavert(this%j) istop1 = this%iavert(this%j + 1) - 1 istart2 = cell2%iavert(cell2%j) @@ -272,30 +306,29 @@ function shares_edge(this, cell2) result(l) if (ivert1 == 0 .or. ivert2 == 0) then l = .false. end if + ! + ! -- Return return end function shares_edge + !> @brief Find two common vertices shared by cell1 and cell2. + !! + !! Return 0 if there are no shared edges. Proceed forward through ivlist1 + !! and backward through ivlist2 as a clockwise face in cell1 must correspond + !! to a counter clockwise face in cell2. + !< subroutine shared_edge(ivlist1, ivlist2, ivert1, ivert2) -! ****************************************************************************** -! shared_edge -- Find two common vertices shared by cell1 and cell2. -! ivert1 and ivert2 will return with 0 if there are -! no shared edges. Proceed forward through ivlist1 and -! backward through ivlist2 as a clockwise face in cell1 -! must correspond to a counter clockwise face in cell2 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy integer(I4B), dimension(:) :: ivlist1 integer(I4B), dimension(:) :: ivlist2 integer(I4B), intent(out) :: ivert1 integer(I4B), intent(out) :: ivert2 + ! -- local integer(I4B) :: nv1 integer(I4B) :: nv2 integer(I4B) :: il1 integer(I4B) :: il2 logical :: found -! ------------------------------------------------------------------------------ ! found = .false. nv1 = size(ivlist1) @@ -316,15 +349,12 @@ subroutine shared_edge(ivlist1, ivlist2, ivert1, ivert2) end do outerloop end subroutine shared_edge + !> @brief Calculate and return the area of the cell + !! + !! a = 1/2 *[(x1*y2 + x2*y3 + x3*y4 + ... + xn*y1) - + !! (x2*y1 + x3*y2 + x4*y3 + ... + x1*yn)] + !< function get_area(this) result(area) -! ****************************************************************************** -! get_cell2d_area -- Calculate and return the area of the cell -! a = 1/2 *[(x1*y2 + x2*y3 + x3*y4 + ... + xn*y1) - -! (x2*y1 + x3*y2 + x4*y3 + ... + x1*yn)] -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use ConstantsModule, only: DZERO, DHALF ! -- dummy @@ -335,13 +365,18 @@ function get_area(this) result(area) integer(I4B) :: ivert integer(I4B) :: nvert integer(I4B) :: icount + integer(I4B) :: iv1 real(DP) :: x real(DP) :: y -! ------------------------------------------------------------------------------ + real(DP) :: x1 + real(DP) :: y1 ! area = DZERO nvert = this%iavert(this%j + 1) - this%iavert(this%j) icount = 1 + iv1 = this%javert(this%iavert(this%j)) + x1 = this%vertex_grid(1, iv1) + y1 = this%vertex_grid(2, iv1) do ivert = this%iavert(this%j), this%iavert(this%j + 1) - 1 x = this%vertex_grid(1, this%javert(ivert)) if (icount < nvert) then @@ -349,7 +384,7 @@ function get_area(this) result(area) else y = this%vertex_grid(2, this%javert(this%iavert(this%j))) end if - area = area + x * y + area = area + (x - x1) * (y - y1) icount = icount + 1 end do ! @@ -361,114 +396,116 @@ function get_area(this) result(area) else x = this%vertex_grid(1, this%javert(this%iavert(this%j))) end if - area = area - x * y + area = area - (x - x1) * (y - y1) icount = icount + 1 end do ! area = abs(area) * DHALF ! - ! -- return + ! -- Return return end function get_area + !> @brief Calculate the angle that the x-axis makes with a line that is + !! normal to the two points. + !! + !! This assumes that vertices are numbered clockwise so that the angle is for + !! the normal outward of cell n. + !< function anglex(x1, y1, x2, y2) result(ax) -! ****************************************************************************** -! anglex -- Calculate the angle that the x-axis makes with a line that is -! normal to the two points. This assumes that vertices are numbered -! clockwise so that the angle is for the normal outward of cell n. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DZERO, DTWO, DPI + ! -- dummy real(DP), intent(in) :: x1 real(DP), intent(in) :: x2 real(DP), intent(in) :: y1 real(DP), intent(in) :: y2 + ! -- return real(DP) :: ax + ! -- local real(DP) :: dx real(DP) :: dy -! ------------------------------------------------------------------------------ + ! dx = x2 - x1 dy = y2 - y1 ax = atan2(dx, -dy) if (ax < DZERO) ax = DTWO * DPI + ax + ! + ! -- Return return end function anglex + !> @brief Calculate distance between two points + !< function distance(x1, y1, x2, y2) result(d) -! ****************************************************************************** -! distance -- Calculate distance between two points -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy real(DP), intent(in) :: x1 real(DP), intent(in) :: x2 real(DP), intent(in) :: y1 real(DP), intent(in) :: y2 + ! -- return real(DP) :: d -! ------------------------------------------------------------------------------ + ! d = (x1 - x2)**2 + (y1 - y2)**2 d = sqrt(d) + ! + ! -- Return return end function distance + !> @brief Calculate normal distance from point (x0, y0) to line defined by + !! two points, (x1, y1), (x2, y2). + !< function distance_normal(x0, y0, x1, y1, x2, y2) result(d) -! ****************************************************************************** -! distance_normal -- Calculate normal distance from point (x0, y0) to line -! defined by two points, (x1, y1), (x2, y2) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy real(DP), intent(in) :: x0 real(DP), intent(in) :: y0 real(DP), intent(in) :: x1 real(DP), intent(in) :: y1 real(DP), intent(in) :: x2 real(DP), intent(in) :: y2 + ! -- return real(DP) :: d -! ------------------------------------------------------------------------------ + ! d = abs((x2 - x1) * (y1 - y0) - (x1 - x0) * (y2 - y1)) d = d / distance(x1, y1, x2, y2) + ! + ! -- Return return end function distance_normal + !> @brief Calculate the normal vector components (xcomp and ycomp) for a line + !! defined by two points, (x0, y0), (x1, y1). + !< subroutine line_unit_normal(x0, y0, x1, y1, xcomp, ycomp) -! ****************************************************************************** -! line_unit_normal -- Calculate the normal vector components (xcomp and ycomp) -! for a line defined by two points, (x0, y0), (x1, y1) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy real(DP), intent(in) :: x0 real(DP), intent(in) :: y0 real(DP), intent(in) :: x1 real(DP), intent(in) :: y1 real(DP), intent(out) :: xcomp real(DP), intent(out) :: ycomp + ! -- local real(DP) :: dx, dy, vmag -! ------------------------------------------------------------------------------ + ! dx = x1 - x0 dy = y1 - y0 vmag = sqrt(dx**2 + dy**2) xcomp = -dy / vmag ycomp = dx / vmag + ! + ! -- Return return end subroutine line_unit_normal + !> @brief Calculate the vector components (xcomp, ycomp, and zcomp) for a + !! line defined by two points, (x0, y0, z0), (x1, y1, z1). + !! + !! Also return the magnitude of the original vector, vmag. + !< subroutine line_unit_vector(x0, y0, z0, x1, y1, z1, & xcomp, ycomp, zcomp, vmag) -! ****************************************************************************** -! line_unit_vector -- Calculate the vector components (xcomp, ycomp, and zcomp) -! for a line defined by two points, (x0, y0, z0), (x1, y1, z1). Also return -! the magnitude of the original vector, vmag. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy real(DP), intent(in) :: x0 real(DP), intent(in) :: y0 real(DP), intent(in) :: z0 @@ -478,8 +515,10 @@ subroutine line_unit_vector(x0, y0, z0, x1, y1, z1, & real(DP), intent(out) :: xcomp real(DP), intent(out) :: ycomp real(DP), intent(out) :: zcomp - real(DP) :: dx, dy, dz, vmag -! ------------------------------------------------------------------------------ + real(DP) :: vmag + ! -- local + real(DP) :: dx, dy, dz + ! dx = x1 - x0 dy = y1 - y0 dz = z1 - z0 @@ -487,6 +526,8 @@ subroutine line_unit_vector(x0, y0, z0, x1, y1, z1, & xcomp = dx / vmag ycomp = dy / vmag zcomp = dz / vmag + ! + ! -- Return return end subroutine line_unit_vector diff --git a/src/Model/ModelUtilities/FlowModelInterface.f90 b/src/Model/ModelUtilities/FlowModelInterface.f90 new file mode 100644 index 00000000000..73b539a40af --- /dev/null +++ b/src/Model/ModelUtilities/FlowModelInterface.f90 @@ -0,0 +1,983 @@ +module FlowModelInterfaceModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DONE, DZERO, DHALF, LINELENGTH, LENBUDTXT, & + LENPACKAGENAME, LENVARNAME + use SimModule, only: store_error, store_error_unit + use SimVariablesModule, only: errmsg + use NumericalPackageModule, only: NumericalPackageType + use BaseDisModule, only: DisBaseType + use ListModule, only: ListType + use BudgetFileReaderModule, only: BudgetFileReaderType + use HeadFileReaderModule, only: HeadFileReaderType + use PackageBudgetModule, only: PackageBudgetType + use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr_bfr + + implicit none + private + public :: FlowModelInterfaceType + + type, extends(NumericalPackageType) :: FlowModelInterfaceType + + character(len=LENPACKAGENAME) :: text = '' !< text string for package + logical, pointer :: flows_from_file => null() !< if .false., then flows come from GWF through GWF-Model exg + type(ListType), pointer :: gwfbndlist => null() !< list of gwf stress packages + integer(I4B), pointer :: iflowsupdated => null() !< flows were updated for this time step + integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to Model ibound + real(DP), dimension(:), pointer, contiguous :: gwfflowja => null() !< pointer to the GWF flowja array + real(DP), dimension(:, :), pointer, contiguous :: gwfspdis => null() !< pointer to npf specific discharge array + real(DP), dimension(:), pointer, contiguous :: gwfhead => null() !< pointer to the GWF head array + real(DP), dimension(:), pointer, contiguous :: gwfsat => null() !< pointer to the GWF saturation array + integer(I4B), dimension(:), pointer, contiguous :: ibdgwfsat0 => null() !< mark cells with saturation = 0 to exclude from dispersion + real(DP), dimension(:), pointer, contiguous :: gwfstrgss => null() !< pointer to flow model QSTOSS + real(DP), dimension(:), pointer, contiguous :: gwfstrgsy => null() !< pointer to flow model QSTOSY + integer(I4B), pointer :: igwfstrgss => null() !< indicates if gwfstrgss is available + integer(I4B), pointer :: igwfstrgsy => null() !< indicates if gwfstrgsy is available + integer(I4B), pointer :: iubud => null() !< unit number GWF budget file + integer(I4B), pointer :: iuhds => null() !< unit number GWF head file + integer(I4B), pointer :: iumvr => null() !< unit number GWF mover budget file + integer(I4B), pointer :: nflowpack => null() !< number of GWF flow packages + integer(I4B), dimension(:), pointer, contiguous :: igwfmvrterm => null() !< flag to indicate that gwf package is a mover term + type(BudgetFileReaderType) :: bfr !< budget file reader + type(HeadFileReaderType) :: hfr !< head file reader + type(PackageBudgetType), dimension(:), allocatable :: gwfpackages !< used to get flows between a package and gwf + type(BudgetObjectType), pointer :: mvrbudobj => null() !< pointer to the mover budget budget object + character(len=16), dimension(:), allocatable :: flowpacknamearray !< array of boundary package names (e.g. LAK-1, SFR-3, etc.) + character(len=LENVARNAME) :: depvartype = '' + + contains + + procedure :: advance_bfr + procedure :: advance_hfr + procedure :: allocate_arrays + procedure :: allocate_gwfpackages + procedure :: allocate_scalars + procedure :: deallocate_gwfpackages + procedure :: finalize_bfr + procedure :: finalize_hfr + procedure :: fmi_ar + procedure :: fmi_da + procedure :: fmi_df + procedure :: get_package_index + procedure :: initialize_bfr + procedure :: initialize_gwfterms_from_bfr + procedure :: initialize_gwfterms_from_gwfbndlist + procedure :: initialize_hfr + procedure :: read_options + procedure :: read_packagedata + + end type FlowModelInterfaceType + +contains + + !> @brief Define the flow model interface + !< + subroutine fmi_df(this, dis) + ! -- modules + use SimModule, only: store_error + ! -- dummy + class(FlowModelInterfaceType) :: this + class(DisBaseType), pointer, intent(in) :: dis + ! -- formats + character(len=*), parameter :: fmtfmi = & + "(1x,/1x,'FMI -- FLOW MODEL INTERFACE, VERSION 2, 8/17/2023', & + &' INPUT READ FROM UNIT ', i0, //)" + character(len=*), parameter :: fmtfmi0 = & + "(1x,/1x,'FMI -- FLOW MODEL INTERFACE,'& + &' VERSION 2, 8/17/2023')" + + ! --print a message identifying the FMI package. + if (this%iout > 0) then + if (this%inunit /= 0) then + write (this%iout, fmtfmi) this%inunit + else + write (this%iout, fmtfmi0) + if (this%flows_from_file) then + write (this%iout, '(a)') ' FLOWS ARE ASSUMED TO BE ZERO.' + else + write (this%iout, '(a)') ' FLOWS PROVIDED BY A GWF MODEL IN THIS & + &SIMULATION' + end if + end if + end if + ! + ! -- Store pointers + this%dis => dis + ! + ! -- Read fmi options + if (this%inunit /= 0) then + call this%read_options() + end if + ! + ! -- Read packagedata options + if (this%inunit /= 0 .and. this%flows_from_file) then + call this%read_packagedata() + call this%initialize_gwfterms_from_bfr() + end if + ! + ! -- If GWF-Model exchange is active, setup flow terms + if (.not. this%flows_from_file) then + call this%initialize_gwfterms_from_gwfbndlist() + end if + ! + ! -- Return + return + end subroutine fmi_df + + !> @brief Allocate the package + !< + subroutine fmi_ar(this, ibound) + ! -- modules + use SimModule, only: store_error + ! -- dummy + class(FlowModelInterfaceType) :: this + integer(I4B), dimension(:), pointer, contiguous :: ibound + ! + ! -- store pointers to arguments that were passed in + this%ibound => ibound + ! + ! -- Allocate arrays + call this%allocate_arrays(this%dis%nodes) + ! + ! -- Return + return + end subroutine fmi_ar + + !> @brief Deallocate variables + !< + subroutine fmi_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- todo: finalize hfr and bfr either here or in a finalize routine + ! + ! -- deallocate any memory stored with gwfpackages + call this%deallocate_gwfpackages() + ! + ! -- deallocate fmi arrays + deallocate (this%gwfpackages) + deallocate (this%flowpacknamearray) + call mem_deallocate(this%igwfmvrterm) + call mem_deallocate(this%ibdgwfsat0) + ! + if (this%flows_from_file) then + call mem_deallocate(this%gwfstrgss) + call mem_deallocate(this%gwfstrgsy) + end if + ! + ! -- special treatment, these could be from mem_checkin + call mem_deallocate(this%gwfhead, 'GWFHEAD', this%memoryPath) + call mem_deallocate(this%gwfsat, 'GWFSAT', this%memoryPath) + call mem_deallocate(this%gwfspdis, 'GWFSPDIS', this%memoryPath) + call mem_deallocate(this%gwfflowja, 'GWFFLOWJA', this%memoryPath) + ! + ! -- deallocate scalars + call mem_deallocate(this%flows_from_file) + call mem_deallocate(this%iflowsupdated) + call mem_deallocate(this%igwfstrgss) + call mem_deallocate(this%igwfstrgsy) + call mem_deallocate(this%iubud) + call mem_deallocate(this%iuhds) + call mem_deallocate(this%iumvr) + call mem_deallocate(this%nflowpack) + ! + ! -- deallocate parent + call this%NumericalPackageType%da() + ! + ! -- Return + return + end subroutine fmi_da + + !> @brief Allocate scalars + !< + subroutine allocate_scalars(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + ! + ! -- allocate scalars in NumericalPackageType + call this%NumericalPackageType%allocate_scalars() + ! + ! -- Allocate + call mem_allocate(this%flows_from_file, 'FLOWS_FROM_FILE', this%memoryPath) + call mem_allocate(this%iflowsupdated, 'IFLOWSUPDATED', this%memoryPath) + call mem_allocate(this%igwfstrgss, 'IGWFSTRGSS', this%memoryPath) + call mem_allocate(this%igwfstrgsy, 'IGWFSTRGSY', this%memoryPath) + call mem_allocate(this%iubud, 'IUBUD', this%memoryPath) + call mem_allocate(this%iuhds, 'IUHDS', this%memoryPath) + call mem_allocate(this%iumvr, 'IUMVR', this%memoryPath) + call mem_allocate(this%nflowpack, 'NFLOWPACK', this%memoryPath) + ! + ! ! + ! -- Initialize + this%flows_from_file = .true. + this%iflowsupdated = 1 + this%igwfstrgss = 0 + this%igwfstrgsy = 0 + this%iubud = 0 + this%iuhds = 0 + this%iumvr = 0 + this%nflowpack = 0 + ! + ! -- Return + return + end subroutine allocate_scalars + + !> @brief Allocate arrays + !< + subroutine allocate_arrays(this, nodes) + use MemoryManagerModule, only: mem_allocate + !modules + use ConstantsModule, only: DZERO + ! -- dummy + class(FlowModelInterfaceType) :: this + integer(I4B), intent(in) :: nodes + ! -- local + integer(I4B) :: n + ! + ! -- Allocate ibdgwfsat0, which is an indicator array marking cells with + ! saturation greater than 0.0 with a value of 1 + call mem_allocate(this%ibdgwfsat0, nodes, 'IBDGWFSAT0', this%memoryPath) + do n = 1, nodes + this%ibdgwfsat0(n) = 1 + end do + ! + ! -- Allocate differently depending on whether or not flows are + ! being read from a file. + if (this%flows_from_file) then + call mem_allocate(this%gwfflowja, this%dis%con%nja, & + 'GWFFLOWJA', this%memoryPath) + call mem_allocate(this%gwfsat, nodes, 'GWFSAT', this%memoryPath) + call mem_allocate(this%gwfhead, nodes, 'GWFHEAD', this%memoryPath) + call mem_allocate(this%gwfspdis, 3, nodes, 'GWFSPDIS', this%memoryPath) + do n = 1, nodes + this%gwfsat(n) = DONE + this%gwfhead(n) = DZERO + this%gwfspdis(:, n) = DZERO + end do + do n = 1, size(this%gwfflowja) + this%gwfflowja(n) = DZERO + end do + ! + ! -- allocate and initialize storage arrays + if (this%igwfstrgss == 0) then + call mem_allocate(this%gwfstrgss, 1, 'GWFSTRGSS', this%memoryPath) + else + call mem_allocate(this%gwfstrgss, nodes, 'GWFSTRGSS', this%memoryPath) + end if + if (this%igwfstrgsy == 0) then + call mem_allocate(this%gwfstrgsy, 1, 'GWFSTRGSY', this%memoryPath) + else + call mem_allocate(this%gwfstrgsy, nodes, 'GWFSTRGSY', this%memoryPath) + end if + do n = 1, size(this%gwfstrgss) + this%gwfstrgss(n) = DZERO + end do + do n = 1, size(this%gwfstrgsy) + this%gwfstrgsy(n) = DZERO + end do + ! + ! -- If there is no fmi package, then there are no flows at all or a + ! connected GWF model, so allocate gwfpackages to zero + if (this%inunit == 0) call this%allocate_gwfpackages(this%nflowpack) + end if + ! + ! -- Return + return + end subroutine allocate_arrays + + !> @brief Read options from input file + !< + subroutine read_options(this) + ! -- modules + use ConstantsModule, only: LINELENGTH, DEM6 + use InputOutputModule, only: getunit, openfile, urdaux + use SimModule, only: store_error, store_error_unit + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + character(len=LINELENGTH) :: keyword + integer(I4B) :: ierr + logical :: isfound, endOfBlock + ! + ! -- get options block + call this%parser%GetBlock('OPTIONS', isfound, ierr, blockRequired=.false., & + supportOpenClose=.true.) + ! + ! -- parse options block if detected + if (isfound) then + write (this%iout, '(1x,a)') 'PROCESSING FMI OPTIONS' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('SAVE_FLOWS') + this%ipakcb = -1 + case default + write (errmsg, '(a,3(1x,a))') & + 'UNKNOWN', trim(adjustl(this%text)), 'OPTION:', trim(keyword) + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end select + end do + write (this%iout, '(1x,a)') 'END OF FMI OPTIONS' + end if + ! + ! -- return + return + end subroutine read_options + + !> @brief Read packagedata block from input file + !< + subroutine read_packagedata(this) + ! -- modules + use OpenSpecModule, only: ACCESS, FORM + use ConstantsModule, only: LINELENGTH, DEM6, LENPACKAGENAME + use InputOutputModule, only: getunit, openfile, urdaux + use SimModule, only: store_error, store_error_unit + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + character(len=LINELENGTH) :: keyword, fname + integer(I4B) :: ierr + integer(I4B) :: inunit + integer(I4B) :: iapt + logical :: isfound, endOfBlock + logical :: blockrequired + logical :: exist + ! + ! -- initialize + iapt = 0 + blockrequired = .true. + ! + ! -- get options block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + blockRequired=blockRequired, & + supportOpenClose=.true.) + ! + ! -- parse options block if detected + if (isfound) then + write (this%iout, '(1x,a)') 'PROCESSING FMI PACKAGEDATA' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('GWFBUDGET') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFBUDGET KEYWORD MUST BE FOLLOWED BY '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inunit = getunit() + inquire (file=trim(fname), exist=exist) + if (.not. exist) then + call store_error('Could not find file '//trim(fname)) + call this%parser%StoreErrorUnit() + end if + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iubud = inunit + call this%initialize_bfr() + case ('GWFHEAD') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFHEAD KEYWORD MUST BE FOLLOWED BY '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inquire (file=trim(fname), exist=exist) + if (.not. exist) then + call store_error('Could not find file '//trim(fname)) + call this%parser%StoreErrorUnit() + end if + inunit = getunit() + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iuhds = inunit + call this%initialize_hfr() + case ('GWFMOVER') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFMOVER KEYWORD MUST BE FOLLOWED BY '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inunit = getunit() + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iumvr = inunit + call budgetobject_cr_bfr(this%mvrbudobj, 'MVT', this%iumvr, & ! kluge note: MVT? + this%iout) + call this%mvrbudobj%fill_from_bfr(this%dis, this%iout) + case default + write (errmsg, '(a,3(1x,a))') & + 'UNKNOWN', trim(adjustl(this%text)), 'PACKAGEDATA:', trim(keyword) + call store_error(errmsg) + end select + end do + write (this%iout, '(1x,a)') 'END OF FMI PACKAGEDATA' + end if + ! + ! -- return + return + end subroutine read_packagedata + + !> @brief Initialize the budget file reader + !< + subroutine initialize_bfr(this) + ! -- modules + class(FlowModelInterfaceType) :: this + ! -- dummy + integer(I4B) :: ncrbud + ! + ! -- Initialize the budget file reader + call this%bfr%initialize(this%iubud, this%iout, ncrbud) + ! + ! -- todo: need to run through the budget terms + ! and do some checking + end subroutine initialize_bfr + + !> @brief Advance the budget file reader + !! + !! Advance the budget file reader by reading the next chunk + !! of information for the current time step and stress period. + !! + !< + subroutine advance_bfr(this) + ! -- modules + use TdisModule, only: kstp, kper + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + logical :: success + integer(I4B) :: n + integer(I4B) :: ipos + integer(I4B) :: nu, nr + integer(I4B) :: ip, i + logical :: readnext + ! -- format + character(len=*), parameter :: fmtkstpkper = & + "(1x,/1x,'FMI READING BUDGET TERMS & + &FOR KSTP ', i0, ' KPER ', i0)" + character(len=*), parameter :: fmtbudkstpkper = & + "(1x,/1x, 'FMI SETTING BUDGET TERMS & + &FOR KSTP ', i0, ' AND KPER ', & + &i0, ' TO BUDGET FILE TERMS FROM & + &KSTP ', i0, ' AND KPER ', i0)" + ! + ! -- If the latest record read from the budget file is from a stress + ! -- period with only one time step, reuse that record (do not read a + ! -- new record) if the running model is still in that same stress period, + ! -- or if that record is the last one in the budget file. + readnext = .true. + if (kstp * kper > 1) then + if (this%bfr%kstp == 1) then + if (this%bfr%kpernext == kper + 1) then + readnext = .false. + else if (this%bfr%endoffile) then + readnext = .false. + end if + else if (this%bfr%endoffile) then + write (errmsg, '(4x,a)') 'REACHED END OF GWF BUDGET & + &FILE BEFORE READING SUFFICIENT BUDGET INFORMATION FOR THIS & + &GWT SIMULATION.' + call store_error(errmsg) + call store_error_unit(this%iubud) + end if + end if + ! + ! -- Read the next record + if (readnext) then + ! + ! -- Write the current time step and stress period + write (this%iout, fmtkstpkper) kstp, kper + ! + ! -- loop through the budget terms for this stress period + ! i is the counter for gwf flow packages + ip = 1 + do n = 1, this%bfr%nbudterms + call this%bfr%read_record(success, this%iout) + if (.not. success) then + write (errmsg, '(4x,a)') 'GWF BUDGET READ NOT SUCCESSFUL' + call store_error(errmsg) + call store_error_unit(this%iubud) + end if + ! + ! -- Ensure kper is same between model and budget file + if (kper /= this%bfr%kper) then + write (errmsg, '(4x,a)') 'PERIOD NUMBER IN BUDGET FILE & + &DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE & + &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN & + &STRESS PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL & + &TIME STEPS ONE-FOR-ONE IN THAT STRESS PERIOD.' + call store_error(errmsg) + call store_error_unit(this%iubud) + end if + ! + ! -- if budget file kstp > 1, then kstp must match + if (this%bfr%kstp > 1 .and. (kstp /= this%bfr%kstp)) then + write (errmsg, '(4x,a)') 'TIME STEP NUMBER IN BUDGET FILE & + &DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE & + &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS & + &PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS & + &ONE-FOR-ONE IN THAT STRESS PERIOD.' + call store_error(errmsg) + call store_error_unit(this%iubud) + end if + ! + ! -- parse based on the type of data, and compress all user node + ! numbers into reduced node numbers + select case (trim(adjustl(this%bfr%budtxt))) + case ('FLOW-JA-FACE') + ! + ! -- bfr%flowja contains only reduced connections so there is + ! a one-to-one match with this%gwfflowja + do ipos = 1, size(this%bfr%flowja) + this%gwfflowja(ipos) = this%bfr%flowja(ipos) + end do + case ('DATA-SPDIS') + do i = 1, this%bfr%nlist + nu = this%bfr%nodesrc(i) + nr = this%dis%get_nodenumber(nu, 0) + if (nr <= 0) cycle + this%gwfspdis(1, nr) = this%bfr%auxvar(1, i) + this%gwfspdis(2, nr) = this%bfr%auxvar(2, i) + this%gwfspdis(3, nr) = this%bfr%auxvar(3, i) + end do + case ('DATA-SAT') + do i = 1, this%bfr%nlist + nu = this%bfr%nodesrc(i) + nr = this%dis%get_nodenumber(nu, 0) + if (nr <= 0) cycle + this%gwfsat(nr) = this%bfr%auxvar(1, i) + end do + case ('STO-SS') + do nu = 1, this%dis%nodesuser + nr = this%dis%get_nodenumber(nu, 0) + if (nr <= 0) cycle + this%gwfstrgss(nr) = this%bfr%flow(nu) + end do + case ('STO-SY') + do nu = 1, this%dis%nodesuser + nr = this%dis%get_nodenumber(nu, 0) + if (nr <= 0) cycle + this%gwfstrgsy(nr) = this%bfr%flow(nu) + end do + case default + call this%gwfpackages(ip)%copy_values( & + this%bfr%nlist, & + this%bfr%nodesrc, & + this%bfr%flow, & + this%bfr%auxvar) + do i = 1, this%gwfpackages(ip)%nbound + nu = this%gwfpackages(ip)%nodelist(i) + nr = this%dis%get_nodenumber(nu, 0) + this%gwfpackages(ip)%nodelist(i) = nr + end do + ip = ip + 1 + end select + end do + else + ! + ! -- write message to indicate that flows are being reused + write (this%iout, fmtbudkstpkper) kstp, kper, this%bfr%kstp, this%bfr%kper + ! + ! -- set the flag to indicate that flows were not updated + this%iflowsupdated = 0 + end if + end subroutine advance_bfr + + !> @brief Finalize the budget file reader + !< + subroutine finalize_bfr(this) + ! -- modules + class(FlowModelInterfaceType) :: this + ! -- dummy + ! + ! -- Finalize the budget file reader + call this%bfr%finalize() + ! + end subroutine finalize_bfr + + !> @brief Initialize the head file reader + !< + subroutine initialize_hfr(this) + ! -- modules + class(FlowModelInterfaceType) :: this + ! -- dummy + ! + ! -- Initialize the budget file reader + call this%hfr%initialize(this%iuhds, this%iout) + ! + ! -- todo: need to run through the head terms + ! and do some checking + end subroutine initialize_hfr + + !> @brief Advance the head file reader + !< + subroutine advance_hfr(this) + ! -- modules + use TdisModule, only: kstp, kper + class(FlowModelInterfaceType) :: this + integer(I4B) :: nu, nr, i, ilay + integer(I4B) :: ncpl + real(DP) :: val + logical :: readnext + logical :: success + character(len=*), parameter :: fmtkstpkper = & + "(1x,/1x,'FMI READING HEAD FOR & + &KSTP ', i0, ' KPER ', i0)" + character(len=*), parameter :: fmthdskstpkper = & + "(1x,/1x, 'FMI SETTING HEAD FOR KSTP ', i0, ' AND KPER ', & + &i0, ' TO BINARY FILE HEADS FROM KSTP ', i0, ' AND KPER ', i0)" + ! + ! -- If the latest record read from the head file is from a stress + ! -- period with only one time step, reuse that record (do not read a + ! -- new record) if the running model is still in that same stress period, + ! -- or if that record is the last one in the head file. + readnext = .true. + if (kstp * kper > 1) then + if (this%hfr%kstp == 1) then + if (this%hfr%kpernext == kper + 1) then + readnext = .false. + else if (this%hfr%endoffile) then + readnext = .false. + end if + else if (this%hfr%endoffile) then + write (errmsg, '(4x,a)') 'REACHED END OF GWF HEAD & + &FILE BEFORE READING SUFFICIENT HEAD INFORMATION FOR THIS & + &GWT SIMULATION.' + call store_error(errmsg) + call store_error_unit(this%iuhds) + end if + end if + ! + ! -- Read the next record + if (readnext) then + ! + ! -- write to list file that heads are being read + write (this%iout, fmtkstpkper) kstp, kper + ! + ! -- loop through the layered heads for this time step + do ilay = 1, this%hfr%nlay + ! + ! -- read next head chunk + call this%hfr%read_record(success, this%iout) + if (.not. success) then + write (errmsg, '(4x,a)') 'GWF HEAD READ NOT SUCCESSFUL' + call store_error(errmsg) + call store_error_unit(this%iuhds) + end if + ! + ! -- Ensure kper is same between model and head file + if (kper /= this%hfr%kper) then + write (errmsg, '(4x,a)') 'PERIOD NUMBER IN HEAD FILE & + &DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE & + &IS MORE THAN ONE TIME STEP IN THE HEAD FILE FOR A GIVEN STRESS & + &PERIOD, HEAD FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS & + &ONE-FOR-ONE IN THAT STRESS PERIOD.' + call store_error(errmsg) + call store_error_unit(this%iuhds) + end if + ! + ! -- if head file kstp > 1, then kstp must match + if (this%hfr%kstp > 1 .and. (kstp /= this%hfr%kstp)) then + write (errmsg, '(4x,a)') 'TIME STEP NUMBER IN HEAD FILE & + &DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE & + &IS MORE THAN ONE TIME STEP IN THE HEAD FILE FOR A GIVEN STRESS & + &PERIOD, HEAD FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS & + &ONE-FOR-ONE IN THAT STRESS PERIOD.' + call store_error(errmsg) + call store_error_unit(this%iuhds) + end if + ! + ! -- fill the head array for this layer and + ! compress into reduced form + ncpl = size(this%hfr%head) + do i = 1, ncpl + nu = (ilay - 1) * ncpl + i + nr = this%dis%get_nodenumber(nu, 0) + val = this%hfr%head(i) + if (nr > 0) this%gwfhead(nr) = val + end do + end do + else + write (this%iout, fmthdskstpkper) kstp, kper, this%hfr%kstp, this%hfr%kper + end if + end subroutine advance_hfr + + !> @brief Finalize the head file reader + !< + subroutine finalize_hfr(this) + ! -- modules + class(FlowModelInterfaceType) :: this + ! -- dummy + ! + ! -- Finalize the head file reader + close (this%iuhds) + ! + end subroutine finalize_hfr + + !> @brief Initialize gwf terms from budget file + !! + !! initalize terms and figure out how many + !! different terms and packages are contained within the file + !! + !< + subroutine initialize_gwfterms_from_bfr(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use SimModule, only: store_error, store_error_unit, count_errors + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + integer(I4B) :: nflowpack + integer(I4B) :: i, ip + integer(I4B) :: naux + logical :: found_flowja + logical :: found_dataspdis + logical :: found_datasat + logical :: found_stoss + logical :: found_stosy + integer(I4B), dimension(:), allocatable :: imap + ! + ! -- Calculate the number of gwf flow packages + allocate (imap(this%bfr%nbudterms)) + imap(:) = 0 + nflowpack = 0 + found_flowja = .false. + found_dataspdis = .false. + found_datasat = .false. + found_stoss = .false. + found_stosy = .false. + do i = 1, this%bfr%nbudterms + select case (trim(adjustl(this%bfr%budtxtarray(i)))) + case ('FLOW-JA-FACE') + found_flowja = .true. + case ('DATA-SPDIS') + found_dataspdis = .true. + case ('DATA-SAT') + found_datasat = .true. + case ('STO-SS') + found_stoss = .true. + this%igwfstrgss = 1 + case ('STO-SY') + found_stosy = .true. + this%igwfstrgsy = 1 + case default + nflowpack = nflowpack + 1 + imap(i) = 1 + end select + end do + ! + ! -- allocate gwfpackage arrays + call this%allocate_gwfpackages(nflowpack) + ! + ! -- Copy the package name and aux names from budget file reader + ! to the gwfpackages derived-type variable + ip = 1 + do i = 1, this%bfr%nbudterms + if (imap(i) == 0) cycle + call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), & + this%bfr%budtxtarray(i)) + naux = this%bfr%nauxarray(i) + call this%gwfpackages(ip)%set_auxname(naux, this%bfr%auxtxtarray(1:naux, i)) + ip = ip + 1 + end do + ! + ! -- Copy just the package names for the boundary packages into + ! the flowpacknamearray + ip = 1 + do i = 1, size(imap) + if (imap(i) == 1) then + this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i) + ip = ip + 1 + end if + end do + ! + ! -- Error if specific discharge, saturation or flowja not found + if (.not. found_dataspdis) then + write (errmsg, '(4x,a)') 'SPECIFIC DISCHARGE NOT FOUND IN & + &BUDGET FILE. SAVE_SPECIFIC_DISCHARGE AND & + &SAVE_FLOWS MUST BE ACTIVATED IN THE NPF PACKAGE.' + call store_error(errmsg) + end if + if (.not. found_datasat) then + write (errmsg, '(4x,a)') 'SATURATION NOT FOUND IN & + &BUDGET FILE. SAVE_SATURATION AND & + &SAVE_FLOWS MUST BE ACTIVATED IN THE NPF PACKAGE.' + call store_error(errmsg) + end if + if (.not. found_flowja) then + write (errmsg, '(4x,a)') 'FLOWJA NOT FOUND IN & + &BUDGET FILE. SAVE_FLOWS MUST & + &BE ACTIVATED IN THE NPF PACKAGE.' + call store_error(errmsg) + end if + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + ! + ! -- return + return + end subroutine initialize_gwfterms_from_bfr + + !> @brief Initialize gwf terms from a GWF exchange + !< + subroutine initialize_gwfterms_from_gwfbndlist(this) + ! -- modules + use BndModule, only: BndType, GetBndFromList + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + integer(I4B) :: ngwfpack + integer(I4B) :: ngwfterms + integer(I4B) :: ip + integer(I4B) :: imover + integer(I4B) :: ntomvr + integer(I4B) :: iterm + character(len=LENPACKAGENAME) :: budtxt + class(BndType), pointer :: packobj => null() + ! + ! -- determine size of gwf terms + ngwfpack = this%gwfbndlist%Count() + ! + ! -- Count number of to-mvr terms, but do not include advanced packages + ! as those mover terms are not losses from the cell, but rather flows + ! within the advanced package + ntomvr = 0 + do ip = 1, ngwfpack + packobj => GetBndFromList(this%gwfbndlist, ip) + imover = packobj%imover + if (packobj%isadvpak /= 0) imover = 0 + if (imover /= 0) then + ntomvr = ntomvr + 1 + end if + end do + ! + ! -- Allocate arrays in fmi of size ngwfterms, which is the number of + ! packages plus the number of packages with mover terms. + ngwfterms = ngwfpack + ntomvr + call this%allocate_gwfpackages(ngwfterms) + ! + ! -- Assign values in the fmi package + iterm = 1 + do ip = 1, ngwfpack + ! + ! -- set and store names + packobj => GetBndFromList(this%gwfbndlist, ip) + budtxt = adjustl(packobj%text) + call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) + this%flowpacknamearray(iterm) = packobj%packName + iterm = iterm + 1 + ! + ! -- if this package has a mover associated with it, then add another + ! term that corresponds to the mover flows + imover = packobj%imover + if (packobj%isadvpak /= 0) imover = 0 + if (imover /= 0) then + budtxt = trim(adjustl(packobj%text))//'-TO-MVR' + call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) + this%flowpacknamearray(iterm) = packobj%packName + this%igwfmvrterm(iterm) = 1 + iterm = iterm + 1 + end if + end do + return + end subroutine initialize_gwfterms_from_gwfbndlist + + !> @brief Allocate budget packages + !! + !! gwfpackages is an array of PackageBudget objects. + !! This routine allocates gwfpackages to the proper size and initializes some + !! member variables. + !< + subroutine allocate_gwfpackages(this, ngwfterms) + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_allocate + ! -- dummy + class(FlowModelInterfaceType) :: this + integer(I4B), intent(in) :: ngwfterms + ! -- local + integer(I4B) :: n + character(len=LENMEMPATH) :: memPath + ! + ! -- direct allocate + allocate (this%gwfpackages(ngwfterms)) + allocate (this%flowpacknamearray(ngwfterms)) + ! + ! -- mem_allocate + call mem_allocate(this%igwfmvrterm, ngwfterms, 'IGWFMVRTERM', this%memoryPath) + ! + ! -- initialize + this%nflowpack = ngwfterms + do n = 1, this%nflowpack + this%igwfmvrterm(n) = 0 + this%flowpacknamearray(n) = '' + ! + ! -- Create a mempath for each individual flow package data set + ! of the form, MODELNAME/FMI-FTn + write (memPath, '(a, i0)') trim(this%memoryPath)//'-FT', n + call this%gwfpackages(n)%initialize(memPath) + end do + ! + ! -- return + return + end subroutine allocate_gwfpackages + + !> @brief Deallocate memory in the gwfpackages array + !< + subroutine deallocate_gwfpackages(this) + ! -- modules + ! -- dummy + class(FlowModelInterfaceType) :: this + ! -- local + integer(I4B) :: n + ! + ! -- initialize + do n = 1, this%nflowpack + call this%gwfpackages(n)%da() + end do + ! + ! -- return + return + end subroutine deallocate_gwfpackages + + !> @brief Find the package index for the package with the given name + !< + subroutine get_package_index(this, name, idx) + use BndModule, only: BndType, GetBndFromList + class(FlowModelInterfaceType) :: this + character(len=*), intent(in) :: name + integer(I4B), intent(inout) :: idx + ! -- local + integer(I4B) :: ip + ! + ! -- Look through all the packages and return the index with name + idx = 0 + do ip = 1, size(this%flowpacknamearray) + if (this%flowpacknamearray(ip) == name) then + idx = ip + exit + end if + end do + if (idx == 0) then + call store_error('Error in get_package_index. Could not find '//name, & + terminate=.TRUE.) + end if + ! + ! -- return + return + end subroutine get_package_index + +end module FlowModelInterfaceModule diff --git a/src/Model/ModelUtilities/GwtSpc.f90 b/src/Model/ModelUtilities/GwtSpc.f90 index 9b33f196e2d..0b0677afc91 100644 --- a/src/Model/ModelUtilities/GwtSpc.f90 +++ b/src/Model/ModelUtilities/GwtSpc.f90 @@ -117,7 +117,7 @@ subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow) ! ! -- Setup the time series manager call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, name_model, this%iout) ! ! -- read options call this%read_options() diff --git a/src/Model/ModelUtilities/ModelPackageInput.f90 b/src/Model/ModelUtilities/ModelPackageInput.f90 new file mode 100644 index 00000000000..09782fd08d8 --- /dev/null +++ b/src/Model/ModelUtilities/ModelPackageInput.f90 @@ -0,0 +1,99 @@ +!> @brief This module contains the ModelPackageInputModule +!! +!! Add an input model type to routines in this module +!! to integrate the Model with IDM. +!! +!< +module ModelPackageInputModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LENFTYPE, LENPACKAGETYPE + use SimModule, only: store_error, store_error_filename + use GwfModule, only: GWF_NBASEPKG, GWF_NMULTIPKG, & + GWF_BASEPKG, GWF_MULTIPKG + use GwtModule, only: GWT_NBASEPKG, GWT_NMULTIPKG, & + GWT_BASEPKG, GWT_MULTIPKG + + implicit none + private + public :: supported_model_packages + public :: multi_package_type + +contains + + !> @brief set supported package types for model + !! + !! Allocate a list of package types supported + !! by the model. Base packages should be listed + !! first as list determines load order. + !! + !< + subroutine supported_model_packages(mtype, pkgtypes, numpkgs) + ! -- modules + ! -- dummy + character(len=LENFTYPE), intent(in) :: mtype + character(len=LENPACKAGETYPE), dimension(:), allocatable, & + intent(inout) :: pkgtypes + integer(I4B), intent(inout) :: numpkgs + ! -- local + ! + select case (mtype) + case ('GWF6') + numpkgs = GWF_NBASEPKG + GWF_NMULTIPKG + allocate (pkgtypes(numpkgs)) + pkgtypes = [GWF_BASEPKG, GWF_MULTIPKG] + ! + case ('GWT6') + numpkgs = GWT_NBASEPKG + GWT_NMULTIPKG + allocate (pkgtypes(numpkgs)) + pkgtypes = [GWT_BASEPKG, GWT_MULTIPKG] + ! + case default + end select + ! + ! -- return + return + end subroutine supported_model_packages + + !> @brief Is the package multi-instance + !< + function multi_package_type(mtype_component, ptype_component, pkgtype) & + result(multi_package) + ! -- modules + ! -- dummy + character(len=LENFTYPE), intent(in) :: mtype_component + character(len=LENFTYPE), intent(in) :: ptype_component + character(len=LENFTYPE), intent(in) :: pkgtype + ! -- return + logical(LGP) :: multi_package + ! -- local + integer(I4B) :: n + ! + multi_package = .false. + ! + select case (mtype_component) + case ('GWF') + do n = 1, GWF_NMULTIPKG + if (GWF_MULTIPKG(n) == pkgtype) then + multi_package = .true. + exit + end if + end do + ! + case ('GWT') + do n = 1, GWT_NMULTIPKG + if (GWT_MULTIPKG(n) == pkgtype) then + multi_package = .true. + exit + end if + end do + ! + case default + end select + ! + ! -- return + return + end function multi_package_type + +end module ModelPackageInputModule diff --git a/src/Model/ModelUtilities/Mover.f90 b/src/Model/ModelUtilities/Mover.f90 index 64d52ce1a8c..1e560c036ad 100644 --- a/src/Model/ModelUtilities/Mover.f90 +++ b/src/Model/ModelUtilities/Mover.f90 @@ -6,7 +6,7 @@ !< module MvrModule - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LENMODELNAME, LINELENGTH, LENBUDTXT, & LENAUXNAME, LENBOUNDNAME, DZERO, DONE, & LENMEMPATH @@ -27,12 +27,15 @@ module MvrModule !! !< type MvrType - character(len=LENMEMPATH) :: pckNameSrc = '' !< provider package name - character(len=LENMEMPATH) :: pckNameTgt = '' !< receiver package name + character(len=LENMEMPATH) :: mem_path_src = '' !< provider package name + character(len=LENMEMPATH) :: mem_path_tgt = '' !< receiver package name integer(I4B), pointer :: iRchNrSrc => null() !< provider reach number + integer(I4B) :: iRchNrSrcMapped !< mapped provider reach number (currently for lake outlet) integer(I4B), pointer :: iRchNrTgt => null() !< receiver reach number integer(I4B), pointer :: imvrtype => null() !< mover type (1, 2, 3, 4) corresponds to mvrtypes real(DP), pointer :: value => null() !< factor or rate depending on mvrtype + logical(LGP) :: is_provider_active = .true. + logical(LGP) :: is_receiver_active = .true. real(DP) :: qpactual = DZERO !< rate provided to the receiver real(DP) :: qavailable = DZERO !< rate available at time of providing real(DP), pointer :: qtformvr_ptr => null() !< pointer to total available flow (qtformvr) @@ -44,7 +47,8 @@ module MvrModule procedure :: prepare procedure :: echo procedure :: advance - procedure :: fc + procedure :: update_provider + procedure :: update_receiver procedure :: qrcalc procedure :: writeflow end type MvrType @@ -69,13 +73,16 @@ subroutine set_values(this, mname1, pname1, id1, mname2, pname2, & integer(I4B), intent(in), target :: imvrtype real(DP), intent(in), target :: value - this%pckNameSrc = create_mem_path(mname1, pname1) + this%mem_path_src = create_mem_path(mname1, pname1) this%iRchNrSrc => id1 - this%pckNameTgt = create_mem_path(mname2, pname2) + this%mem_path_tgt = create_mem_path(mname2, pname2) this%iRchNrTgt => id2 this%imvrtype => imvrtype this%value => value + ! to be set later + this%iRchNrSrcMapped = -1 + return end subroutine set_values @@ -102,10 +109,10 @@ subroutine prepare(this, inunit, pckMemPaths, pakmovers) integer(I4B) :: ipakloc1, ipakloc2 ! ! -- Check to make sure provider and receiver are not the same - if (this%pckNameSrc == this%pckNameTgt .and. & + if (this%mem_path_src == this%mem_path_tgt .and. & this%iRchNrSrc == this%iRchNrTgt) then call store_error('Provider and receiver are the same: '// & - trim(this%pckNameSrc)//' : '//trim(this%pckNameTgt)) + trim(this%mem_path_src)//' : '//trim(this%mem_path_tgt)) call store_error_unit(inunit) end if ! @@ -114,62 +121,68 @@ subroutine prepare(this, inunit, pckMemPaths, pakmovers) found = .false. ipakloc1 = 0 do i = 1, size(pckMemPaths) - if (this%pckNameSrc == pckMemPaths(i)) then + if (this%mem_path_src == pckMemPaths(i)) then found = .true. ipakloc1 = i exit end if end do if (.not. found) then - call store_error('Mover capability not activated in '//this%pckNameSrc) + call store_error('Mover capability not activated in '//this%mem_path_src) call store_error('Add "MOVER" keyword to package options block.') end if found = .false. ipakloc2 = 0 do i = 1, size(pckMemPaths) - if (this%pckNameTgt == pckMemPaths(i)) then + if (this%mem_path_tgt == pckMemPaths(i)) then found = .true. ipakloc2 = i exit end if end do if (.not. found) then - call store_error('Mover capability not activated in '//this%pckNameTgt) + call store_error('Mover capability not activated in '//this%mem_path_tgt) call store_error('Add "MOVER" keyword to package options block.') end if if (count_errors() > 0) then call store_error_unit(inunit) end if - ! - ! -- Set pointer to QTOMVR array in the provider boundary package - temp_ptr => pakmovers(ipakloc1)%qtomvr - if (this%iRchNrSrc < 1 .or. this%iRchNrSrc > size(temp_ptr)) then - call store_error('Provider ID < 1 or greater than package size ') - write (errmsg, '(a,i0,a,i0)') 'Provider ID = ', this%iRchNrSrc, & - '; Package size = ', size(temp_ptr) - call store_error(trim(errmsg)) - call store_error_unit(inunit) + + if (this%is_provider_active) then + ! + ! -- Set pointer to QTOMVR array in the provider boundary package + temp_ptr => pakmovers(ipakloc1)%qtomvr + if (this%iRchNrSrc < 1 .or. this%iRchNrSrc > size(temp_ptr)) then + call store_error('Provider ID < 1 or greater than package size ') + write (errmsg, '(a,i0,a,i0)') 'Provider ID = ', this%iRchNrSrc, & + '; Package size = ', size(temp_ptr) + call store_error(trim(errmsg)) + call store_error_unit(inunit) + end if + this%qtomvr_ptr => temp_ptr(this%iRchNrSrc) + ! + ! -- Set pointer to QFORMVR array in the provider boundary package + temp_ptr => pakmovers(ipakloc1)%qformvr + this%qformvr_ptr => temp_ptr(this%iRchNrSrc) + ! + ! -- Set pointer to QTFORMVR array in the provider boundary package + temp_ptr => pakmovers(ipakloc1)%qtformvr + this%qtformvr_ptr => temp_ptr(this%iRchNrSrc) end if - this%qtomvr_ptr => temp_ptr(this%iRchNrSrc) - ! - ! -- Set pointer to QFORMVR array in the provider boundary package - temp_ptr => pakmovers(ipakloc1)%qformvr - this%qformvr_ptr => temp_ptr(this%iRchNrSrc) - ! - ! -- Set pointer to QTFORMVR array in the provider boundary package - temp_ptr => pakmovers(ipakloc1)%qtformvr - this%qtformvr_ptr => temp_ptr(this%iRchNrSrc) - ! - ! -- Set pointer to QFROMMVR array in the receiver boundary package - temp_ptr => pakmovers(ipakloc2)%qfrommvr - if (this%iRchNrTgt < 1 .or. this%iRchNrTgt > size(temp_ptr)) then - call store_error('Receiver ID < 1 or greater than package size ') - write (errmsg, '(a,i0,a,i0)') 'Receiver ID = ', this%iRchNrTgt, & - '; package size = ', size(temp_ptr) - call store_error(trim(errmsg)) - call store_error_unit(inunit) + + if (this%is_receiver_active) then + ! + ! -- Set pointer to QFROMMVR array in the receiver boundary package + temp_ptr => pakmovers(ipakloc2)%qfrommvr + if (this%iRchNrTgt < 1 .or. this%iRchNrTgt > size(temp_ptr)) then + call store_error('Receiver ID < 1 or greater than package size ') + write (errmsg, '(a,i0,a,i0)') 'Receiver ID = ', this%iRchNrTgt, & + '; package size = ', size(temp_ptr) + call store_error(trim(errmsg)) + call store_error_unit(inunit) + end if + this%qfrommvr_ptr => temp_ptr(this%iRchNrTgt) end if - this%qfrommvr_ptr => temp_ptr(this%iRchNrTgt) ! ! -- return return @@ -187,9 +200,9 @@ subroutine echo(this, iout) integer(I4B), intent(in) :: iout !< unit number for output file ! -- local ! - write (iout, '(4x, a, a, a, i0)') 'FROM PACKAGE: ', trim(this%pckNameSrc), & + write (iout, '(4x, a, a, a, i0)') 'FROM PACKAGE: ', trim(this%mem_path_src), & ' FROM ID: ', this%iRchNrSrc - write (iout, '(4x, a, a, a, i0)') 'TO PACKAGE: ', trim(this%pckNameTgt), & + write (iout, '(4x, a, a, a, i0)') 'TO PACKAGE: ', trim(this%mem_path_tgt), & ' TO ID: ', this%iRchNrTgt write (iout, '(4x, a, a, a, 1pg15.6,/)') 'MOVER TYPE: ', & trim(mvrtypes(this%imvrtype)), ' ', this%value @@ -215,10 +228,10 @@ end subroutine advance !> @ brief Formulate coefficients !! - !! Make mover calculations. + !! Make mover calculations for provider. !! !< - subroutine fc(this) + subroutine update_provider(this) ! -- modules ! -- dummy class(MvrType) :: this !< MvrType @@ -237,10 +250,6 @@ subroutine fc(this) ! -- Store qpactual this%qpactual = qpactual ! - ! -- Add the calculated qpactual term directly into the receiver package - ! qfrommvr array. - this%qfrommvr_ptr = this%qfrommvr_ptr + qpactual - ! ! -- Add the calculated qpactual term directly into the provider package ! qtomvr array. this%qtomvr_ptr = this%qtomvr_ptr + qpactual @@ -251,7 +260,22 @@ subroutine fc(this) ! ! -- return return - end subroutine fc + end subroutine update_provider + + !> @ brief Formulate coefficients + !! + !! Make mover calculations for receiver. + !! + !< + subroutine update_receiver(this) + class(MvrType) :: this !< MvrType + ! -- Add the calculated qpactual term directly into the receiver package + ! qfrommvr array. + this%qfrommvr_ptr = this%qfrommvr_ptr + this%qpactual + ! + ! -- return + return + end subroutine update_receiver !> @ brief Flow to receiver !! @@ -319,8 +343,8 @@ subroutine writeflow(this, iout) "(1x, a, ' ID ', i0, ' AVAILABLE ', 1(1pg15.6), & &' PROVIDED ', 1(1pg15.6), ' TO ', a, ' ID ', i0)" ! - write (iout, fmt) trim(this%pckNameSrc), this%iRchNrSrc, this%qavailable, & - this%qpactual, trim(this%pckNameTgt), this%iRchNrTgt + write (iout, fmt) trim(this%mem_path_src), this%iRchNrSrc, this%qavailable, & + this%qpactual, trim(this%mem_path_tgt), this%iRchNrTgt ! ! -- return return diff --git a/src/Model/ModelUtilities/PackageMover.f90 b/src/Model/ModelUtilities/PackageMover.f90 index 98dc2a9c625..f8304460c1d 100644 --- a/src/Model/ModelUtilities/PackageMover.f90 +++ b/src/Model/ModelUtilities/PackageMover.f90 @@ -26,7 +26,7 @@ module PackageMoverModule contains procedure :: ar procedure :: ad - procedure :: cf + procedure :: reset procedure :: fc procedure :: da procedure :: allocate_scalars @@ -100,7 +100,7 @@ subroutine ad(this) return end subroutine ad - subroutine cf(this) + subroutine reset(this) class(PackageMoverType) :: this integer :: i ! @@ -116,7 +116,7 @@ subroutine cf(this) ! ! -- return return - end subroutine cf + end subroutine reset subroutine fc(this) class(PackageMoverType) :: this diff --git a/src/Model/ModelUtilities/GwtAdvOptions.f90 b/src/Model/ModelUtilities/TspAdvOptions.f90 similarity index 53% rename from src/Model/ModelUtilities/GwtAdvOptions.f90 rename to src/Model/ModelUtilities/TspAdvOptions.f90 index 4e724a745d0..08beb0e0d80 100644 --- a/src/Model/ModelUtilities/GwtAdvOptions.f90 +++ b/src/Model/ModelUtilities/TspAdvOptions.f90 @@ -1,10 +1,10 @@ -module GwtAdvOptionsModule +module TspAdvOptionsModule use KindModule, only: I4B implicit none private - type, public :: GwtAdvOptionsType + type, public :: TspAdvOptionsType integer(I4B) :: iAdvScheme !< the advection scheme: 0 = up, 1 = central, 2 = TVD - end type GwtAdvOptionsType + end type TspAdvOptionsType -end module GwtAdvOptionsModule +end module TspAdvOptionsModule diff --git a/src/Model/ModelUtilities/UzfCellGroup.f90 b/src/Model/ModelUtilities/UzfCellGroup.f90 index 5e8cc879535..91c0221ff4b 100644 --- a/src/Model/ModelUtilities/UzfCellGroup.f90 +++ b/src/Model/ModelUtilities/UzfCellGroup.f90 @@ -12,6 +12,7 @@ module UzfCellGroupModule public :: UzfCellGroupType type :: UzfCellGroupType + integer(I4B) :: imem_manager real(DP), pointer, dimension(:), contiguous :: thtr => null() real(DP), pointer, dimension(:), contiguous :: thts => null() @@ -53,7 +54,9 @@ module UzfCellGroupModule real(DP), pointer, dimension(:), contiguous :: gwpet => null() integer(I4B), pointer, dimension(:), contiguous :: landflag => null() integer(I4B), pointer, dimension(:), contiguous :: ivertcon => null() + contains + procedure :: init procedure :: setdata procedure :: sethead @@ -86,18 +89,12 @@ module UzfCellGroupModule procedure :: get_water_content_at_depth procedure :: get_wcnew end type UzfCellGroupType -! + contains -! -! ------------------------------------------------------------------------------ + !> @brief Allocate and set uzf object variables + !< subroutine init(this, ncells, nwav, memory_path) -! ****************************************************************************** -! init -- allocate and set uzf object variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -107,7 +104,6 @@ subroutine init(this, ncells, nwav, memory_path) character(len=*), intent(in), optional :: memory_path ! -- local integer(I4B) :: icell -! ------------------------------------------------------------------------------ ! ! -- Use mem_allocate if memory path is passed in, otherwise it's a temp object if (present(memory_path)) then @@ -238,23 +234,17 @@ subroutine init(this, ncells, nwav, memory_path) this%ivertcon(icell) = 0 end do ! - ! -- return + ! -- Return return end subroutine init + !> @brief Deallocate uzf object variables + !< subroutine dealloc(this) -! ****************************************************************************** -! dealloc -- deallocate uzf object variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(UzfCellGroupType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate based on whether or not memory manager was used if (this%imem_manager == 0) then @@ -341,19 +331,14 @@ subroutine dealloc(this) call mem_deallocate(this%ivertcon) end if ! - ! -- return + ! -- Return return end subroutine dealloc + !> @brief Set uzf object material properties + !< subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & thti, eps, ntrail, landflag, ivertcon) -! ****************************************************************************** -! setdata -- set uzf object material properties -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -369,7 +354,6 @@ subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & integer(I4B), intent(in) :: ntrail integer(I4B), intent(in) :: landflag integer(I4B), intent(in) :: ivertcon -! ------------------------------------------------------------------------------ ! ! -- set the values for uzf cell icell this%landflag(icell) = landflag @@ -396,19 +380,13 @@ subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & this%hroot(icell) = DZERO end subroutine setdata + !> @brief Set initial head for uzf object + !< subroutine sethead(this, icell, hgwf) -! ****************************************************************************** -! sethead -- set uzf object material properties -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: hgwf -! ------------------------------------------------------------------------------ ! ! -- set initial head this%watab(icell) = this%celbot(icell) @@ -416,22 +394,19 @@ subroutine sethead(this, icell, hgwf) if (this%watab(icell) > this%celtop(icell)) & this%watab(icell) = this%celtop(icell) this%watabold(icell) = this%watab(icell) + ! + ! -- Return + return end subroutine sethead + !> @brief Set infiltration + !< subroutine setdatafinf(this, icell, finf) -! ****************************************************************************** -! setdatafinf -- set infiltration -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: finf -! ------------------------------------------------------------------------------ + ! if (this%landflag(icell) == 1) then this%sinf(icell) = finf this%finf(icell) = finf @@ -442,39 +417,29 @@ subroutine setdatafinf(this, icell, finf) this%finf_rej(icell) = DZERO this%surflux(icell) = DZERO this%surfluxbelow(icell) = DZERO + ! + ! -- Return + return end subroutine setdatafinf + !> @brief Set uzfarea using cellarea and areamult + !< subroutine setdatauzfarea(this, icell, areamult) -! ****************************************************************************** -! setdatauzfarea -- set uzfarea using cellarea and areamult -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: areamult -! ------------------------------------------------------------------------------ ! ! -- set uzf area this%uzfarea(icell) = this%cellarea(icell) * areamult ! - ! -- return + ! -- Return return end subroutine setdatauzfarea -! ------------------------------------------------------------------------------ -! + !> @brief Set unsaturated ET-related variables + !< subroutine setdataet(this, icell, jbelow, pet, extdp) -! ****************************************************************************** -! setdataet -- set unsat. et variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -483,7 +448,7 @@ subroutine setdataet(this, icell, jbelow, pet, extdp) real(DP), intent(in) :: extdp ! -- local real(DP) :: thick -! ------------------------------------------------------------------------------ + ! if (this%landflag(icell) == 1) then this%pet(icell) = pet this%gwpet(icell) = pet @@ -515,18 +480,13 @@ subroutine setdataet(this, icell, jbelow, pet, extdp) this%petmax(jbelow) = this%petmax(icell) end if ! - ! -- return + ! -- Return return end subroutine setdataet + !> @brief Subtract aet from pet to calculate residual et for gw + !< subroutine setgwpet(this, icell) -! ****************************************************************************** -! setgwpet -- subtract aet from pet to calculate residual et for gw -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -534,7 +494,7 @@ subroutine setgwpet(this, icell) integer(I4B), intent(in) :: icell ! -- dummy real(DP) :: pet -! ------------------------------------------------------------------------------ + ! pet = DZERO ! ! -- reduce pet for gw by uzet @@ -542,18 +502,13 @@ subroutine setgwpet(this, icell) if (pet < DZERO) pet = DZERO this%gwpet(icell) = pet ! - ! -- return + ! -- Return return end subroutine setgwpet + !> @brief Subtract aet from pet to calculate residual et for deeper cells + !< subroutine setbelowpet(this, icell, jbelow) -! ****************************************************************************** -! setbelowpet -- subtract aet from pet to calculate residual et -! for deeper cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -562,7 +517,7 @@ subroutine setbelowpet(this, icell, jbelow) integer(I4B), intent(in) :: jbelow ! -- dummy real(DP) :: pet -! ------------------------------------------------------------------------------ + ! pet = DZERO ! ! -- transfer unmet pet to lower cell @@ -574,39 +529,30 @@ subroutine setbelowpet(this, icell, jbelow) end if this%pet(jbelow) = pet ! - ! -- return + ! -- Return return end subroutine setbelowpet + !> @brief Set extinction water content + !< subroutine setdataetwc(this, icell, jbelow, extwc) -! ****************************************************************************** -! setdataetwc -- set extinction water content -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell integer(I4B), intent(in) :: jbelow real(DP), intent(in) :: extwc -! ------------------------------------------------------------------------------ ! ! -- set extinction water content this%extwc(icell) = extwc if (jbelow > 0) this%extwc(jbelow) = extwc ! - ! -- return + ! -- Return return end subroutine setdataetwc + !> @brief Set variables for head-based unsaturated flow + !< subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) -! ****************************************************************************** -! setdataetha -- set variables for head-based unsat. flow -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -614,7 +560,6 @@ subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) real(DP), intent(in) :: ha real(DP), intent(in) :: hroot real(DP), intent(in) :: rootact -! ------------------------------------------------------------------------------ ! ! -- set variables this%ha(icell) = ha @@ -626,39 +571,30 @@ subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) this%rootact(jbelow) = rootact end if ! - ! -- return + ! -- Return return end subroutine setdataetha + !> @brief Set variables to advance to new time step. nothing yet. + !< subroutine advance(this, icell) -! ****************************************************************************** -! advance -- set variables to advance to new time step. nothing yet. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell -! ------------------------------------------------------------------------------ ! ! -- set variables this%surfseep(icell) = DZERO ! - ! -- return + ! -- Return return end subroutine advance + !> @brief Formulate the unsaturated flow object, calculate terms for gwf + !! equation + !< subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & issflag, iseepflag, hgwf, qfrommvr, ierr, & reset_state, trhs, thcof, deriv, watercontent) -! ****************************************************************************** -! formulate -- formulate the unsaturated flow object, calculate terms for -! gwf equation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -690,7 +626,6 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & real(DP) :: thcofseep real(DP) :: deriv1 real(DP) :: deriv2 -! ------------------------------------------------------------------------------ ! ! -- initialize variables totfluxtot = DZERO @@ -721,7 +656,7 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & if (reset_state) then call thiswork%wave_shift(this, 1, icell, 0, 1, this%nwavst(icell), 1) end if - + ! if (this%watab(icell) > this%celtop(icell)) & this%watab(icell) = this%celtop(icell) ! @@ -791,17 +726,13 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & call this%wave_shift(thiswork, icell, 1, 0, 1, thiswork%nwavst(1), 1) end if ! + ! -- Return return end subroutine solve + !> @brief Add recharge or infiltration to cells + !< subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) -! ****************************************************************************** -! addrech -- add recharge or infiltration to cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -814,7 +745,6 @@ subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) ! -- local real(DP) :: fcheck real(DP) :: x, scale, range -! ------------------------------------------------------------------------------ ! ! -- initialize range = DEM5 @@ -838,18 +768,13 @@ subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) this%totflux(icell) = scale * this%totflux(icell) + fcheck * delt trhs = this%uzfarea(icell) * this%totflux(icell) / delt ! - ! -- return + ! -- Return return end subroutine addrech + !> @brief Reject applied infiltration due to low vks + !< subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) -! ****************************************************************************** -! rejfinf -- reject applied infiltration due to low vks -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -860,7 +785,7 @@ subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) real(DP), intent(in) :: hgwf ! -- local real(DP) :: x, range, scale, q -! ------------------------------------------------------------------------------ + ! range = this%surfdep(icell) q = this%surflux(icell) finfact = q @@ -874,18 +799,13 @@ subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) thcof = finfact * this%uzfarea(icell) / range end if ! - ! -- return + ! -- Return return end subroutine rejfinf + !> @brief Calculate groudwater discharge to land surface + !< subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) -! ****************************************************************************** -! gwseep -- calc. groudwater discharge to land surface -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -897,7 +817,7 @@ subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) real(DP), intent(in) :: hgwf ! -- local real(DP) :: x, range, y, deriv1, d1, d2, Q -! ------------------------------------------------------------------------------ + ! seep = DZERO deriv = DZERO deriv1 = DZERO @@ -922,18 +842,13 @@ subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) thcof = DZERO end if ! - ! -- return + ! -- Return return end subroutine gwseep + !> @brief Calculate gwf et using residual uzf pet + !< subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) -! ****************************************************************************** -! simgwet -- calc. gwf et using residual uzf pet -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: igwetflag @@ -944,7 +859,6 @@ subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) real(DP), intent(inout) :: det ! -- local real(DP) :: s, x, c, b, et -! ------------------------------------------------------------------------------ ! this%gwet(icell) = DZERO trhs = DZERO @@ -962,26 +876,20 @@ subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) else if (igwetflag == 2) then et = etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) end if -! this%gwet(icell) = et * this%uzfarea(icell) + ! this%gwet(icell) = et * this%uzfarea(icell) trhs = trhs * this%uzfarea(icell) thcof = thcof * this%uzfarea(icell) this%gwet(icell) = trhs - (thcof * hgwf) - ! write(99,*)'in group', icell, this%gwet(icell) + ! write(99,*)'in group', icell, this%gwet(icell) ! - ! -- return + ! -- Return return end subroutine simgwet + !> @brief Calculate gwf et using linear ET function from mf-2005 + !< function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) -! ****************************************************************************** -! etfunc_lin -- calc. gwf et using linear ET function from mf-2005 -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: etfunc_lin ! -- dummy real(DP), intent(in) :: s @@ -997,7 +905,6 @@ function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) real(DP) :: etgw real(DP) :: range real(DP) :: depth, scale, thick -! ------------------------------------------------------------------------------ ! ! -- Between ET surface and extinction depth if (hgwf > (s - x) .and. hgwf < s) THEN @@ -1033,18 +940,14 @@ function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) det = -det * etgw etfunc_lin = etgw ! - ! -- return + ! -- Return return end function etfunc_lin + !> @brief Square-wave ET function with smoothing at extinction depth + !< function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) -! ****************************************************************************** -! etfunc_nlin -- Square-wave ET function with smoothing at extinction depth -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return + ! -- Return real(DP) :: etfunc_nlin ! -- dummy real(DP), intent(in) :: s @@ -1058,7 +961,7 @@ function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) real(DP) :: etgw real(DP) :: range real(DP) :: depth, scale -! ------------------------------------------------------------------------------ + ! depth = hgwf - (s - x) if (depth < DZERO) depth = DZERO etgw = c @@ -1069,24 +972,19 @@ function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) det = -det * etgw etfunc_nlin = etgw ! - ! -- return + ! -- Return return end function etfunc_nlin + !> @brief Calculate recharge due to a rise in the gwf head + !< subroutine uz_rise(this, icell, totfluxtot) -! ****************************************************************************** -! uz_rise -- calculate recharge due to a rise in the gwf head -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(inout) :: totfluxtot ! -- local real(DP) :: fm1, fm2, d1 -! ------------------------------------------------------------------------------ ! ! -- additional recharge from a rising water table if (this%watab(icell) - this%watabold(icell) > DEM30) then @@ -1097,17 +995,13 @@ subroutine uz_rise(this, icell, totfluxtot) totfluxtot = totfluxtot + (fm1 - fm2) end if ! - ! -- return + ! -- Return return end subroutine uz_rise + !> @brief Reset waves to default values at start of simulation + !< subroutine setwaves(this, icell) -! ****************************************************************************** -! setwaves -- reset waves to default values at start of simulation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this ! -- local @@ -1115,7 +1009,6 @@ subroutine setwaves(this, icell) real(DP) :: bottom, top integer(I4B) :: jk real(DP) :: thick -! ------------------------------------------------------------------------------ ! ! -- initialize this%totflux(icell) = DZERO @@ -1154,18 +1047,13 @@ subroutine setwaves(this, icell) this%uzthst(1, icell) = this%thtr(icell) end if ! - ! -- return + ! -- Return return end subroutine + !> @brief Prepare and route waves over time step + !< subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) -! ****************************************************************************** -! routewaves -- prepare and route waves over time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: totfluxtot @@ -1176,7 +1064,6 @@ subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) ! -- local real(DP) :: thick, thickold integer(I4B) :: idelt, iwav, ik -! ------------------------------------------------------------------------------ ! ! -- initialize this%totflux(icell) = DZERO @@ -1201,17 +1088,13 @@ subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) totfluxtot = totfluxtot + this%totflux(icell) end do ! - ! -- return + ! -- Return return end subroutine routewaves + !> @brief Copy waves or shift waves in arrays + !< subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) -! ****************************************************************************** -! wave_shift -- copy waves or shift waves in arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this type(UzfCellGroupType) :: this2 @@ -1223,7 +1106,6 @@ subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) integer(I4B), intent(in) :: cntr ! -- local integer(I4B) :: j -! ------------------------------------------------------------------------------ ! ! -- copy waves from one uzf cell group to another do j = strt, stp, cntr @@ -1234,17 +1116,13 @@ subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) end do this%nwavst(icell) = this2%nwavst(icell2) ! - ! -- return + ! -- Return return end subroutine + !> @brief Method of Characteristics solution for kinematic wave equation + !< subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) -! ****************************************************************************** -! uzflow -- moc solution for kinematic wave equation -! ****************************************************************************** -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: thickold @@ -1257,7 +1135,7 @@ subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) real(DP) :: ffcheck, time, feps1, feps2 real(DP) :: thetadif, thetab, fluxb, oldsflx integer(I4B) :: itrailflg, itester -! ------------------------------------------------------------------------------ + ! time = DZERO this%totflux(icell) = DZERO itrailflg = 0 @@ -1330,24 +1208,18 @@ subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) if (ietflag > 0) call this%uzet(icell, delt, ietflag, ierr) if (ierr > 0) return ! - ! -- return + ! -- Return return end subroutine uzflow + !> @brief Calculate unit specific tolerances + !< subroutine factors(feps1, feps2) -! ****************************************************************************** -! factors----calculate unit specific tolerances -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy real(DP), intent(out) :: feps1 real(DP), intent(out) :: feps2 real(DP) :: factor1 real(DP) :: factor2 -! ------------------------------------------------------------------------------ ! ! calculate constants for uzflow factor1 = DONE @@ -1367,18 +1239,13 @@ subroutine factors(feps1, feps2) feps1 = feps1 * factor1 * factor2 feps2 = feps2 * factor1 * factor2 ! - ! -- return + ! -- Return return end subroutine factors + !> @brief Create and set trail waves + !< subroutine trailwav(this, icell, ierr) -! ****************************************************************************** -! trailwav----create and set trail waves -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1389,7 +1256,6 @@ subroutine trailwav(this, icell, ierr) real(DP) :: flux1, flux2, theta1, theta2 real(DP) :: fnuminc integer(I4B) :: j, jj, jk, nwavstm1 -! ------------------------------------------------------------------------------ ! ! -- initialize eps_m1 = dble(this%eps(icell)) - DONE @@ -1462,19 +1328,14 @@ subroutine trailwav(this, icell, ierr) this%thtr(icell), this%eps(icell), this%vks(icell)) end if ! - ! -- return + ! -- Return return end subroutine trailwav + !> @brief Create a lead wave and route over time step + !< subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & ffcheck, feps2, delt, icell) -! ****************************************************************************** -! leadwav----create a lead wave and route over time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: thetab @@ -1495,7 +1356,7 @@ subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & integer(I4B) :: iflx, iremove, j, l integer(I4B) :: nwavp1, jshort integer(I4B), allocatable, dimension(:) :: more -! ------------------------------------------------------------------------------ + ! allocate (checktime(this%nwavst(icell))) allocate (more(this%nwavst(icell))) ftest = DZERO @@ -1671,19 +1532,14 @@ subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & deallocate (checktime) deallocate (more) ! - ! -- return + ! -- Return return end subroutine leadwav + !> @brief Calculates waves speed from dflux/dtheta + !< function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) -! ****************************************************************************** -! leadspeed----calculates waves speed from dflux/dtheta -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: leadspeed ! -- dummy real(DP), intent(in) :: theta1 @@ -1697,7 +1553,6 @@ function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) ! -- local real(DP) :: comp1, comp2, thsrinv, epsfksths real(DP) :: eps_m1, fhold, comp3 -! ------------------------------------------------------------------------------ ! eps_m1 = eps - DONE thsrinv = DONE / (thts - thtr) @@ -1715,19 +1570,14 @@ function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) end if if (leadspeed < DEM30) leadspeed = DEM30 ! - ! -- return + ! -- Return return end function leadspeed + !> @brief Sums up mobile water over depth interval + !< function unsat_stor(this, icell, d1) -! ****************************************************************************** -! unsat_stor---- sums up mobile water over depth interval -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: unsat_stor ! -- dummy class(UzfCellGroupType) :: this @@ -1736,7 +1586,7 @@ function unsat_stor(this, icell, d1) ! -- local real(DP) :: fm integer(I4B) :: j, k, nwavm1, jj -! ------------------------------------------------------------------------------ + ! fm = DZERO j = this%nwavst(icell) + 1 k = this%nwavst(icell) @@ -1766,16 +1616,14 @@ function unsat_stor(this, icell, d1) fm = fm + (this%uzthst(1, icell) - this%thtr(icell)) * d1 end if unsat_stor = fm + ! + ! -- Return + return end function unsat_stor + !> @brief Update to new state of uz at end of time step + !< subroutine update_wav(this, icell, delt, iss, itest) -! ****************************************************************************** -! update_wav -- update to new state of uz at end of time step -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1786,7 +1634,6 @@ subroutine update_wav(this, icell, delt, iss, itest) real(DP) :: bot, depthsave, top real(DP) :: thick, thtsrinv integer(I4B) :: nwavhld, k, j -! ------------------------------------------------------------------------------ ! bot = this%watab(icell) top = this%celtop(icell) @@ -1848,16 +1695,14 @@ subroutine update_wav(this, icell, delt, iss, itest) end if this%watabold(icell) = this%watab(icell) end if + ! + ! -- Return + return end subroutine update_wav + !> @brief Remove water from uz due to et + !< subroutine uzet(this, icell, delt, ietflag, ierr) -! ****************************************************************************** -! uzet -- remove water from uz due to et -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1894,7 +1739,6 @@ subroutine uzet(this, icell, delt, ietflag, ierr) integer(I4B) :: k integer(I4B) :: nwv integer(I4B) :: itest -! ------------------------------------------------------------------------------ ! ! -- initialize this%etact(icell) = DZERO @@ -2189,25 +2033,20 @@ subroutine uzet(this, icell, delt, ietflag, ierr) ! -- deallocate temporary worker call uzfktemp%dealloc() ! - ! -- return + ! -- Return return end subroutine uzet + !> @brief Calculate capillary pressure head from B-C equation + !< function caph(this, icell, tho) -! ****************************************************************************** -! caph---- calculate capillary pressure head from B-C equation -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: tho ! -- local real(DP) :: caph, lambda, star -! ------------------------------------------------------------------------------ + ! caph = -DEM6 star = (tho - this%thtr(icell)) / (this%thts(icell) - this%thtr(icell)) if (star < DEM15) star = DEM15 @@ -2219,37 +2058,45 @@ function caph(this, icell, tho) caph = DZERO end if end if + ! + ! -- Return + return end function caph + !> @brief Calculate capillary pressure-based uz et function rate_et_z(this, icell, factor, fktho, h) -! ****************************************************************************** -! rate_et_z---- capillary pressure based uz et -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: rate_et_z ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: factor, fktho, h - ! -- local -! ------------------------------------------------------------------------------ + ! rate_et_z = factor * fktho * (h - this%hroot(icell)) if (rate_et_z < DZERO) rate_et_z = DZERO + ! + ! -- Return + return end function rate_et_z + !> @brief Determine the water content at a specific depth + !! + !! Because UZF-calculated waves are internal to UZF objects, different water + !! contents exists at different depths. + !< function get_water_content_at_depth(this, icell, depth) result(theta_at_depth) + ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell !< uzf cell containing depth real(DP), intent(in) :: depth !< depth within the cell + ! -- return real(DP) :: theta_at_depth + ! -- local real(DP) :: d1 real(DP) :: d2 real(DP) :: f1 real(DP) :: f2 + ! if (this%watab(icell) < this%celtop(icell)) then if (this%celtop(icell) - depth > this%watab(icell)) then d1 = depth - DEM3 @@ -2263,14 +2110,20 @@ function get_water_content_at_depth(this, icell, depth) result(theta_at_depth) else theta_at_depth = this%thts(icell) end if + ! + ! -- Return return end function get_water_content_at_depth + !> @brief Calculate and return the cell-based water content value + !< function get_wcnew(this, icell) result(watercontent) + ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell !< uzf cell containing depth - ! + ! -- return real(DP) :: watercontent + ! -- local real(DP) :: top real(DP) :: bot real(DP) :: theta_r @@ -2292,6 +2145,8 @@ function get_wcnew(this, icell) result(watercontent) else watercontent = DZERO end if + ! + ! -- Return return end function get_wcnew diff --git a/src/Model/ModelUtilities/Xt3dAlgorithm.f90 b/src/Model/ModelUtilities/Xt3dAlgorithm.f90 index 19bbb70191e..3472f0b995a 100644 --- a/src/Model/ModelUtilities/Xt3dAlgorithm.f90 +++ b/src/Model/ModelUtilities/Xt3dAlgorithm.f90 @@ -9,52 +9,44 @@ module Xt3dAlgorithmModule contains + !> @brief Compute the "conductances" in the normal-flux expression for an + !! interface (modflow-usg version). The cell on one side of the interface is + !! "cell 0", and the one on the other side is "cell 1". + !! + !! nnbrmx = maximum number of neighbors allowed for a cell. + !! nnbr0 = number of neighbors (local connections) for cell 0. + !! inbr0 = array with the list of neighbors for cell 0. + !! il01 = local node number of cell 1 with respect to cell 0. + !! vc0 = array of connection unit-vectors for cell 0 with its neighbors. + !! vn0 = array of unit normal vectors for cell 0's interfaces. + !! dl0 = array of lengths contributed by cell 0 to its connections with its + !! neighbors. + !! dl0n = array of lengths contributed by cell 0's neighbors to their + !! connections with cell 0. + !! ck0 = conductivity tensor for cell 0. + !! nnbr1 = number of neighbors (local connections) for cell 1. + !! inbr1 = array with the list of neighbors for cell 1. + !! il10 = local node number of cell 0 with respect to cell 1. + !! vc1 = array of connection unit-vectors for cell 1 with its neighbors. + !! vn1 = array of unit normal vectors for cell 1's interfaces. + !! dl1 = array of lengths contributed by cell 1 to its connections with its + !! neighbors. + !! dl1n = array of lengths contributed by cell 1's neighbors to their + !! connections with cell 1. + !! ck1 = conductivity tensor for cell1. + !! ar01 = area of interface (0,1). + !! ar10 = area of interface (1,0). + !! chat01 = "conductance" for connection (0,1). + !! chati0 = array of "conductances" for connections of cell 0. + !! (zero for connection with cell 1, as this connection is + !! already covered by chat01.) + !! chat1j = array of "conductances" for connections of cell 1. + !! (zero for connection with cell 0., as this connection is + !! already covered by chat01.) + !< subroutine qconds(nnbrmx, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, ar01, ar10, & vcthresh, allhc0, allhc1, chat01, chati0, chat1j) -! ****************************************************************************** -! -!.....Compute the "conductances" in the normal-flux expression for an -! interface (modflow-usg version). The cell on one side of -! the interface is "cell 0", and the one on the other side is -! "cell 1". -! -! nnbrmx = maximum number of neighbors allowed for a cell. -! nnbr0 = number of neighbors (local connections) for cell 0. -! inbr0 = array with the list of neighbors for cell 0. -! il01 = local node number of cell 1 with respect to cell 0. -! vc0 = array of connection unit-vectors for cell 0 with its -! neighbors. -! vn0 = array of unit normal vectors for cell 0's interfaces. -! dl0 = array of lengths contributed by cell 0 to its -! connections with its neighbors. -! dl0n = array of lengths contributed by cell 0's neighbors to -! their connections with cell 0. -! ck0 = conductivity tensor for cell 0. -! nnbr1 = number of neighbors (local connections) for cell 1. -! inbr1 = array with the list of neighbors for cell 1. -! il10 = local node number of cell 0 with respect to cell 1. -! vc1 = array of connection unit-vectors for cell 1 with its -! neighbors. -! vn1 = array of unit normal vectors for cell 1's interfaces. -! dl1 = array of lengths contributed by cell 1 to its -! connections with its neighbors. -! dl1n = array of lengths contributed by cell 1's neighbors to -! their connections with cell 1. -! ck1 = conductivity tensor for cell1. -! ar01 = area of interface (0,1). -! ar10 = area of interface (1,0). -! chat01 = "conductance" for connection (0,1). -! chati0 = array of "conductances" for connections of cell 0. -! (zero for connection with cell 1, as this connection is -! already covered by chat01.) -! chat1j = array of "conductances" for connections of cell 1. -! (zero for connection with cell 0., as this connection is -! already covered by chat01.) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B) :: nnbrmx integer(I4B) :: nnbr0 @@ -91,31 +83,30 @@ subroutine qconds(nnbrmx, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & real(DP), dimension(nnbrmx) :: bhat0 real(DP), dimension(nnbrmx) :: bhat1 real(DP) :: denom -! ------------------------------------------------------------------------------ -! -!.....Set the global cell number for cell 1, as found in the neighbor -! list for cell 0. It is assumed that cells 0 and 1 are both -! active, or else this subroutine would not have been called. + ! + ! -- Set the global cell number for cell 1, as found in the neighbor list + ! for cell 0. It is assumed that cells 0 and 1 are both active, or else + ! this subroutine would not have been called. i1 = inbr0(il01) -! -!.....If area ar01 is zero (in which case ar10 is also zero, since -! this can only happen here in the case of Newton), then the -! "conductances" are all zero. + ! + ! -- If area ar01 is zero (in which case ar10 is also zero, since this can + ! only happen here in the case of Newton), then the "conductances" are + ! all zero. if (ar01 .eq. 0d0) then chat01 = 0d0 do i = 1, nnbrmx chati0(i) = 0d0 chat1j(i) = 0d0 end do -!.....Else compute "conductances." + ! -- Else compute "conductances." else -!........Compute contributions from cell 0. + ! -- Compute contributions from cell 0. call abhats(nnbrmx, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & vcthresh, allhc0, ar01, ahat0, bhat0) -!........Compute contributions from cell 1. + ! -- Compute contributions from cell 1. call abhats(nnbrmx, nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, & vcthresh, allhc1, ar10, ahat1, bhat1) -!........Compute "conductances" based on the two flux estimates. + ! -- Compute "conductances" based on the two flux estimates. denom = (ahat0 + ahat1) if (abs(denom) > DPREC) then wght1 = ahat0 / (ahat0 + ahat1) @@ -129,19 +120,15 @@ subroutine qconds(nnbrmx, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & chat1j(i) = wght1 * bhat1(i) end do end if -! + ! + ! -- Return return end subroutine qconds + !> @brief Compute "ahat" and "bhat" coefficients for one side of an interface + !< subroutine abhats(nnbrmx, nnbr, inbr, il01, vc, vn, dl0, dln, ck, & vcthresh, allhc, ar01, ahat, bhat) -! ****************************************************************************** -!.....Compute "ahat" and "bhat" coefficients for one side of an -! interface. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B) :: nnbrmx integer(I4B) :: nnbr @@ -179,45 +166,42 @@ subroutine abhats(nnbrmx, nnbr, inbr, il01, vc, vn, dl0, dln, ck, & real(DP) :: alphad real(DP) :: alphae real(DP) :: dl0il -! ------------------------------------------------------------------------------ -! -!.....Determine the basis vectors for local "(c, d, e)" coordinates -! associated with the connection between cells 0 and 1, and -! set the rotation matrix that transforms vectors from model -! coordinates to (c, d, e) coordinates. (If no active -! connection is found that has a non-negligible component -! perpendicular to the primary connection, ilmo=0 is returned.) + ! + ! -- Determine the basis vectors for local "(c, d, e)" coordinates + ! associated with the connection between cells 0 and 1, and set the + ! rotation matrix that transforms vectors from model coordinates to + ! (c, d, e) coordinates. (If no active connection is found that has a + ! non-negligible component perpendicular to the primary connection, + ! ilmo=0 is returned.) call getrot(nnbrmx, nnbr, inbr, vc, il01, rmat, iml0) -! -!.....If no active connection with a non-negligible perpendicular -! component, assume no perpendicular gradient and base gradient -! solely on the primary connection. Otherwise, proceed with -! basing weights on information from neighboring connections. + ! + ! -- If no active connection with a non-negligible perpendicular + ! component, assume no perpendicular gradient and base gradient solely + ! on the primary connection. Otherwise, proceed with basing weights on + ! information from neighboring connections. if (iml0 .eq. 0) then -! -!........Compute ahat and bhat coefficients assuming perpendicular -! components of gradient are zero. + ! + ! -- Compute ahat and bhat coefficients assuming perpendicular components + ! of gradient are zero. sigma(1) = dot_product(vn(il01, :), matmul(ck, rmat(:, 1))) ahat = sigma(1) / dl0(il01) bhat = 0d0 -! else -! -!........Transform local connection unit-vectors from model coordinates -! to "(c, d, e)" coordinates associated with the connection -! between cells 0 and 1. + ! + ! -- Transform local connection unit-vectors from model coordinates to + ! "(c, d, e)" coordinates associated with the connection between cells + ! 0 and 1. call tranvc(nnbrmx, nnbr, rmat, vc, vccde) -! -!........Get "a" and "b" weights for first perpendicular direction. + ! + ! -- Get "a" and "b" weights for first perpendicular direction. call abwts(nnbrmx, nnbr, inbr, il01, 2, vccde, & vcthresh, dl0, dln, acd, add, aed, bd) -! -!........If all neighboring connections are user-designated as -! horizontal, or if none have a non-negligible component in -! the second perpendicular direction, assume zero gradient in -! the second perpendicular direction. Otherwise, get "a" and -! "b" weights for second perpendicular direction based on -! neighboring connections. + ! + ! -- If all neighboring connections are user-designated as horizontal, or + ! if none have a non-negligible component in the second perpendicular + ! direction, assume zero gradient in the second perpendicular direction. + ! Otherwise, get "a" and "b" weights for second perpendicular direction + ! based on neighboring connections. if (allhc) then ace = 0d0 aee = 1d0 @@ -243,8 +227,8 @@ subroutine abhats(nnbrmx, nnbr, inbr, il01, vc, vn, dl0, dln, ck, & be = 0d0 end if end if -! -!........Compute alpha and beta coefficients. + ! + ! -- Compute alpha and beta coefficients. determ = add * aee - ade * aed oodet = 1d0 / determ alphad = (acd * aee - ace * aed) * oodet @@ -252,62 +236,57 @@ subroutine abhats(nnbrmx, nnbr, inbr, il01, vc, vn, dl0, dln, ck, & betad = 0d0 betae = 0d0 do il = 1, nnbr -!...........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il == il01) .or. (inbr(il) == 0)) cycle betad(il) = (bd(il) * aee - be(il) * aed) * oodet betae(il) = (be(il) * add - bd(il) * ade) * oodet end do -! -!........Compute sigma coefficients. + ! + ! -- Compute sigma coefficients. sigma = matmul(vn(il01, :), matmul(ck, rmat)) -! -!........Compute ahat and bhat coefficients. + ! + ! -- Compute ahat and bhat coefficients. ahat = (sigma(1) - sigma(2) * alphad - sigma(3) * alphae) / dl0(il01) bhat = 0d0 do il = 1, nnbr -!...........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il == il01) .or. (inbr(il) == 0)) cycle dl0il = dl0(il) + dln(il) bhat(il) = (sigma(2) * betad(il) + sigma(3) * betae(il)) / dl0il end do -!........Set the bhat for connection (0,1) to zero here, since we have -! been skipping it in our do loops to avoiding explicitly -! computing it. This will carry through to the corresponding -! chati0 and chat1j value, so that they too are zero. + ! -- Set the bhat for connection (0,1) to zero here, since we have been + ! skipping it in our do loops to avoiding explicitly computing it. + ! This will carry through to the corresponding chati0 and chat1j value, + ! so that they too are zero. bhat(il01) = 0d0 -! + ! end if -! -!.....Multiply by area. + ! + ! -- Multiply by area. ahat = ahat * ar01 bhat = bhat * ar01 -! + ! + ! -- Return return end subroutine abhats + !> @brief Compute the matrix that rotates the model-coordinate axes to the + !! "(c, d, e)-coordinate" axes associated with a connection. + !! + !! This is also the matrix that transforms the components of a vector + !! from (c, d, e) coordinates to model coordinates. [Its transpose + !! transforms from model to (c, d, e) coordinates.] + !! + !! vcc = unit vector for the primary connection, in model coordinates. + !! vcd = unit vector for the first perpendicular direction, in model + !! coordinates. + !! vce = unit vector for the second perpendicular direction, in model + !! coordinates. + !! vcmax = unit vector for the connection with the maximum component + !! perpendicular to the primary connection, in model coordinates. + !! rmat = rotation matrix from model to (c, d, e) coordinates. + !< subroutine getrot(nnbrmx, nnbr, inbr, vc, il01, rmat, iml0) -! ****************************************************************************** -!.....Compute the matrix that rotates the model-coordinate axes to -! the "(c, d, e)-coordinate" axes associated with a connection. -! This is also the matrix that transforms the components of a vector -! from (c, d, e) coordinates to model coordinates. [Its transpose -! transforms from model to (c, d, e) coordinates.] -! -! vcc = unit vector for the primary connection, in model -! coordinates. -! vcd = unit vector for the first perpendicular direction, -! in model coordinates. -! vce = unit vector for the second perpendicular direction, -! in model coordinates. -! vcmax = unit vector for the connection with the maximum -! component perpendicular to the primary connection, -! in model coordinates. -! rmat = rotation matrix from model to (c, d, e) coordinates. -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B) :: nnbrmx integer(I4B) :: nnbr @@ -326,15 +305,13 @@ subroutine getrot(nnbrmx, nnbr, inbr, vc, il01, rmat, iml0) real(DP) :: cmp real(DP) :: acmp real(DP) :: cmpmn -! ------------------------------------------------------------------------------ -! -!.....set vcc. + ! + ! -- Set vcc. vcc(:) = vc(il01, :) -! -!.....Set vcmax. (If no connection has a perpendicular component -! greater than some tiny threshold, return with iml0=0 and -! the first column of rmat set to vcc -- the other columns -! are not needed.) + ! + ! -- Set vcmax. (If no connection has a perpendicular component greater + ! than some tiny threshold, return with iml0=0 and the first column of + ! rmat set to vcc -- the other columns are not needed.) acmpmn = 1d0 - 1d-10 iml0 = 0 do il = 1, nnbr @@ -356,43 +333,37 @@ subroutine getrot(nnbrmx, nnbr, inbr, vc, il01, rmat, iml0) else vcmax(:) = vc(iml0, :) end if -! -!.....Set the first perpendicular direction as the direction that is -! coplanar with vcc and vcmax and perpendicular to vcc. + ! + ! -- Set the first perpendicular direction as the direction that is coplanar + ! with vcc and vcmax and perpendicular to vcc. vcd = vcmax - cmpmn * vcc vcd = vcd / dsqrt(1d0 - cmpmn * cmpmn) -! -!.....Set the second perpendicular direction as the cross product of -! the primary and first-perpendicular directions. + ! + ! -- Set the second perpendicular direction as the cross product of the + ! primary and first-perpendicular directions. vce(1) = vcc(2) * vcd(3) - vcc(3) * vcd(2) vce(2) = vcc(3) * vcd(1) - vcc(1) * vcd(3) vce(3) = vcc(1) * vcd(2) - vcc(2) * vcd(1) -! -!.....Set the rotation matrix as the matrix with vcc, vcd, and vce -! as its columns. + ! + ! -- Set the rotation matrix as the matrix with vcc, vcd, and vce as its + ! columns. rmat(:, 1) = vcc(:) rmat(:, 2) = vcd(:) rmat(:, 3) = vce(:) -! + ! + ! -- Return 999 return end subroutine getrot + !> @brief Transform local connection unit-vectors from model coordinates to + !! "(c, d, e)" coordinates associated with a connection. + !! + !! nnbrs = number of neighbors (local connections) + !! rmat = rotation matrix from (c, d, e) to model coordinates. + !! vc = array of connection unit-vectors with respect to model coordinates. + !! vccde = array of connection unit-vectors with respect to (c, d, e) + !! coordinates. subroutine tranvc(nnbrmx, nnbrs, rmat, vc, vccde) -! ****************************************************************************** -!.....Transform local connection unit-vectors from model coordinates -! to "(c, d, e)" coordinates associated with a connection. -! -! nnbrs = number of neighbors (local connections) -! rmat = rotation matrix from (c, d, e) to model coordinates. -! vc = array of connection unit-vectors with respect to model -! coordinates. -! vccde = array of connection unit-vectors with respect to -! (c, d, e) coordinates. -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B) :: nnbrmx integer(I4B) :: nnbrs @@ -401,39 +372,31 @@ subroutine tranvc(nnbrmx, nnbrs, rmat, vc, vccde) real(DP), dimension(nnbrmx, 3) :: vccde ! -- local integer(I4B) :: il -! ------------------------------------------------------------------------------ -! -!.....Loop over the local connections, transforming the unit vectors. -! Note that we are multiplying by the transpose of the -! rotation matrix so that the transformation is from model -! to (c, d, e) coordinates. + ! + ! -- Loop over the local connections, transforming the unit vectors. + ! Note that we are multiplying by the transpose of the rotation matrix + ! so that the transformation is from model to (c, d, e) coordinates. do il = 1, nnbrs vccde(il, :) = matmul(transpose(rmat), vc(il, :)) end do -! + ! + ! -- Return return end subroutine tranvc + !> @brief Compute "a" and "b" weights for the local connections with respect + !! to the perpendicular direction of primary interest. + !! + !! nde1 = number that indicates the perpendicular direction of primary + !! interest on this call: "d" (2) or "e" (3). + !! vccde = array of connection unit-vectors with respect to (c, d, e) + !! coordinates. + !! bd = array of "b" weights. + !! aed = "a" weight that goes on the matrix side of the 2x2 problem. + !! acd = "a" weight that goes on the right-hand side of the 2x2 problem. + !< subroutine abwts(nnbrmx, nnbr, inbr, il01, nde1, vccde, & vcthresh, dl0, dln, acd, add, aed, bd) -! ****************************************************************************** -!.....Compute "a" and "b" weights for the local connections with respect -! to the perpendicular direction of primary interest. -! -! nde1 = number that indicates the perpendicular direction of -! primary interest on this call: "d" (2) or "e" (3). -! vccde = array of connection unit-vectors with respect to -! (c, d, e) coordinates. -! bd = array of "b" weights. -! aed = "a" weight that goes on the matrix side of the 2x2 -! problem. -! acd = "a" weight that goes on the right-hand side of the -! 2x2 problem. -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy integer(I4B) :: nnbrmx integer(I4B) :: nnbr @@ -460,80 +423,79 @@ subroutine abwts(nnbrmx, nnbr, inbr, il01, nde1, vccde, & real(DP) :: oodsum real(DP) :: fatten real(DP), dimension(nnbrmx) :: omwt -! ------------------------------------------------------------------------------ -! -!.....Set the perpendicular direction of secondary interest. + ! + ! -- Set the perpendicular direction of secondary interest. nde2 = 5 - nde1 -! -!.....Begin computing "omega" weights. + ! + ! -- Begin computing "omega" weights. omwt = 0d0 dsum = 0d0 vcmx = 0d0 do il = 1, nnbr -!........if this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il .eq. il01) .or. (inbr(il) .eq. 0)) cycle vcmx = max(dabs(vccde(il, nde1)), vcmx) dlm = 5d-1 * (dl0(il) + dln(il)) -!...........Distance-based weighting. dl4wt is the distance between -! the point supplying the gradient information and the -! point at which the flux is being estimated. Could be -! coded as a special case of resistance-based weighting -! (by setting the conductivity matrix to be the identity -! matrix), but this is more efficient. + ! -- Distance-based weighting. dl4wt is the distance between the point + ! supplying the gradient information and the point at which the flux is + ! being estimated. Could be coded as a special case of resistance-based + ! weighting (by setting the conductivity matrix to be the identity + ! matrix), but this is more efficient. cosang = vccde(il, 1) dl4wt = dsqrt(dlm * dlm + dl0(il01) * dl0(il01) & - 2d0 * dlm * dl0(il01) * cosang) omwt(il) = dabs(vccde(il, nde1)) * dl4wt dsum = dsum + omwt(il) end do -! -!.....Finish computing non-normalized "omega" weights. [Add a -! tiny bit to dsum so that the normalized omega weight later -! evaluates to (essentially) 1 in the case of a single relevant -! connection, avoiding 0/0.] + ! + ! -- Finish computing non-normalized "omega" weights. [Add a tiny bit to + ! dsum so that the normalized omega weight later evaluates to + ! (essentially) 1 in the case of a single relevant connection, avoiding + ! 0/0.] dsum = dsum + 1d-10 * dsum do il = 1, nnbr -!........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il .eq. il01) .or. (inbr(il) .eq. 0)) cycle fact = dsum - omwt(il) omwt(il) = fact * dabs(vccde(il, nde1)) end do -! -!.....Compute "b" weights. + ! + ! -- Compute "b" weights. bd = 0d0 dsum = 0d0 do il = 1, nnbr -!........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il .eq. il01) .or. (inbr(il) .eq. 0)) cycle bd(il) = omwt(il) * sign(1d0, vccde(il, nde1)) dsum = dsum + omwt(il) * dabs(vccde(il, nde1)) end do + ! oodsum = 1d0 / dsum do il = 1, nnbr -!........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il .eq. il01) .or. (inbr(il) .eq. 0)) cycle bd(il) = bd(il) * oodsum end do -! -!.....Compute "a" weights. + ! + ! -- Compute "a" weights. add = 1d0 acd = 0d0 aed = 0d0 do il = 1, nnbr -!........If this is connection (0,1) or inactive, skip. + ! -- If this is connection (0,1) or inactive, skip. if ((il .eq. il01) .or. (inbr(il) .eq. 0)) cycle acd = acd + bd(il) * vccde(il, 1) aed = aed + bd(il) * vccde(il, nde2) end do -! -!.....Apply attenuation function to acd, aed, and bd. + ! + ! -- Apply attenuation function to acd, aed, and bd. if (vcmx .lt. vcthresh) then fatten = vcmx / vcthresh acd = acd * fatten aed = aed * fatten bd = bd * fatten end if -! + ! end subroutine abwts -! + end module Xt3dAlgorithmModule diff --git a/src/Model/ModelUtilities/Xt3dInterface.f90 b/src/Model/ModelUtilities/Xt3dInterface.f90 index df87f773fc3..f7ca17e1e81 100644 --- a/src/Model/ModelUtilities/Xt3dInterface.f90 +++ b/src/Model/ModelUtilities/Xt3dInterface.f90 @@ -11,6 +11,7 @@ module Xt3dModule public :: xt3d_cr type Xt3dType + character(len=LENMEMPATH) :: memoryPath !< location in memory manager for storing package variables integer(I4B), pointer :: inunit => null() !< unit number from where xt3d was read integer(I4B), pointer :: iout => null() !< unit number for output @@ -48,7 +49,9 @@ module Xt3dModule real(DP), dimension(:), pointer, contiguous :: angle2 => null() !< k ellipse rotation up from xy plane around y axis (pitch) real(DP), dimension(:), pointer, contiguous :: angle3 => null() !< k tensor rotation around x axis (roll) logical, pointer :: ldispersion => null() !< flag to indicate dispersion + contains + procedure :: xt3d_df procedure :: xt3d_ac procedure :: xt3d_mc @@ -76,30 +79,25 @@ module Xt3dModule procedure, private :: xt3d_rhs procedure, private :: xt3d_fillrmatck procedure, private :: xt3d_qnbrs + end type Xt3dType contains + !> @brief Create a new xt3d object + !< subroutine xt3d_cr(xt3dobj, name_model, inunit, iout, ldispopt) -! ****************************************************************************** -! xt3d_cr -- Create a new xt3d object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(Xt3dType), pointer :: xt3dobj character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout logical, optional, intent(in) :: ldispopt -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (xt3dobj) ! - - ! -- assign the memory path + ! -- Assign the memory path xt3dobj%memoryPath = create_mem_path(name_model, 'XT3D') ! ! -- Allocate scalars @@ -114,18 +112,12 @@ subroutine xt3d_cr(xt3dobj, name_model, inunit, iout, ldispopt) return end subroutine xt3d_cr + !> @brief Define the xt3d object + !< subroutine xt3d_df(this, dis) -! ****************************************************************************** -! xt3d_df -- define the xt3d object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(Xt3dType) :: this class(DisBaseType), pointer, intent(inout) :: dis -! ------------------------------------------------------------------------------ ! this%dis => dis ! @@ -133,13 +125,9 @@ subroutine xt3d_df(this, dis) return end subroutine xt3d_df + !> @brief Add connections for extended neighbors to the sparse matrix + !< subroutine xt3d_ac(this, moffset, sparse) -! ****************************************************************************** -! xt3d_ac -- Add connections for extended neighbors to the sparse matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SparseModule, only: sparsematrix use MemoryManagerModule, only: mem_allocate @@ -152,17 +140,15 @@ subroutine xt3d_ac(this, moffset, sparse) integer(I4B) :: i, j, k, jj, kk, iglo, kglo, iadded integer(I4B) :: nnz integer(I4B) :: ierror -! ------------------------------------------------------------------------------ ! ! -- If not rhs, add connections if (this%ixt3d == 1) then - - ! -- assume nnz is 19, which is an approximate value + ! -- Assume nnz is 19, which is an approximate value ! based on a 3d structured grid nnz = 19 call sparse_xt3d%init(this%dis%nodes, this%dis%nodes, nnz) - - ! -- loop over nodes and store extended xt3d neighbors + ! + ! -- Loop over nodes and store extended xt3d neighbors ! temporarily in sparse_xt3d; this will be converted to ! ia_xt3d and ja_xt3d next do i = 1, this%dis%nodes @@ -178,7 +164,7 @@ subroutine xt3d_ac(this, moffset, sparse) end do end do end do - + ! ! -- calculate ia_xt3d and ja_xt3d from sparse_xt3d and ! then destroy sparse call mem_allocate(this%ia_xt3d, this%dis%nodes + 1, 'IA_XT3D', & @@ -209,13 +195,9 @@ subroutine xt3d_ac(this, moffset, sparse) return end subroutine xt3d_ac + !> @brief Map connections and construct iax, jax, and idxglox + !< subroutine xt3d_mc(this, moffset, matrix_sln) -! ****************************************************************************** -! xt3d_mc -- Map connections and construct iax, jax, and idxglox -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -228,7 +210,6 @@ subroutine xt3d_mc(this, moffset, matrix_sln) integer(I4B) :: jj_xt3d integer(I4B) :: igfirstnod, iglastnod logical :: isextnbr -! ------------------------------------------------------------------------------ ! ! -- If not rhs, map connections for extended neighbors and construct iax, ! -- jax, and idxglox @@ -301,14 +282,10 @@ subroutine xt3d_mc(this, moffset, matrix_sln) return end subroutine xt3d_mc + !> @brief Allocate and Read + !< subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22, iangle1, & iangle2, iangle3, angle1, angle2, angle3, inewton, icelltype) -! ****************************************************************************** -! xt3d_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error ! -- dummy @@ -334,8 +311,6 @@ subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22, iangle1, & ! -- formats character(len=*), parameter :: fmtheader = & "(1x, /1x, 'XT3D is active.'//)" - ! -- data -! ------------------------------------------------------------------------------ ! ! -- Print a message identifying the xt3d module. if (this%iout > 0) then @@ -356,6 +331,7 @@ subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22, iangle1, & this%angle1 => angle1 this%angle2 => angle2 this%angle3 => angle3 + ! if (present(inewton)) then ! -- inewton is not needed for transport so it's optional. this%inewton = inewton @@ -406,13 +382,9 @@ subroutine xt3d_ar(this, ibound, k11, ik33, k33, sat, ik22, k22, iangle1, & return end subroutine xt3d_ar + !> @brief Formulate subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! xt3d_fc -- Formulate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DONE use Xt3dAlgorithmModule, only: qconds ! -- dummy @@ -425,7 +397,6 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) ! -- local integer(I4B) :: nodes, nja integer(I4B) :: n, m, ipos - ! logical :: allhc0, allhc1 integer(I4B) :: nnbr0, nnbr1 integer(I4B) :: il0, ii01, jjs01, il01, il10, ii00, ii11, ii10 @@ -438,7 +409,6 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) real(DP) :: chat01 real(DP), dimension(this%nbrmax) :: chati0, chat1j real(DP) :: qnm, qnbrs -! ------------------------------------------------------------------------------ ! ! -- Calculate xt3d conductance-like coefficients and put into amat and rhs ! -- as appropriate @@ -466,7 +436,7 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) call this%xt3d_load(nodes, n, nnbr0, inbr0, vc0, vn0, dl0, dl0n, & ck0, allhc0) ! -- Loop over active neighbors of cell 0 that have a higher - ! -- cell number (taking advantage of reciprocity). + ! cell number (taking advantage of reciprocity). do il0 = 1, nnbr0 ipos = this%dis%con%ia(n) + il0 if (this%dis%con%mask(ipos) == 0) cycle @@ -489,13 +459,13 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) call this%xt3d_areas(nodes, n, m, jjs01, .false., ar01, ar10, hnew) end if ! -- Compute "conductances" for interface between - ! -- cells 0 and 1. + ! cells 0 and 1. call qconds(this%nbrmax, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, ar01, ar10, & this%vcthresh, allhc0, allhc1, chat01, chati0, chat1j) ! -- If Newton, compute and save saturated flow, then scale - ! -- conductance-like coefficients by the actual area for - ! -- subsequent amat and rhs assembly. + ! conductance-like coefficients by the actual area for + ! subsequent amat and rhs assembly. if (this%inewton /= 0) then ! -- Contribution to flow from primary connection. qnm = chat01 * (hnew(m) - hnew(n)) @@ -514,6 +484,7 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) chati0 = chati0 * ar01 chat1j = chat1j * ar01 end if + ! ! -- Contribute to rows for cells 0 and 1. call matrix_sln%add_value_pos(idxglo(ii00), -chat01) call matrix_sln%add_value_pos(idxglo(ii01), chat01) @@ -540,14 +511,10 @@ subroutine xt3d_fc(this, kiter, matrix_sln, idxglo, rhs, hnew) return end subroutine xt3d_fc + !> @brief Formulate for permanently confined connections and save in amatpc + !! and amatpcx + !< subroutine xt3d_fcpc(this, nodes, lsat) -! ****************************************************************************** -! xt3d_fcpc -- Formulate for permanently confined connections and save in -! amatpc and amatpcx -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use Xt3dAlgorithmModule, only: qconds ! -- dummy @@ -567,7 +534,6 @@ subroutine xt3d_fcpc(this, nodes, lsat) real(DP), dimension(3, 3) :: ck0, ck1 real(DP) :: chat01 real(DP), dimension(this%nbrmax) :: chati0, chat1j -! ------------------------------------------------------------------------------ ! ! -- Initialize amatpc and amatpcx to zero do n = 1, size(this%amatpc) @@ -626,14 +592,11 @@ subroutine xt3d_fcpc(this, nodes, lsat) return end subroutine xt3d_fcpc + !> @brief Formulate HFB correction + !< subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & n, m, condhfb) -! ****************************************************************************** -! xt3d_fhfb -- Formulate HFB correction -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DONE use Xt3dAlgorithmModule, only: qconds ! -- dummy @@ -648,7 +611,6 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & real(DP), intent(inout), dimension(nodes) :: hnew real(DP) :: condhfb ! -- local - ! logical :: allhc0, allhc1 integer(I4B) :: nnbr0, nnbr1 integer(I4B) :: il0, ii01, jjs01, il01, il10, ii00, ii11, ii10, il @@ -661,10 +623,9 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & real(DP), dimension(this%nbrmax) :: chati0, chat1j real(DP) :: qnm, qnbrs real(DP) :: term -! ------------------------------------------------------------------------------ ! ! -- Calculate hfb corrections to xt3d conductance-like coefficients and - ! -- put into amat and rhs as appropriate + ! put into amat and rhs as appropriate ! nnbr0 = this%dis%con%ia(n + 1) - this%dis%con%ia(n) - 1 ! -- Load conductivity and connection info for cell 0. @@ -691,11 +652,13 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & else call this%xt3d_areas(nodes, n, m, jjs01, .false., ar01, ar10, hnew) end if + ! ! -- Compute "conductances" for interface between - ! -- cells 0 and 1. + ! cells 0 and 1. call qconds(this%nbrmax, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, & ck0, nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, ar01, ar10, & this%vcthresh, allhc0, allhc1, chat01, chati0, chat1j) + ! ! -- Apply scale factor to compute "conductances" for hfb correction if (condhfb > DZERO) then term = chat01 / (chat01 + condhfb) @@ -705,9 +668,9 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & chat01 = -chat01 * term chati0 = -chati0 * term chat1j = -chat1j * term - ! -- If Newton, compute and save saturated flow, then scale - ! -- conductance-like coefficients by the actual area for - ! -- subsequent amat and rhs assembly. + ! + ! -- If Newton, compute and save saturated flow, then scale conductance-like + ! coefficients by the actual area for subsequent amat and rhs assembly. if (this%inewton /= 0) then ! -- Contribution to flow from primary connection. qnm = chat01 * (hnew(m) - hnew(n)) @@ -726,6 +689,7 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & chati0 = chati0 * ar01 chat1j = chat1j * ar01 end if + ! ! -- Contribute to rows for cells 0 and 1. call matrix_sln%add_value_pos(idxglo(ii00), -chat01) call matrix_sln%add_value_pos(idxglo(ii01), chat01) @@ -749,13 +713,9 @@ subroutine xt3d_fhfb(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew, & return end subroutine xt3d_fhfb + !> @brief Fill Newton terms for xt3d subroutine xt3d_fn(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew) -! ****************************************************************************** -! xt3d_fn -- Fill Newton terms for xt3d -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DONE use SmoothingModule, only: sQuadraticSaturationDerivative ! -- dummy @@ -769,47 +729,53 @@ subroutine xt3d_fn(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew) real(DP), intent(inout), dimension(nodes) :: hnew ! -- local integer(I4B) :: n, m, ipos - ! integer(I4B) :: nnbr0 integer(I4B) :: il0, ii01, jjs01, il01, il10, ii00, ii11, ii10 integer(I4B), dimension(this%nbrmax) :: inbr0 integer(I4B) :: iups, idn real(DP) :: topup, botup, derv, term -! ------------------------------------------------------------------------------ ! ! -- Update amat and rhs with Newton terms do n = 1, nodes + ! ! -- Skip if inactive. if (this%ibound(n) .eq. 0) cycle + ! ! -- No Newton correction if amat saved (which implies no rhs option) - ! -- and all connections for the cell are permanently confined. + ! and all connections for the cell are permanently confined. if (this%lamatsaved) then if (this%iallpc(n) == 1) cycle end if nnbr0 = this%dis%con%ia(n + 1) - this%dis%con%ia(n) - 1 + ! ! -- Load neighbors of cell. Set cell numbers for inactive - ! -- neighbors to zero. + ! neighbors to zero. call this%xt3d_load_inbr(n, nnbr0, inbr0) + ! ! -- Loop over active neighbors of cell 0 that have a higher - ! -- cell number (taking advantage of reciprocity). + ! cell number (taking advantage of reciprocity). do il0 = 1, nnbr0 ipos = this%dis%con%ia(n) + il0 if (this%dis%con%mask(ipos) == 0) cycle - + ! m = inbr0(il0) + ! ! -- Skip if neighbor is inactive or has lower cell number. if ((inbr0(il0) .eq. 0) .or. (m .lt. n)) cycle + ! ! -- Set various indices. call this%xt3d_indices(n, m, il0, ii01, jjs01, il01, il10, & ii00, ii11, ii10) - ! determine upstream node + ! + ! -- Determine upstream node iups = m if (hnew(m) < hnew(n)) iups = n idn = n if (iups == n) idn = m - ! -- no Newton terms if upstream cell is confined - ! -- and no rhs option + ! + ! -- No Newton terms if upstream cell is confined and no rhs option if ((this%icelltype(iups) == 0) .and. (this%ixt3d .eq. 1)) cycle + ! ! -- Set the upstream top and bot, and then recalculate for a ! vertically staggered horizontal connection topup = this%dis%top(iups) @@ -818,25 +784,33 @@ subroutine xt3d_fn(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew) topup = min(this%dis%top(n), this%dis%top(m)) botup = max(this%dis%bot(n), this%dis%bot(m)) end if - ! derivative term + ! + ! -- Derivative term derv = sQuadraticSaturationDerivative(topup, botup, hnew(iups)) term = this%qsat(ii01) * derv - ! fill Jacobian for n being the upstream node + ! + ! -- Fill Jacobian for n being the upstream node if (iups == n) then - ! fill in row of n + ! + ! -- Fill in row of n call matrix_sln%add_value_pos(idxglo(ii00), term) rhs(n) = rhs(n) + term * hnew(n) - ! fill in row of m + ! + ! -- Fill in row of m call matrix_sln%add_value_pos(idxglo(ii10), -term) rhs(m) = rhs(m) - term * hnew(n) - ! fill Jacobian for m being the upstream node + ! + ! -- Fill Jacobian for m being the upstream node else - ! fill in row of n + ! + ! -- Fill in row of n call matrix_sln%add_value_pos(idxglo(ii01), term) rhs(n) = rhs(n) + term * hnew(m) - ! fill in row of m + ! + ! -- Fill in row of m call matrix_sln%add_value_pos(idxglo(ii11), -term) rhs(m) = rhs(m) - term * hnew(m) + ! end if end do end do @@ -845,13 +819,10 @@ subroutine xt3d_fn(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, hnew) return end subroutine xt3d_fn + !> @brief Budget + !< subroutine xt3d_flowja(this, hnew, flowja) -! ****************************************************************************** -! xt3d_flowja -- Budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use Xt3dAlgorithmModule, only: qconds ! -- dummy class(Xt3dType) :: this @@ -870,44 +841,54 @@ subroutine xt3d_flowja(this, hnew, flowja) real(DP), dimension(3, 3) :: ck0, ck1 real(DP) :: chat01 real(DP), dimension(this%nbrmax) :: chati0, chat1j -! ------------------------------------------------------------------------------ ! ! -- Calculate the flow across each cell face and store in flowja nodes = this%dis%nodes do n = 1, nodes + ! ! -- Skip if inactive. if (this%ibound(n) .eq. 0) cycle nnbr0 = this%dis%con%ia(n + 1) - this%dis%con%ia(n) - 1 + ! ! -- Load conductivity and connection info for cell 0. call this%xt3d_load(nodes, n, nnbr0, inbr0, vc0, vn0, dl0, dl0n, & ck0, allhc0) + ! ! -- Loop over active neighbors of cell 0 that have a higher - ! -- cell number (taking advantage of reciprocity). + ! cell number (taking advantage of reciprocity). do il0 = 1, nnbr0 m = inbr0(il0) + ! ! -- Skip if neighbor is inactive or has lower cell number. if ((inbr0(il0) .eq. 0) .or. (m .lt. n)) cycle nnbr1 = this%dis%con%ia(m + 1) - this%dis%con%ia(m) - 1 + ! ! -- Load conductivity and connection info for cell 1. call this%xt3d_load(nodes, m, nnbr1, inbr1, vc1, vn1, dl1, dl1n, & ck1, allhc1) + ! ! -- Set various indices. call this%xt3d_indices(n, m, il0, ii01, jjs01, il01, il10, & ii00, ii11, ii10) + ! ! -- Compute areas. if (this%inewton /= 0) & call this%xt3d_areas(nodes, n, m, jjs01, .true., ar01, ar10, hnew) call this%xt3d_areas(nodes, n, m, jjs01, .false., ar01, ar10, hnew) + ! ! -- Compute "conductances" for interface between - ! -- cells 0 and 1. + ! cells 0 and 1. call qconds(this%nbrmax, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, ck0, & nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, ar01, ar10, & this%vcthresh, allhc0, allhc1, chat01, chati0, chat1j) + ! ! -- Contribution to flow from primary connection. qnm = chat01 * (hnew(m) - hnew(n)) + ! ! -- Contribution from immediate neighbors of node 0. call this%xt3d_qnbrs(nodes, n, m, nnbr0, inbr0, chati0, hnew, qnbrs) qnm = qnm + qnbrs + ! ! -- Contribution from immediate neighbors of node 1. call this%xt3d_qnbrs(nodes, m, n, nnbr1, inbr1, chat1j, hnew, qnbrs) qnm = qnm - qnbrs @@ -921,13 +902,10 @@ subroutine xt3d_flowja(this, hnew, flowja) return end subroutine xt3d_flowja + !> @brief hfb contribution to flowja when xt3d is used + !< subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) -! ****************************************************************************** -! xt3d_flowjahfb -- hfb contribution to flowja when xt3d is used -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DONE use Xt3dAlgorithmModule, only: qconds ! -- dummy @@ -937,10 +915,9 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) real(DP), intent(inout), dimension(:) :: flowja real(DP) :: condhfb ! -- local - ! integer(I4B) :: nodes logical :: allhc0, allhc1 -!!! integer(I4B), parameter :: nbrmax = 10 + ! integer(I4B), parameter :: nbrmax = 10 integer(I4B) :: nnbr0, nnbr1 integer(I4B) :: il0, ii01, jjs01, il01, il10, ii00, ii11, ii10, il integer(I4B), dimension(this%nbrmax) :: inbr0, inbr1 @@ -953,16 +930,16 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) real(DP), dimension(this%nbrmax) :: chati0, chat1j real(DP) :: qnm, qnbrs real(DP) :: term -! ------------------------------------------------------------------------------ ! ! -- Calculate hfb corrections to xt3d conductance-like coefficients and - ! -- put into amat and rhs as appropriate - ! + ! put into amat and rhs as appropriate nodes = this%dis%nodes nnbr0 = this%dis%con%ia(n + 1) - this%dis%con%ia(n) - 1 + ! ! -- Load conductivity and connection info for cell 0. call this%xt3d_load(nodes, n, nnbr0, inbr0, vc0, vn0, dl0, dl0n, & ck0, allhc0) + ! ! -- Find local neighbor number of cell 1. do il = 1, nnbr0 if (inbr0(il) .eq. m) then @@ -970,13 +947,17 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) exit end if end do + ! nnbr1 = this%dis%con%ia(m + 1) - this%dis%con%ia(m) - 1 + ! ! -- Load conductivity and connection info for cell 1. call this%xt3d_load(nodes, m, nnbr1, inbr1, vc1, vn1, dl1, dl1n, & ck1, allhc1) + ! ! -- Set various indices. call this%xt3d_indices(n, m, il0, ii01, jjs01, il01, il10, & ii00, ii11, ii10) + ! ! -- Compute areas. if (this%inewton /= 0) then ar01 = DONE @@ -984,11 +965,13 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) else call this%xt3d_areas(nodes, n, m, jjs01, .false., ar01, ar10, hnew) end if + ! ! -- Compute "conductances" for interface between - ! -- cells 0 and 1. + ! cells 0 and 1. call qconds(this%nbrmax, nnbr0, inbr0, il01, vc0, vn0, dl0, dl0n, & ck0, nnbr1, inbr1, il10, vc1, vn1, dl1, dl1n, ck1, ar01, ar10, & this%vcthresh, allhc0, allhc1, chat01, chati0, chat1j) + ! ! -- Apply scale factor to compute "conductances" for hfb correction if (condhfb > DZERO) then term = chat01 / (chat01 + condhfb) @@ -998,21 +981,26 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) chat01 = -chat01 * term chati0 = -chati0 * term chat1j = -chat1j * term + ! ! -- Contribution to flow from primary connection. qnm = chat01 * (hnew(m) - hnew(n)) + ! ! -- Contribution from immediate neighbors of node 0. call this%xt3d_qnbrs(nodes, n, m, nnbr0, inbr0, chati0, hnew, qnbrs) qnm = qnm + qnbrs + ! ! -- Contribution from immediate neighbors of node 1. call this%xt3d_qnbrs(nodes, m, n, nnbr1, inbr1, chat1j, hnew, qnbrs) qnm = qnm - qnbrs + ! ! -- If Newton, scale conductance-like coefficients by the - ! -- actual area. + ! actual area. if (this%inewton /= 0) then call this%xt3d_areas(nodes, n, m, jjs01, .true., ar01, ar10, hnew) call this%xt3d_areas(nodes, n, m, jjs01, .false., ar01, ar10, hnew) qnm = qnm * ar01 end if + ! ipos = ii01 flowja(ipos) = flowja(ipos) + qnm flowja(this%dis%con%isym(ipos)) = flowja(this%dis%con%isym(ipos)) - qnm @@ -1021,18 +1009,13 @@ subroutine xt3d_flowjahfb(this, n, m, hnew, flowja, condhfb) return end subroutine xt3d_flowjahfb + !> @brief Deallocate variables + !< subroutine xt3d_da(this) -! ****************************************************************************** -! xt3d_da -- Deallocate variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(Xt3dType) :: this -! ------------------------------------------------------------------------------ ! ! -- Deallocate arrays if (this%ixt3d /= 0) then @@ -1064,18 +1047,13 @@ subroutine xt3d_da(this) return end subroutine xt3d_da + !> @brief Allocate scalar pointer variables + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- Allocate scalar pointer variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy class(Xt3dType) :: this -! ------------------------------------------------------------------------------ ! ! -- Allocate scalars call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath) @@ -1105,13 +1083,9 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Allocate xt3d arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- Allocate xt3d arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -1119,7 +1093,6 @@ subroutine allocate_arrays(this) ! -- local integer(I4B) :: njax integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- Allocate Newton-dependent arrays if (this%inewton /= 0) then @@ -1174,13 +1147,8 @@ subroutine allocate_arrays(this) return end subroutine allocate_arrays + !> @brief Allocate and populate iallpc array. Set lamatsaved. subroutine xt3d_iallpc(this) -! ****************************************************************************** -! xt3d_iallpc -- Allocate and populate iallpc array. Set lamatsaved. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_deallocate ! -- dummy @@ -1189,7 +1157,6 @@ subroutine xt3d_iallpc(this) integer(I4B) :: n, m, mm, il0, il1 integer(I4B) :: nnbr0, nnbr1 integer(I4B), dimension(this%nbrmax) :: inbr0, inbr1 -! ------------------------------------------------------------------------------ ! if (this%ixt3d == 2) then this%lamatsaved = .false. @@ -1253,27 +1220,21 @@ subroutine xt3d_iallpc(this) return end subroutine xt3d_iallpc + !> @brief Set various indices for XT3D. + !< subroutine xt3d_indices(this, n, m, il0, ii01, jjs01, il01, il10, & ii00, ii11, ii10) -! ****************************************************************************** -! xt3d_indices -- Set various indices for XT3D. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B) :: n, m, il0, ii01, jjs01, il01, il10, ii00, ii11, ii10 ! -- local integer(I4B) :: iinm -! ------------------------------------------------------------------------------ ! ! -- Set local number of node 0-1 connection (local cell number of cell 1 - ! -- in cell 0's neighbor list). + ! in cell 0's neighbor list). il01 = il0 ! -- Set local number of node 1-0 connection (local cell number of cell 0 - ! -- in cell 1's neighbor list). + ! in cell 1's neighbor list). call this%xt3d_get_iinm(m, n, iinm) il10 = iinm - this%dis%con%ia(m) ! -- Set index of node 0 diagonal in the ja array. @@ -1287,17 +1248,14 @@ subroutine xt3d_indices(this, n, m, il0, ii01, jjs01, il01, il10, & ! -- Set index of node 1-0 connection in the ja array. ii10 = ii11 + il10 ! + ! -- Return return end subroutine xt3d_indices + !> @brief Load conductivity and connection info for a cell into arrays used + !! by XT3D + !< subroutine xt3d_load(this, nodes, n, nnbr, inbr, vc, vn, dl, dln, ck, allhc) -! ****************************************************************************** -! xt3d_load -- Load conductivity and connection info for a cell into arrays -! used by XT3D. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use ConstantsModule, only: DZERO, DHALF, DONE ! -- dummy @@ -1314,7 +1272,6 @@ subroutine xt3d_load(this, nodes, n, nnbr, inbr, vc, vn, dl, dln, ck, allhc) integer(I4B) :: ihcnjj real(DP) :: satn, satjj real(DP) :: cl1njj, cl2njj, dltot, ooclsum -! ------------------------------------------------------------------------------ ! ! -- Set conductivity tensor for cell. ck = DZERO @@ -1325,11 +1282,10 @@ subroutine xt3d_load(this, nodes, n, nnbr, inbr, vc, vn, dl, dln, ck, allhc) ck = matmul(this%rmatck, ck) ck = matmul(ck, transpose(this%rmatck)) ! - ! -- Load neighbors of cell. Set cell numbers for inactive - ! -- neighbors to zero so xt3d knows to ignore them. Compute - ! -- direct connection lengths from perpendicular connection - ! -- lengths. Also determine if all active connections are - ! -- horizontal. + ! -- Load neighbors of cell. Set cell numbers for inactive neighbors to + ! zero so xt3d knows to ignore them. Compute direct connection lengths + ! from perpendicular connection lengths. Also determine if all active + ! connections are horizontal. allhc = .true. do il = 1, nnbr ii = il + this%dis%con%ia(n) @@ -1339,6 +1295,7 @@ subroutine xt3d_load(this, nodes, n, nnbr, inbr, vc, vn, dl, dln, ck, allhc) inbr(il) = jj satn = this%sat(n) satjj = this%sat(jj) + ! ! -- DISV and DIS ihcnjj = this%dis%con%ihc(jjs) call this%dis%connection_normal(n, jj, ihcnjj, vn(il, 1), vn(il, 2), & @@ -1361,27 +1318,22 @@ subroutine xt3d_load(this, nodes, n, nnbr, inbr, vc, vn, dl, dln, ck, allhc) end if end do ! + ! -- Return return end subroutine xt3d_load + !> @brief Load neighbor list for a cell. + !< subroutine xt3d_load_inbr(this, n, nnbr, inbr) -! ****************************************************************************** -! xt3d_load_inbr -- Load neighbor list for a cell. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B) :: n, nnbr integer(I4B), dimension(this%nbrmax) :: inbr ! -- local integer(I4B) :: il, ii, jj -! ------------------------------------------------------------------------------ ! ! -- Load neighbors of cell. Set cell numbers for inactive - ! -- neighbors to zero so xt3d knows to ignore them. + ! neighbors to zero so xt3d knows to ignore them. do il = 1, nnbr ii = il + this%dis%con%ia(n) jj = this%dis%con%ja(ii) @@ -1392,17 +1344,13 @@ subroutine xt3d_load_inbr(this, n, nnbr, inbr) end if end do ! + ! -- Return return end subroutine xt3d_load_inbr + !> @brief Compute interfacial areas. + !< subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) -! ****************************************************************************** -! xt3d_areas -- Compute interfacial areas. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this logical :: lsat @@ -1413,12 +1361,11 @@ subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) real(DP) :: topn, botn, topm, botm, thksatn, thksatm real(DP) :: sill_top, sill_bot, tpn, tpm real(DP) :: satups -! ------------------------------------------------------------------------------ ! ! -- Compute area depending on connection type if (this%dis%con%ihc(jjs01) == 0) then ! - ! -- vertical connection + ! -- Vertical connection ar01 = this%dis%con%hwva(jjs01) ar10 = ar01 else if (this%inewton /= 0) then @@ -1434,7 +1381,7 @@ subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) thksatn = topn - botn thksatm = topm - botm if (this%dis%con%ihc(jjs01) .eq. 2) then - ! -- vertically staggered + ! -- Vertically staggered sill_top = min(topn, topm) sill_bot = max(botn, botm) tpn = botn + thksatn @@ -1445,9 +1392,9 @@ subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) ar01 = this%dis%con%hwva(jjs01) * DHALF * (thksatn + thksatm) else ! -- If Newton and lsat=.false., it is assumed that the fully saturated - ! -- areas have already been calculated and are being passed in through - ! -- ar01 and ar10. The actual areas are obtained simply by scaling by - ! -- the upstream saturation. + ! areas have already been calculated and are being passed in through + ! ar01 and ar10. The actual areas are obtained simply by scaling by + ! the upstream saturation. if (hnew(m) < hnew(n)) then satups = this%sat(n) else @@ -1470,7 +1417,7 @@ subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) thksatm = this%sat(m) * thksatm end if if (this%dis%con%ihc(jjs01) == 2) then - ! -- vertically staggered + ! -- Vertically staggered sill_top = min(topn, topm) sill_bot = max(botn, botm) tpn = botn + thksatn @@ -1482,18 +1429,14 @@ subroutine xt3d_areas(this, nodes, n, m, jjs01, lsat, ar01, ar10, hnew) ar10 = this%dis%con%hwva(jjs01) * thksatm end if ! + ! -- Return return end subroutine xt3d_areas + !> @brief Add contributions from neighbors to amat. + !< subroutine xt3d_amat_nbrs(this, nodes, n, idiag, nnbr, nja, & matrix_sln, inbr, idxglo, chat) -! ****************************************************************************** -! xt3d_amat_nbrs -- Add contributions from neighbors to amat. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1504,7 +1447,6 @@ subroutine xt3d_amat_nbrs(this, nodes, n, idiag, nnbr, nja, & real(DP), dimension(this%nbrmax) :: chat ! -- local integer(I4B) :: iil, iii -! ------------------------------------------------------------------------------ ! do iil = 1, nnbr if (inbr(iil) .ne. 0) then @@ -1514,18 +1456,14 @@ subroutine xt3d_amat_nbrs(this, nodes, n, idiag, nnbr, nja, & end if end do ! + ! -- Return return end subroutine xt3d_amat_nbrs + !> @brief Add contributions from neighbors of neighbor to amat. + !< subroutine xt3d_amat_nbrnbrs(this, nodes, n, m, ii01, nnbr, nja, & matrix_sln, inbr, idxglo, chat) -! ****************************************************************************** -! xt3d_amat_nbrnbrs -- Add contributions from neighbors of neighbor to amat. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1536,7 +1474,6 @@ subroutine xt3d_amat_nbrnbrs(this, nodes, n, m, ii01, nnbr, nja, & real(DP), dimension(this%nbrmax) :: chat ! -- local integer(I4B) :: iil, iii, jjj, iixjjj, iijjj -! ------------------------------------------------------------------------------ ! do iil = 1, nnbr if (inbr(iil) .ne. 0) then @@ -1553,17 +1490,13 @@ subroutine xt3d_amat_nbrnbrs(this, nodes, n, m, ii01, nnbr, nja, & end if end do ! + ! -- Return return end subroutine xt3d_amat_nbrnbrs + !> @brief Add contributions from neighbors to amatpc. + !< subroutine xt3d_amatpc_nbrs(this, nodes, n, idiag, nnbr, inbr, chat) -! ****************************************************************************** -! xt3d_amatpc_nbrs -- Add contributions from neighbors to amatpc. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1572,7 +1505,6 @@ subroutine xt3d_amatpc_nbrs(this, nodes, n, idiag, nnbr, inbr, chat) real(DP), dimension(this%nbrmax) :: chat ! -- local integer(I4B) :: iil, iii -! ------------------------------------------------------------------------------ ! do iil = 1, nnbr iii = this%dis%con%ia(n) + iil @@ -1580,18 +1512,13 @@ subroutine xt3d_amatpc_nbrs(this, nodes, n, idiag, nnbr, inbr, chat) this%amatpc(iii) = this%amatpc(iii) + chat(iil) end do ! + ! -- Return return end subroutine xt3d_amatpc_nbrs + !> @brief Add contributions from neighbors of neighbor to amatpc and amatpcx + !< subroutine xt3d_amatpcx_nbrnbrs(this, nodes, n, m, ii01, nnbr, inbr, chat) -! ****************************************************************************** -! xt3d_amatpcx_nbrnbrs -- Add contributions from neighbors of neighbor to -! amatpc and amatpcx. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1600,7 +1527,6 @@ subroutine xt3d_amatpcx_nbrnbrs(this, nodes, n, m, ii01, nnbr, inbr, chat) real(DP), dimension(this%nbrmax) :: chat ! -- local integer(I4B) :: iil, iii, jjj, iixjjj, iijjj -! ------------------------------------------------------------------------------ ! do iil = 1, nnbr this%amatpc(ii01) = this%amatpc(ii01) + chat(iil) @@ -1615,24 +1541,19 @@ subroutine xt3d_amatpcx_nbrnbrs(this, nodes, n, m, ii01, nnbr, inbr, chat) end if end do ! + ! -- Return return end subroutine xt3d_amatpcx_nbrnbrs + !> @brief Get position of n-m connection in ja array (return 0 if not + !! connected) + !< subroutine xt3d_get_iinm(this, n, m, iinm) -! ****************************************************************************** -! xt3d_get_iinm -- Get position of n-m connection in ja array (return 0 if -! not connected). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B) :: n, m, iinm ! -- local integer(I4B) :: ii, jj -! ------------------------------------------------------------------------------ ! iinm = 0 do ii = this%dis%con%ia(n), this%dis%con%ia(n + 1) - 1 @@ -1643,24 +1564,19 @@ subroutine xt3d_get_iinm(this, n, m, iinm) end if end do ! + ! -- Return return end subroutine xt3d_get_iinm + !> @brief Get position of n-m "extended connection" in jax array (return 0 if + !! not connected) + !< subroutine xt3d_get_iinmx(this, n, m, iinmx) -! ****************************************************************************** -! xt3d_get_iinmx -- Get position of n-m "extended connection" in jax array -! (return 0 if not connected). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B) :: n, m, iinmx ! -- local integer(I4B) :: iix, jjx -! ------------------------------------------------------------------------------ ! iinmx = 0 do iix = this%iax(n), this%iax(n + 1) - 1 @@ -1671,18 +1587,14 @@ subroutine xt3d_get_iinmx(this, n, m, iinmx) end if end do ! + ! -- Return return end subroutine xt3d_get_iinmx + !> @brief Add contributions to rhs. + !< subroutine xt3d_rhs(this, nodes, n, m, nnbr, inbr, chat, hnew, & rhs) -! ****************************************************************************** -! xt3d_rhs -- Add contributions to rhs. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1693,7 +1605,6 @@ subroutine xt3d_rhs(this, nodes, n, m, nnbr, inbr, chat, hnew, & ! -- local integer(I4B) :: iil, iii, jjj real(DP) :: term -! ------------------------------------------------------------------------------ ! do iil = 1, nnbr if (inbr(iil) .ne. 0) then @@ -1705,18 +1616,14 @@ subroutine xt3d_rhs(this, nodes, n, m, nnbr, inbr, chat, hnew, & end if end do ! + ! -- Return return end subroutine xt3d_rhs + !> @brief Add contributions to flow from neighbors + !< subroutine xt3d_qnbrs(this, nodes, n, m, nnbr, inbr, chat, hnew, & qnbrs) -! ****************************************************************************** -! xt3d_qnbrs -- Add contributions to flow from neighbors. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: nodes @@ -1728,7 +1635,6 @@ subroutine xt3d_qnbrs(this, nodes, n, m, nnbr, inbr, chat, hnew, & ! -- local integer(I4B) :: iil, iii, jjj real(DP) :: term -! ------------------------------------------------------------------------------ ! qnbrs = 0d0 do iil = 1, nnbr @@ -1740,25 +1646,21 @@ subroutine xt3d_qnbrs(this, nodes, n, m, nnbr, inbr, chat, hnew, & end if end do ! + ! -- Return return end subroutine xt3d_qnbrs + !> @brief Fill rmat array for cell n. + !! + !! angle1, 2, and 3 must be in radians. + !< subroutine xt3d_fillrmatck(this, n) -! ****************************************************************************** -! xt3d_fillrmatck -- Fill rmat array for cell n. -! angle1, 2, and 3 must be in radians. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- module ! -- dummy class(Xt3dType) :: this integer(I4B), intent(in) :: n ! -- local real(DP) :: ang1, ang2, ang3, ang2d, ang3d real(DP) :: s1, c1, s2, c2, s3, c3 -! ------------------------------------------------------------------------------ ! if (this%nozee) then ang2d = 0d0 @@ -1787,6 +1689,7 @@ subroutine xt3d_fillrmatck(this, n) this%rmatck(3, 2) = -c2 * s3 this%rmatck(3, 3) = c2 * c3 ! + ! -- Return return end subroutine xt3d_fillrmatck diff --git a/src/Model/NumericalModel.f90 b/src/Model/NumericalModel.f90 index 59ccf46ec76..e4d5e0e5add 100644 --- a/src/Model/NumericalModel.f90 +++ b/src/Model/NumericalModel.f90 @@ -48,6 +48,7 @@ module NumericalModelModule procedure :: model_mc procedure :: model_rp procedure :: model_ad + procedure :: model_reset procedure :: model_cf procedure :: model_fc procedure :: model_ptcchk @@ -106,6 +107,20 @@ subroutine model_ad(this) class(NumericalModelType) :: this end subroutine model_ad + subroutine model_reset(this) + use BndModule, only: BndType, GetBndFromList + class(NumericalModelType) :: this + ! local + class(BndType), pointer :: packobj + integer(I4B) :: ip + + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_reset() + end do + + end subroutine model_reset + subroutine model_cf(this, kiter) class(NumericalModelType) :: this integer(I4B), intent(in) :: kiter diff --git a/src/Model/NumericalPackage.f90 b/src/Model/NumericalPackage.f90 index 114256a4778..ee9c81fd048 100644 --- a/src/Model/NumericalPackage.f90 +++ b/src/Model/NumericalPackage.f90 @@ -6,7 +6,7 @@ !< module NumericalPackageModule ! -- modules - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LENPACKAGENAME, LENMODELNAME, & LENMEMPATH, LENFTYPE, LINELENGTH, & LENVARNAME @@ -28,7 +28,7 @@ module NumericalPackageModule character(len=LENMEMPATH) :: memoryPath = '' !< the location in the memory manager where the variables are stored character(len=LENMEMPATH) :: memoryPathModel = '' !< the location in the memory manager where the variables !! of the parent model are stored - character(len=LENMEMPATH), pointer :: input_mempath => null() !< input context mempath + character(len=LENMEMPATH) :: input_mempath = '' !< input context mempath character(len=LINELENGTH), pointer :: input_fname => null() !< input file name character(len=LENFTYPE) :: filtyp = '' !< file type (CHD, DRN, RIV, etc.) character(len=LENFTYPE), pointer :: package_type => null() !< package type (same as filtyp) stored in memory manager @@ -60,23 +60,25 @@ module NumericalPackageModule contains ! !> @ brief Set package names - !! - !! Method to assign the filtyp (ftype), the model name, and package name for - !! a package. This method also creates the memoryPath and memoryPathModel that - !! is used by the memory manager when variables are allocated. - !! + !! + !! Method to assign the filtyp (ftype), the model name, and package name for + !! a package. This method also creates the memoryPath and memoryPathModel that + !! is used by the memory manager when variables are allocated. + !! !< - subroutine set_names(this, ibcnum, name_model, pakname, ftype) + subroutine set_names(this, ibcnum, name_model, pakname, ftype, input_mempath) ! -- dummy variables class(NumericalPackageType), intent(inout) :: this !< NumericalPackageType object integer(I4B), intent(in) :: ibcnum !< unique package number character(len=*), intent(in) :: name_model !< name of the model character(len=*), intent(in) :: pakname !< name of the package character(len=*), intent(in) :: ftype !< package type + character(len=*), optional, intent(in) :: input_mempath !< input_mempath ! ! -- set names this%filtyp = ftype this%name_model = name_model + if (present(input_mempath)) this%input_mempath = input_mempath if (pakname == '') then write (this%packName, '(a, i0)') trim(ftype)//'-', ibcnum else @@ -93,19 +95,17 @@ subroutine set_names(this, ibcnum, name_model, pakname, ftype) end if this%memoryPath = create_mem_path(name_model, this%packName) this%memoryPathModel = create_mem_path(name_model) - ! - ! -- return - return end subroutine set_names !> @ brief Allocate package scalars - !! - !! Allocate and initialize base numerical package scalars. - !! + !! + !! Allocate and initialize base numerical package scalars. + !! !< subroutine allocate_scalars(this) ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr + use MemoryManagerExtModule, only: mem_set_value ! -- dummy variables class(NumericalPackageType) :: this !< NumericalPackageType object ! -- local variables @@ -113,10 +113,9 @@ subroutine allocate_scalars(this) integer(I4B), pointer :: imodelprpak => null() integer(I4B), pointer :: imodelprflow => null() integer(I4B), pointer :: imodelpakcb => null() + logical(LGP) :: found ! ! -- allocate scalars - call mem_allocate(this%input_mempath, LENMEMPATH, 'INPUT_MEMPATH', & - this%memoryPath) call mem_allocate(this%input_fname, LINELENGTH, 'INPUT_FNAME', & this%memoryPath) call mem_allocate(this%package_type, LENFTYPE, 'PACKAGE_TYPE', & @@ -140,7 +139,6 @@ subroutine allocate_scalars(this) call mem_setptr(imodelpakcb, 'IPAKCB', this%memoryPathModel) ! ! -- initialize - this%input_mempath = '' this%input_fname = '' this%package_type = this%filtyp this%id = 0 @@ -160,14 +158,17 @@ subroutine allocate_scalars(this) imodelprflow => null() imodelpakcb => null() ! - ! -- return - return + ! -- update input filename + if (this%input_mempath /= '') then + call mem_set_value(this%input_fname, 'INPUT_FNAME', & + this%input_mempath, found) + end if end subroutine allocate_scalars !> @ brief Deallocate package scalars - !! - !! Deallocate and initialize base numerical package scalars. - !! + !! + !! Deallocate and initialize base numerical package scalars. + !! !< subroutine da(this) ! -- modules @@ -176,7 +177,6 @@ subroutine da(this) class(NumericalPackageType) :: this !< NumericalPackageType object ! ! -- deallocate - call mem_deallocate(this%input_mempath, 'INPUT_MEMPATH', this%memoryPath) call mem_deallocate(this%input_fname, 'INPUT_FNAME', this%memoryPath) call mem_deallocate(this%package_type, 'PACKAGE_TYPE', this%memoryPath) call mem_deallocate(this%id) @@ -189,18 +189,15 @@ subroutine da(this) call mem_deallocate(this%ipakcb) call mem_deallocate(this%ionper) call mem_deallocate(this%lastonper) - ! - ! -- return - return end subroutine da !> @ brief Check ionper - !! - !! Generic method to read and check ionperiod, which is used to determine - !! if new period data should be read from the input file. The check of - !! ionperiod also makes sure periods are increasing in subsequent period - !! data blocks. - !! + !! + !! Generic method to read and check ionperiod, which is used to determine + !! if new period data should be read from the input file. The check of + !! ionperiod also makes sure periods are increasing in subsequent period + !! data blocks. + !! !< subroutine read_check_ionper(this) ! -- modules @@ -221,15 +218,12 @@ subroutine read_check_ionper(this) call store_error(errmsg) call this%parser%StoreErrorUnit() end if - ! - ! -- return - return end subroutine read_check_ionper !> @ brief Read griddata block for a package - !! - !! Generic method to read data in the GRIDDATA block for a package. - !! + !! + !! Generic method to read data in the GRIDDATA block for a package. + !! !< subroutine get_block_data(this, tags, lfound, varinames) ! -- modules @@ -290,9 +284,6 @@ subroutine get_block_data(this, tags, lfound, varinames) call this%parser%StoreErrorUnit() end if end do - ! - ! -- return - return end subroutine get_block_data end module NumericalPackageModule diff --git a/src/Model/TransportModel.f90 b/src/Model/TransportModel.f90 deleted file mode 100644 index f37082cc3cb..00000000000 --- a/src/Model/TransportModel.f90 +++ /dev/null @@ -1,25 +0,0 @@ -!> @brief This module contains the base transport model type -!! -!! This module contains the base class for transport models. -!! -!< - -module TransportModelModule - use KindModule, only: DP, I4B - use ConstantsModule, only: LENFTYPE - use SimVariablesModule, only: errmsg - use NumericalModelModule, only: NumericalModelType - - implicit none - - private - - public :: TransportModelType - - type, extends(NumericalModelType) :: TransportModelType - - contains - - end type TransportModelType - -end module TransportModelModule diff --git a/src/Model/TransportModel/tsp1.f90 b/src/Model/TransportModel/tsp1.f90 new file mode 100644 index 00000000000..f1de33b333a --- /dev/null +++ b/src/Model/TransportModel/tsp1.f90 @@ -0,0 +1,879 @@ +!> @brief This module contains the base transport model type +!! +!! This module contains the base class for transport models. +!! +!< + +module TransportModelModule + use KindModule, only: DP, I4B + use VersionModule, only: write_listfile_header + use ConstantsModule, only: LENFTYPE, LINELENGTH, DZERO, LENPAKLOC, & + LENMEMPATH, LENVARNAME + use SimVariablesModule, only: errmsg + use NumericalModelModule, only: NumericalModelType + use BndModule, only: BndType, GetBndFromList + use TspIcModule, only: TspIcType + use TspFmiModule, only: TspFmiType + use TspAdvModule, only: TspAdvType + use TspSsmModule, only: TspSsmType + use TspMvtModule, only: TspMvtType + use TspOcModule, only: TspOcType + use TspObsModule, only: TspObsType + use BudgetModule, only: BudgetType + use MatrixBaseModule + + implicit none + + private + + public :: TransportModelType + + type, extends(NumericalModelType) :: TransportModelType + + ! Generalized transport package types common to either GWT or GWE + type(TspAdvType), pointer :: adv => null() !< advection package + type(TspFmiType), pointer :: fmi => null() !< flow model interface + type(TspIcType), pointer :: ic => null() !< initial conditions package + type(TspMvtType), pointer :: mvt => null() !< mover transport package + type(TspObsType), pointer :: obs => null() !< observation package + type(TspOcType), pointer :: oc => null() !< output control package + type(TspSsmType), pointer :: ssm => null() !< source sink mixing package + type(BudgetType), pointer :: budget => null() !< budget object + integer(I4B), pointer :: infmi => null() ! unit number FMI + integer(I4B), pointer :: inadv => null() !< unit number ADV + integer(I4B), pointer :: inic => null() !< unit number IC + integer(I4B), pointer :: inmvt => null() !< unit number MVT + integer(I4B), pointer :: inoc => null() !< unit number OC + integer(I4B), pointer :: inobs => null() !< unit number OBS + + integer(I4B), pointer :: inssm => null() !< unit number SSM + real(DP), pointer :: eqnsclfac => null() !< constant factor by which all terms in the model's governing equation are scaled (divided) for formulation and solution + ! Labels that will be defined + character(len=LENVARNAME) :: tsptype = '' !< "solute" or "heat" + character(len=LENVARNAME) :: depvartype = '' !< "concentration" or "temperature" + character(len=LENVARNAME) :: depvarunit = '' !< "mass" or "energy" + character(len=LENVARNAME) :: depvarunitabbrev = '' !< "M" or "E" + + contains + + ! -- public + procedure, public :: tsp_cr + procedure, public :: tsp_df + procedure, public :: tsp_da + procedure, public :: tsp_ac + procedure, public :: tsp_mc + procedure, public :: tsp_ar + procedure, public :: tsp_rp + procedure, public :: tsp_ad + procedure, public :: tsp_fc + procedure, public :: tsp_cc + procedure, public :: tsp_cq + procedure, public :: tsp_bd + procedure, public :: tsp_ot + procedure, public :: allocate_tsp_scalars + procedure, public :: set_tsp_labels + procedure, public :: ftype_check + ! -- private + procedure, private :: tsp_ot_obs + procedure, private :: tsp_ot_flow + procedure, private :: tsp_ot_flowja + procedure, private :: tsp_ot_dv + procedure, private :: tsp_ot_bdsummary + procedure, private :: create_lstfile + procedure, private :: create_tsp_packages + procedure, private :: log_namfile_options + + end type TransportModelType + +contains + + !> @brief Create a new generalized transport model object + !! + !! Create a new transport model that will be further refined into GWT or GWE + !< + subroutine tsp_cr(this, filename, id, modelname, macronym, indis) + ! -- modules + use MemoryHelperModule, only: create_mem_path + use MemoryManagerExtModule, only: mem_set_value + use SimVariablesModule, only: idm_context + use GwfNamInputModule, only: GwfNamParamFoundType + use BudgetModule, only: budget_cr + ! -- dummy + class(TransportModelType) :: this + character(len=*), intent(in) :: filename + integer(I4B), intent(in) :: id + integer(I4B), intent(inout) :: indis + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: macronym + ! -- local + character(len=LENMEMPATH) :: input_mempath + character(len=LINELENGTH) :: lst_fname + type(GwfNamParamFoundType) :: found + ! + ! -- Assign values + this%filename = filename + this%name = modelname + this%id = id + this%macronym = macronym + ! + ! -- set input model namfile memory path + input_mempath = create_mem_path(modelname, 'NAM', idm_context) + ! + ! -- copy option params from input context + call mem_set_value(lst_fname, 'LIST', input_mempath, found%list) + call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, & + found%print_input) + call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, & + found%print_flows) + call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, found%save_flows) + ! + ! -- create the list file + call this%create_lstfile(lst_fname, filename, found%list) + ! + ! -- activate save_flows if found + if (found%save_flows) then + this%ipakcb = -1 + end if + ! + ! -- log set options + if (this%iout > 0) then + call this%log_namfile_options(found) + end if + ! + ! -- Create utility objects + call budget_cr(this%budget, this%name) + ! + ! -- create model packages + call this%create_tsp_packages(indis) + ! + ! -- Return + return + end subroutine tsp_cr + + !> @brief Generalized transport model define model + !! + !! This subroutine extended by either GWT or GWE. This routine calls the + !! define (df) routines for each attached package and sets variables and + !! pointers. + !< + subroutine tsp_df(this) + ! -- dummy variables + class(TransportModelType) :: this + ! + ! -- Return + return + end subroutine tsp_df + + !> @brief Generalized transport model add connections + !! + !! This subroutine extended by either GWT or GWE. This routine adds the + !! internal connections of this model to the sparse matrix + !< + subroutine tsp_ac(this, sparse) + ! -- modules + use SparseModule, only: sparsematrix + ! -- dummy variables + class(TransportModelType) :: this + type(sparsematrix), intent(inout) :: sparse + ! -- local + ! + ! -- Return + return + end subroutine tsp_ac + + !> @brief Generalized transport model map coefficients + !! + !! This subroutine extended by either GWT or GWE. This routine maps the + !! positions of this models connections in the numerical solution coefficient + !! matrix. + !< + subroutine tsp_mc(this, matrix_sln) + ! -- dummy + class(TransportModelType) :: this + class(MatrixBaseType), pointer :: matrix_sln !< global system matrix + ! -- local + ! + ! -- Return + return + end subroutine tsp_mc + + !> @brief Generalized transport model allocate and read + !! + !! This subroutine extended by either GWT or GWE. This routine calls + !! the allocate and reads (ar) routines of attached packages and allocates + !! memory for arrays required by the model object. + !< + subroutine tsp_ar(this) + ! -- dummy variables + class(TransportModelType) :: this + ! + ! -- Return + return + end subroutine tsp_ar + + !> @brief Generalized transport model read and prepare + !! + !! This subroutine extended by either GWT or GWE. This routine calls + !! the read and prepare (rp) routines of attached packages. + !< + subroutine tsp_rp(this) + ! -- dummy variables + class(TransportModelType) :: this + ! + ! -- Return + return + end subroutine tsp_rp + + !> @brief Generalized transport model time step advance + !! + !! This subroutine extended by either GWT or GWE. This routine calls + !! the advance time step (ad) routines of attached packages. + !< + subroutine tsp_ad(this) + ! -- dummy variables + class(TransportModelType) :: this + ! + ! -- Return + return + end subroutine tsp_ad + + !> @brief Generalized transport model fill coefficients + !! + !! This subroutine extended by either GWT or GWE. This routine calls + !! the fill coefficients (fc) routines of attached packages. + !< + subroutine tsp_fc(this, kiter, matrix_sln, inwtflag) + ! -- dummy variables + class(TransportModelType) :: this + integer(I4B), intent(in) :: kiter + class(MatrixBaseType), pointer :: matrix_sln + integer(I4B), intent(in) :: inwtflag + ! + ! -- Return + return + end subroutine tsp_fc + + !> @brief Generalized transport model final convergence check + !! + !! This subroutine extended by either GWT or GWE. This routine calls + !! the convergence check (cc) routines of attached packages. + !< + subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: innertot + integer(I4B), intent(in) :: kiter + integer(I4B), intent(in) :: iend + integer(I4B), intent(in) :: icnvgmod + character(len=LENPAKLOC), intent(inout) :: cpak + integer(I4B), intent(inout) :: ipak + real(DP), intent(inout) :: dpak + ! -- local + ! + ! -- Return + return + end subroutine tsp_cc + + !> @brief Generalized transport model calculate flows + !! + !! This subroutine extended by either GWT or GWE. This routine calculates + !! intercell flows (flowja) + !< + subroutine tsp_cq(this, icnvg, isuppress_output) + ! -- dummy variables + class(TransportModelType) :: this + integer(I4B), intent(in) :: icnvg + integer(I4B), intent(in) :: isuppress_output + ! -- local + ! + ! -- Return + return + end subroutine tsp_cq + + !> @brief Generalized transport model budget + !! + !! This subroutine extended by either GWT or GWE. This routine calculates + !! package contributions to model budget + !< + subroutine tsp_bd(this, icnvg, isuppress_output) + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: icnvg + integer(I4B), intent(in) :: isuppress_output + ! + ! -- Return + return + end subroutine tsp_bd + + !> @brief Generalized transport model output routine + !! + !! Generalized transport model output + !< + subroutine tsp_ot(this, inmst) + ! -- modules + use TdisModule, only: kstp, kper, tdis_ot, endofperiod + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: inmst + ! -- local + integer(I4B) :: idvsave + integer(I4B) :: idvprint + integer(I4B) :: icbcfl + integer(I4B) :: icbcun + integer(I4B) :: ibudfl + integer(I4B) :: ipflag + ! -- formats + character(len=*), parameter :: fmtnocnvg = & + "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', & + &I0,' OF STRESS PERIOD ',I0,'****')" + ! + ! -- Set write and print flags + idvsave = 0 + idvprint = 0 + icbcfl = 0 + ibudfl = 0 + if (this%oc%oc_save(trim(this%depvartype))) idvsave = 1 + if (this%oc%oc_print(trim(this%depvartype))) idvprint = 1 + if (this%oc%oc_save('BUDGET')) icbcfl = 1 + if (this%oc%oc_print('BUDGET')) ibudfl = 1 + icbcun = this%oc%oc_save_unit('BUDGET') + ! + ! -- Override ibudfl and idvprint flags for nonconvergence + ! and end of period + ibudfl = this%oc%set_print_flag('BUDGET', this%icnvg, endofperiod) + idvprint = this%oc%set_print_flag(trim(this%depvartype), & + this%icnvg, endofperiod) + ! + ! Calculate and save observations + call this%tsp_ot_obs() + ! + ! Save and print flows + call this%tsp_ot_flow(icbcfl, ibudfl, icbcun, inmst) + ! + ! Save and print dependent variables + call this%tsp_ot_dv(idvsave, idvprint, ipflag) + ! + ! Print budget summaries + call this%tsp_ot_bdsummary(ibudfl, ipflag) + ! + ! -- Timing Output; if any dependendent variables or budgets + ! are printed, then ipflag is set to 1. + if (ipflag == 1) call tdis_ot(this%iout) + ! + ! -- Write non-convergence message + if (this%icnvg == 0) then + write (this%iout, fmtnocnvg) kstp, kper + end if + ! + ! -- Return + return + end subroutine tsp_ot + + !> @brief Generalized transport model output routine + !! + !! Calculate and save observations + !< + subroutine tsp_ot_obs(this) + class(TransportModelType) :: this + class(BndType), pointer :: packobj + integer(I4B) :: ip + ! -- Calculate and save observations + call this%obs%obs_bd() + call this%obs%obs_ot() + + ! -- Calculate and save package obserations + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_bd_obs() + call packobj%bnd_ot_obs() + end do + + end subroutine tsp_ot_obs + + !> @brief Generalized transport model output routine + !! + !! Save and print flows + !< + subroutine tsp_ot_flow(this, icbcfl, ibudfl, icbcun, inmst) + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: icbcfl + integer(I4B), intent(in) :: ibudfl + integer(I4B), intent(in) :: icbcun + integer(I4B), intent(in) :: inmst + ! -- local + class(BndType), pointer :: packobj + integer(I4B) :: ip + ! + ! -- Save TSP flows + call this%tsp_ot_flowja(this%nja, this%flowja, icbcfl, icbcun) + if (this%infmi > 0) call this%fmi%fmi_ot_flow(icbcfl, icbcun) + if (this%inssm > 0) then + call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun) + end if + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun) + end do + + ! -- Save advanced package flows + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0) + end do + if (this%inmvt > 0) then + call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl) + end if + + ! -- Print Model (GWT or GWE) flows + ! no need to print flowja + ! no need to print mst + ! no need to print fmi + if (this%inssm > 0) then + call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0) + end if + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0) + end do + + ! -- Print advanced package flows + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl) + end do + if (this%inmvt > 0) then + call this%mvt%mvt_ot_printflow(icbcfl, ibudfl) + end if + + end subroutine tsp_ot_flow + + !> @brief Generalized transport model output routine + !! + !! Write intercell flows for the transport model + !< + subroutine tsp_ot_flowja(this, nja, flowja, icbcfl, icbcun) + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: nja + real(DP), dimension(nja), intent(in) :: flowja + integer(I4B), intent(in) :: icbcfl + integer(I4B), intent(in) :: icbcun + ! -- local + integer(I4B) :: ibinun + ! -- formats + ! + ! -- Set unit number for binary output + if (this%ipakcb < 0) then + ibinun = icbcun + elseif (this%ipakcb == 0) then + ibinun = 0 + else + ibinun = this%ipakcb + end if + if (icbcfl == 0) ibinun = 0 + ! + ! -- Write the face flows if requested + if (ibinun /= 0) then + call this%dis%record_connection_array(flowja, ibinun, this%iout) + end if + ! + ! -- Return + return + end subroutine tsp_ot_flowja + + !> @brief Generalized tranpsort model output routine + !! + !! Loop through attached packages saving and printing dependent variables + !< + subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag) + class(TransportModelType) :: this + integer(I4B), intent(in) :: idvsave + integer(I4B), intent(in) :: idvprint + integer(I4B), intent(inout) :: ipflag + class(BndType), pointer :: packobj + integer(I4B) :: ip + ! + ! -- Print advanced package dependent variables + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_dv(idvsave, idvprint) + end do + + ! -- save head and print head + call this%oc%oc_ot(ipflag) + ! + ! -- Return + return + end subroutine tsp_ot_dv + + !> @brief Generalized tranpsort model output budget summary + !! + !! Loop through attached packages and write budget summaries + !< + subroutine tsp_ot_bdsummary(this, ibudfl, ipflag) + use TdisModule, only: kstp, kper, totim + class(TransportModelType) :: this + integer(I4B), intent(in) :: ibudfl + integer(I4B), intent(inout) :: ipflag + class(BndType), pointer :: packobj + integer(I4B) :: ip + ! + ! -- Package budget summary + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl) + end do + + ! -- mover budget summary + if (this%inmvt > 0) then + call this%mvt%mvt_ot_bdsummary(ibudfl) + end if + + ! -- model budget summary + if (ibudfl /= 0) then + ipflag = 1 + call this%budget%budget_ot(kstp, kper, this%iout) + end if + + ! -- Write to budget csv + call this%budget%writecsv(totim) + ! + ! -- Return + return + end subroutine tsp_ot_bdsummary + + !> @brief Allocate scalar variables for transport model + !! + !! Method to allocate memory for non-allocatable members. + !< + subroutine allocate_tsp_scalars(this, modelname) + ! -- modules + use MemoryManagerModule, only: mem_allocate + ! -- dummy + class(TransportModelType) :: this + character(len=*), intent(in) :: modelname + ! + ! -- allocate members from (grand)parent class + call this%NumericalModelType%allocate_scalars(modelname) + ! + ! -- allocate members that are part of model class + call mem_allocate(this%inic, 'INIC', this%memoryPath) + call mem_allocate(this%infmi, 'INFMI', this%memoryPath) + call mem_allocate(this%inmvt, 'INMVT', this%memoryPath) + call mem_allocate(this%inadv, 'INADV', this%memoryPath) + call mem_allocate(this%inssm, 'INSSM', this%memoryPath) + call mem_allocate(this%inoc, 'INOC ', this%memoryPath) + call mem_allocate(this%inobs, 'INOBS', this%memoryPath) + call mem_allocate(this%eqnsclfac, 'EQNSCLFAC', this%memoryPath) + ! + this%inic = 0 + this%infmi = 0 + this%inmvt = 0 + this%inadv = 0 + this%inssm = 0 + this%inoc = 0 + this%inobs = 0 + this%eqnsclfac = DZERO + ! + ! -- Return + return + end subroutine allocate_tsp_scalars + + !> @brief Define the labels corresponding to the flavor of + !! transport model + !! + !! Set variable names according to type of transport model + !< + subroutine set_tsp_labels(this, tsptype, depvartype, depvarunit, & + depvarunitabbrev) + class(TransportModelType) :: this + character(len=*), intent(in), pointer :: tsptype !< type of model, default is GWT (alternative is GWE) + character(len=*), intent(in) :: depvartype !< dependent variable type, default is "CONCENTRATION" + character(len=*), intent(in) :: depvarunit !< units of dependent variable for writing to list file + character(len=*), intent(in) :: depvarunitabbrev !< abbreviation of associated units + ! + ! -- Set the model type + this%tsptype = tsptype + ! + ! -- Set the type of dependent variable being solved for + this%depvartype = depvartype + ! + ! -- Set the units associated with the dependent variable + this%depvarunit = depvarunit + ! + ! -- Set the units abbreviation + this%depvarunitabbrev = depvarunitabbrev + ! + ! -- Return + return + end subroutine set_tsp_labels + + !> @brief Deallocate memory + !! + !! Deallocate memmory at conclusion of model run + !< + subroutine tsp_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(TransportModelType) :: this + ! -- local + ! + ! -- Scalars + call mem_deallocate(this%inic) + call mem_deallocate(this%infmi) + call mem_deallocate(this%inadv) + call mem_deallocate(this%inssm) + call mem_deallocate(this%inmvt) + call mem_deallocate(this%inoc) + call mem_deallocate(this%inobs) + call mem_deallocate(this%eqnsclfac) + ! + ! -- Return + return + end subroutine tsp_da + + !> @brief Generalized tranpsort model routine + !! + !! Check to make sure required input files have been specified + !< + subroutine ftype_check(this, indis, inmst) + ! -- modules + use ConstantsModule, only: LINELENGTH + use SimModule, only: store_error, count_errors, store_error_filename + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(in) :: indis + integer(I4B), intent(in) :: inmst + ! -- local + character(len=LINELENGTH) :: errmsg +! ------------------------------------------------------------------------------ + ! + ! -- Check for IC6, DIS(u), and MST. Stop if not present. + if (this%inic == 0) then + write (errmsg, '(a)') & + 'Initial conditions (IC6) package not specified.' + call store_error(errmsg) + end if + if (indis == 0) then + write (errmsg, '(a)') & + 'Discretization (DIS6 or DISU6) package not specified.' + call store_error(errmsg) + end if + if (inmst == 0) then + write (errmsg, '(a)') 'Mass storage and transfer (MST6) & + &package not specified.' + call store_error(errmsg) + end if + ! + if (count_errors() > 0) then + write (errmsg, '(a)') 'Required package(s) not specified.' + call store_error(errmsg) + call store_error_filename(this%filename) + end if + ! + ! -- Return + return + end subroutine ftype_check + + !> @brief Create listing output file + !< + subroutine create_lstfile(this, lst_fname, model_fname, defined) + ! -- modules + use KindModule, only: LGP + use InputOutputModule, only: openfile, getunit + ! -- dummy + class(TransportModelType) :: this + character(len=*), intent(inout) :: lst_fname + character(len=*), intent(in) :: model_fname + logical(LGP), intent(in) :: defined + ! -- local + integer(I4B) :: i, istart, istop + ! + ! -- set list file name if not provided + if (.not. defined) then + ! + ! -- initialize + lst_fname = ' ' + istart = 0 + istop = len_trim(model_fname) + ! + ! -- identify '.' character position from back of string + do i = istop, 1, -1 + if (model_fname(i:i) == '.') then + istart = i + exit + end if + end do + ! + ! -- if not found start from string end + if (istart == 0) istart = istop + 1 + ! + ! -- set list file name + lst_fname = model_fname(1:istart) + istop = istart + 3 + lst_fname(istart:istop) = '.lst' + end if + ! + ! -- create the list file + this%iout = getunit() + call openfile(this%iout, 0, lst_fname, 'LIST', filstat_opt='REPLACE') + ! + ! -- write list file header + call write_listfile_header(this%iout, 'GROUNDWATER TRANSPORT MODEL (GWT)') + ! + ! -- Return + return + end subroutine create_lstfile + + !> @brief Write model name file options to list file + !< + subroutine log_namfile_options(this, found) + use GwfNamInputModule, only: GwfNamParamFoundType + class(TransportModelType) :: this + type(GwfNamParamFoundType), intent(in) :: found + ! + write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:' + ! + if (found%newton) then + write (this%iout, '(4x,a)') & + 'NEWTON-RAPHSON method enabled for the model.' + if (found%under_relaxation) then + write (this%iout, '(4x,a,a)') & + 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', & + 'elevation of the model will be applied to the model.' + end if + end if + ! + if (found%print_input) then + write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// & + 'FOR ALL MODEL STRESS PACKAGES' + end if + ! + if (found%print_flows) then + write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// & + 'FOR ALL MODEL PACKAGES' + end if + ! + if (found%save_flows) then + write (this%iout, '(4x,a)') & + 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL' + end if + ! + write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:' + ! + ! -- Return + return + end subroutine log_namfile_options + + !> @brief Source package info and begin to process + !< + subroutine create_tsp_packages(this, indis) + ! -- modules + use ConstantsModule, only: LINELENGTH, LENPACKAGENAME + use CharacterStringModule, only: CharacterStringType + use ArrayHandlersModule, only: expandarray + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path + use SimVariablesModule, only: idm_context + use GwfDisModule, only: dis_cr + use GwfDisvModule, only: disv_cr + use GwfDisuModule, only: disu_cr + use TspIcModule, only: ic_cr + use TspFmiModule, only: fmi_cr + use TspAdvModule, only: adv_cr + use TspSsmModule, only: ssm_cr + use TspMvtModule, only: mvt_cr + use TspOcModule, only: oc_cr + use TspObsModule, only: tsp_obs_cr + ! -- dummy + class(TransportModelType) :: this + integer(I4B), intent(inout) :: indis ! DIS enabled flag + ! -- local + type(CharacterStringType), dimension(:), contiguous, & + pointer :: pkgtypes => null() + type(CharacterStringType), dimension(:), contiguous, & + pointer :: pkgnames => null() + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mempaths => null() + integer(I4B), dimension(:), contiguous, & + pointer :: inunits => null() + character(len=LENMEMPATH) :: model_mempath + character(len=LENFTYPE) :: pkgtype + character(len=LENPACKAGENAME) :: pkgname + character(len=LENMEMPATH) :: mempath + integer(I4B), pointer :: inunit + integer(I4B) :: n + character(len=LENMEMPATH) :: mempathic = '' + ! + ! -- Initialize + indis = 0 + ! + ! -- set input memory paths, input/model and input/model/namfile + model_mempath = create_mem_path(component=this%name, context=idm_context) + ! + ! -- set pointers to model path package info + call mem_setptr(pkgtypes, 'PKGTYPES', model_mempath) + call mem_setptr(pkgnames, 'PKGNAMES', model_mempath) + call mem_setptr(mempaths, 'MEMPATHS', model_mempath) + call mem_setptr(inunits, 'INUNITS', model_mempath) + ! + do n = 1, size(pkgtypes) + ! + ! attributes for this input package + pkgtype = pkgtypes(n) + pkgname = pkgnames(n) + mempath = mempaths(n) + inunit => inunits(n) + ! + ! -- create dis package as it is a prerequisite for other packages + select case (pkgtype) + case ('DIS6') + indis = 1 + call dis_cr(this%dis, this%name, mempath, indis, this%iout) + case ('DISV6') + indis = 1 + call disv_cr(this%dis, this%name, mempath, indis, this%iout) + case ('DISU6') + indis = 1 + call disu_cr(this%dis, this%name, mempath, indis, this%iout) + case ('IC6') + this%inic = 1 + mempathic = mempath + case ('FMI6') + this%infmi = inunit + case ('MVT6') + this%inmvt = inunit + case ('ADV6') + this%inadv = inunit + case ('SSM6') + this%inssm = inunit + case ('OC6') + this%inoc = inunit + case ('OBS6') + this%inobs = inunit + !case default + ! TODO + end select + end do + ! + ! -- Create packages that are tied directly to model + call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis, & + this%depvartype) + call fmi_cr(this%fmi, this%name, this%infmi, this%iout, this%eqnsclfac, & + this%depvartype) + call adv_cr(this%adv, this%name, this%inadv, this%iout, this%fmi, & + this%eqnsclfac) + call ssm_cr(this%ssm, this%name, this%inssm, this%iout, this%fmi, & + this%eqnsclfac, this%depvartype) + call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi, & + this%eqnsclfac) + call oc_cr(this%oc, this%name, this%inoc, this%iout) + call tsp_obs_cr(this%obs, this%inobs) + ! + ! -- Return + return + end subroutine create_tsp_packages + +end module TransportModelModule diff --git a/src/Model/GroundWaterTransport/gwt1adv1.f90 b/src/Model/TransportModel/tsp1adv1.f90 similarity index 70% rename from src/Model/GroundWaterTransport/gwt1adv1.f90 rename to src/Model/TransportModel/tsp1adv1.f90 index 0e9f4bdb487..f08d61351ca 100644 --- a/src/Model/GroundWaterTransport/gwt1adv1.f90 +++ b/src/Model/TransportModel/tsp1adv1.f90 @@ -1,23 +1,24 @@ -module GwtAdvModule +module TspAdvModule use KindModule, only: DP, I4B use ConstantsModule, only: DONE, DZERO, DHALF, DTWO use NumericalPackageModule, only: NumericalPackageType use BaseDisModule, only: DisBaseType - use GwtFmiModule, only: GwtFmiType - use GwtAdvOptionsModule, only: GwtAdvOptionsType + use TspFmiModule, only: TspFmiType + use TspAdvOptionsModule, only: TspAdvOptionsType use MatrixBaseModule implicit none private - public :: GwtAdvType + public :: TspAdvType public :: adv_cr - type, extends(NumericalPackageType) :: GwtAdvType + type, extends(NumericalPackageType) :: TspAdvType integer(I4B), pointer :: iadvwt => null() !< advection scheme (0 up, 1 central, 2 tvd) integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound - type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object + type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object + real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy contains @@ -34,24 +35,22 @@ module GwtAdvModule procedure :: adv_weight procedure :: advtvd - end type GwtAdvType + end type TspAdvType contains - subroutine adv_cr(advobj, name_model, inunit, iout, fmi) -! ****************************************************************************** -! adv_cr -- Create a new ADV object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @ brief Create a new ADV object + !! + !! Create a new ADV package + !< + subroutine adv_cr(advobj, name_model, inunit, iout, fmi, eqnsclfac) ! -- dummy - type(GwtAdvType), pointer :: advobj + type(TspAdvType), pointer :: advobj character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout - type(GwtFmiType), intent(in), target :: fmi -! ------------------------------------------------------------------------------ + type(TspFmiType), intent(in), target :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor ! ! -- Create the object allocate (advobj) @@ -66,15 +65,21 @@ subroutine adv_cr(advobj, name_model, inunit, iout, fmi) advobj%inunit = inunit advobj%iout = iout advobj%fmi => fmi + advobj%eqnsclfac => eqnsclfac ! ! -- Return return end subroutine adv_cr + !> @brief Define ADV object + !! + !! Define the ADV package + !< subroutine adv_df(this, adv_options) - class(GwtAdvType) :: this - type(GwtAdvOptionsType), optional, intent(in) :: adv_options !< the optional options, for when not constructing from file - ! local + ! -- dummy + class(TspAdvType) :: this + type(TspAdvOptionsType), optional, intent(in) :: adv_options !< the optional options, for when not constructing from file + ! -- local character(len=*), parameter :: fmtadv = & "(1x,/1x,'ADV-- ADVECTION PACKAGE, VERSION 1, 8/25/2017', & &' INPUT READ FROM UNIT ', i0, //)" @@ -96,24 +101,23 @@ subroutine adv_df(this, adv_options) ! --set options from input arg this%iadvwt = adv_options%iAdvScheme end if - + ! + ! -- Return + return end subroutine adv_df + !> @brief Allocate and read method for package + !! + !! Method to allocate and read static data for the ADV package. + !< subroutine adv_ar(this, dis, ibound) -! ****************************************************************************** -! adv_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this class(DisBaseType), pointer, intent(in) :: dis - integer(I4B), dimension(:), pointer, contiguous :: ibound + integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ibound ! -- local ! -- formats -! ------------------------------------------------------------------------------ ! ! -- adv pointers to arguments that were passed in this%dis => dis @@ -123,16 +127,14 @@ subroutine adv_ar(this, dis, ibound) return end subroutine adv_ar + !> @brief Fill coefficient method for ADV package + !! + !! Method to calculate coefficients and fill amat and rhs. + !< subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs) -! ****************************************************************************** -! adv_fc -- Calculate coefficients and fill amat and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this integer, intent(in) :: nodes class(MatrixBaseType), pointer :: matrix_sln integer(I4B), intent(in), dimension(:) :: idxglo @@ -141,7 +143,6 @@ subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs) ! -- local integer(I4B) :: n, m, idiag, ipos real(DP) :: omega, qnm -! ------------------------------------------------------------------------------ ! ! -- Calculate advection terms and add to solution rhs and hcof. qnm ! is the volumetric flow rate and has dimensions of L^/T. @@ -152,7 +153,7 @@ subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs) if (this%dis%con%mask(ipos) == 0) cycle m = this%dis%con%ja(ipos) if (this%ibound(m) == 0) cycle - qnm = this%fmi%gwfflowja(ipos) + qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac omega = this%adv_weight(this%iadvwt, ipos, n, m, qnm) call matrix_sln%add_value_pos(idxglo(ipos), qnm * (DONE - omega)) call matrix_sln%add_value_pos(idxglo(idiag), qnm * omega) @@ -171,23 +172,21 @@ subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs) return end subroutine adv_fc + !> @brief Calculate TVD + !! + !! Use explicit scheme to calculate the advective component of transport. + !! TVD is an acronym for Total-Variation Diminishing + !< subroutine advtvd(this, n, cnew, rhs) -! ****************************************************************************** -! advtvd -- Calculate TVD -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this integer(I4B), intent(in) :: n real(DP), dimension(:), intent(in) :: cnew real(DP), dimension(:), intent(inout) :: rhs ! -- local real(DP) :: qtvd integer(I4B) :: m, ipos -! ------------------------------------------------------------------------------ ! ! -- Loop through each n connection. This will do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 @@ -204,19 +203,18 @@ subroutine advtvd(this, n, cnew, rhs) return end subroutine advtvd + !> @brief Calculate TVD + !! + !! Use explicit scheme to calculate the advective component of transport. + !! TVD is an acronym for Total-Variation Diminishing + !< function advqtvd(this, n, m, iposnm, cnew) result(qtvd) -! ****************************************************************************** -! advqtvd -- Calculate TVD -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DPREC ! -- return real(DP) :: qtvd ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this integer(I4B), intent(in) :: n integer(I4B), intent(in) :: m integer(I4B), intent(in) :: iposnm @@ -225,7 +223,6 @@ function advqtvd(this, n, m, iposnm, cnew) result(qtvd) integer(I4B) :: ipos, isympos, iup, idn, i2up, j real(DP) :: qnm, qmax, qupj, elupdn, elup2up real(DP) :: smooth, cdiff, alimiter -! ------------------------------------------------------------------------------ ! ! -- intialize qtvd = DZERO @@ -269,6 +266,7 @@ function advqtvd(this, n, m, iposnm, cnew) result(qtvd) if (smooth > DZERO) then alimiter = DTWO * smooth / (DONE + smooth) qtvd = DHALF * alimiter * qnm * (cnew(idn) - cnew(iup)) + qtvd = qtvd * this%eqnsclfac end if end if ! @@ -276,23 +274,18 @@ function advqtvd(this, n, m, iposnm, cnew) result(qtvd) return end function advqtvd + !> @brief Calculate advection contribution to flowja + !< subroutine adv_cq(this, cnew, flowja) -! ****************************************************************************** -! adv_cq -- Calculate advection contribution to flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this real(DP), intent(in), dimension(:) :: cnew real(DP), intent(inout), dimension(:) :: flowja ! -- local integer(I4B) :: nodes integer(I4B) :: n, m, idiag, ipos real(DP) :: omega, qnm -! ------------------------------------------------------------------------------ ! ! -- Calculate advection and add to flowja. qnm is the volumetric flow ! rate and has dimensions of L^/T. @@ -303,7 +296,7 @@ subroutine adv_cq(this, cnew, flowja) do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 m = this%dis%con%ja(ipos) if (this%ibound(m) == 0) cycle - qnm = this%fmi%gwfflowja(ipos) + qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac omega = this%adv_weight(this%iadvwt, ipos, n, m, qnm) flowja(ipos) = flowja(ipos) + qnm * omega * cnew(n) + & qnm * (DONE - omega) * cnew(m) @@ -317,22 +310,16 @@ subroutine adv_cq(this, cnew, flowja) return end subroutine adv_cq + !> @brief Add TVD contribution to flowja subroutine advtvd_bd(this, cnew, flowja) -! ****************************************************************************** -! advtvd_bd -- Add TVD contribution to flowja -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this real(DP), dimension(:), intent(in) :: cnew real(DP), dimension(:), intent(inout) :: flowja ! -- local real(DP) :: qtvd, qnm integer(I4B) :: nodes, n, m, ipos -! ------------------------------------------------------------------------------ ! nodes = this%dis%nodes do n = 1, nodes @@ -351,18 +338,13 @@ subroutine advtvd_bd(this, cnew, flowja) return end subroutine advtvd_bd + !> @brief Deallocate memory + !< subroutine adv_da(this) -! ****************************************************************************** -! adv_da -- Deallocate variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy - class(GwtAdvType) :: this -! ------------------------------------------------------------------------------ + class(TspAdvType) :: this ! ! -- Deallocate arrays if package was active if (this%inunit > 0) then @@ -381,17 +363,14 @@ subroutine adv_da(this) return end subroutine adv_da + !> @brief Allocate scalars specific to the streamflow energy transport (SFE) + !! package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this ! -- local ! ------------------------------------------------------------------------------ ! @@ -411,18 +390,16 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Read options + !! + !! Read the options block + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this ! -- local character(len=LINELENGTH) :: errmsg, keyword integer(I4B) :: ierr @@ -430,7 +407,6 @@ subroutine read_options(this) ! -- formats character(len=*), parameter :: fmtiadvwt = & &"(4x,'ADVECTION WEIGHTING SCHEME HAS BEEN SET TO: ', a)" -! ------------------------------------------------------------------------------ ! ! -- get options block call this%parser%GetBlock('OPTIONS', isfound, ierr, blockRequired=.false., & @@ -478,17 +454,15 @@ subroutine read_options(this) return end subroutine read_options + !> @ brief Advection weight + !! + !! Calculate the advection weight + !< function adv_weight(this, iadvwt, ipos, n, m, qnm) result(omega) -! ****************************************************************************** -! adv_weight -- calculate advection weight -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: omega ! -- dummy - class(GwtAdvType) :: this + class(TspAdvType) :: this integer, intent(in) :: iadvwt integer, intent(in) :: ipos integer, intent(in) :: n @@ -524,4 +498,4 @@ function adv_weight(this, iadvwt, ipos, n, m, qnm) result(omega) return end function adv_weight -end module GwtAdvModule +end module TspAdvModule diff --git a/src/Model/GroundWaterTransport/gwt1apt1.f90 b/src/Model/TransportModel/tsp1apt1.f90 similarity index 77% rename from src/Model/GroundWaterTransport/gwt1apt1.f90 rename to src/Model/TransportModel/tsp1apt1.f90 index 6f50995ac4c..4d2bb855b0d 100644 --- a/src/Model/GroundWaterTransport/gwt1apt1.f90 +++ b/src/Model/TransportModel/tsp1apt1.f90 @@ -12,12 +12,12 @@ ! FLOW-JA-FACE idxbudfjf FLOW-JA-FACE cv2cv ! GWF (aux FLOW-AREA) idxbudgwf GWF cv2gwf ! STORAGE (aux VOLUME) idxbudsto none used for cv volumes -! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:) +! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:) ! rhow*cpw is applied to various terms for heat transport ! TO-MVR idxbudtmvr TO-MVR q * cfeat ! -- generalized source/sink terms (except ET?) ! RAINFALL idxbudrain RAINFALL q * crain -! EVAPORATION idxbudevap EVAPORATION cfeat null() !< active, inactive, constant - character(len=LENAUXNAME) :: cauxfpconc = '' !< name of aux column in flow package auxvar array for concentration + character(len=LENAUXNAME) :: cauxfpconc = '' !< name of aux column in flow package auxvar array for concentration (or temperature) integer(I4B), pointer :: iauxfpconc => null() !< column in flow package bound array to insert concs integer(I4B), pointer :: imatrows => null() !< if active, add new rows to matrix integer(I4B), pointer :: iprconc => null() !< print conc to listing file @@ -76,7 +77,10 @@ module GwtAptModule integer(I4B), pointer :: ibudcsv => null() !< unit number for csv budget output file integer(I4B), pointer :: ncv => null() !< number of control volumes integer(I4B), pointer :: igwfaptpak => null() !< package number of corresponding this package - real(DP), dimension(:), pointer, contiguous :: strt => null() !< starting feature concentration + integer(I4B), pointer :: idxprepak => null() !< budget-object index that precedes package-specific budget objects + integer(I4B), pointer :: idxlastpak => null() !< budget-object index of last package-specific budget object + real(DP), dimension(:), pointer, contiguous :: strt => null() !< starting feature concentration (or temperature) + real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed/lakebed/filter-pack material through which thermal conduction occurs integer(I4B), dimension(:), pointer, contiguous :: idxlocnode => null() !< map position in global rhs and x array of pack entry integer(I4B), dimension(:), pointer, contiguous :: idxpakdiag => null() !< map diag position of feature in global amat integer(I4B), dimension(:), pointer, contiguous :: idxdglo => null() !< map position in global array of package diagonal row entries @@ -86,16 +90,16 @@ module GwtAptModule integer(I4B), dimension(:), pointer, contiguous :: idxfjfdglo => null() !< map diagonal feature to feature in global amat integer(I4B), dimension(:), pointer, contiguous :: idxfjfoffdglo => null() !< map off diagonal feature to feature in global amat integer(I4B), dimension(:), pointer, contiguous :: iboundpak => null() !< package ibound - real(DP), dimension(:), pointer, contiguous :: xnewpak => null() !< feature concentration for current time step - real(DP), dimension(:), pointer, contiguous :: xoldpak => null() !< feature concentration from previous time step + real(DP), dimension(:), pointer, contiguous :: xnewpak => null() !< feature concentration (or temperature) for current time step + real(DP), dimension(:), pointer, contiguous :: xoldpak => null() !< feature concentration (or temperature) from previous time step real(DP), dimension(:), pointer, contiguous :: dbuff => null() !< temporary storage array character(len=LENBOUNDNAME), & dimension(:), pointer, contiguous :: featname => null() - real(DP), dimension(:), pointer, contiguous :: concfeat => null() !< concentration of the feature + real(DP), dimension(:), pointer, contiguous :: concfeat => null() !< concentration (or temperature) of the feature real(DP), dimension(:, :), pointer, contiguous :: lauxvar => null() !< auxiliary variable - type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object - real(DP), dimension(:), pointer, contiguous :: qsto => null() !< mass flux due to storage change - real(DP), dimension(:), pointer, contiguous :: ccterm => null() !< mass flux required to maintain constant concentration + type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object + real(DP), dimension(:), pointer, contiguous :: qsto => null() !< mass (or energy) flux due to storage change + real(DP), dimension(:), pointer, contiguous :: ccterm => null() !< mass (or energy) flux required to maintain constant concentration (or temperature) integer(I4B), pointer :: idxbudfjf => null() !< index of flow ja face in flowbudptr integer(I4B), pointer :: idxbudgwf => null() !< index of gwf terms in flowbudptr integer(I4B), pointer :: idxbudsto => null() !< index of storage terms in flowbudptr @@ -104,8 +108,12 @@ module GwtAptModule integer(I4B), pointer :: idxbudaux => null() !< index of auxiliary terms in flowbudptr integer(I4B), dimension(:), pointer, contiguous :: idxbudssm => null() !< flag that flowbudptr%buditem is a general solute source/sink integer(I4B), pointer :: nconcbudssm => null() !< number of concbudssm terms (columns) - real(DP), dimension(:, :), pointer, contiguous :: concbudssm => null() !< user specified concentrations for flow terms - real(DP), dimension(:), pointer, contiguous :: qmfrommvr => null() !< a mass flow coming from the mover that needs to be added + real(DP), dimension(:, :), pointer, contiguous :: concbudssm => null() !< user specified concentrations (or temperatures) for flow terms + real(DP), dimension(:), pointer, contiguous :: qmfrommvr => null() !< a mass or energy flow coming from the mover that needs to be added + real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy + character(len=LENVARNAME) :: depvartype = '' !< stores string identifying dependent variable type, depending on model type + character(len=LENVARNAME) :: depvarunit = '' !< "mass" or "energy" + character(len=LENVARNAME) :: depvarunitabbrev = '' !< "M" or "E" ! ! -- pointer to flow package boundary type(BndType), pointer :: flowpackagebnd => null() @@ -125,12 +133,12 @@ module GwtAptModule procedure :: bnd_ar => apt_ar procedure :: bnd_rp => apt_rp procedure :: bnd_ad => apt_ad - procedure :: bnd_cf => apt_cf + procedure :: bnd_reset => apt_reset procedure :: bnd_fc => apt_fc - procedure, private :: apt_fc_expanded + procedure, public :: apt_fc_expanded ! Made public for uze procedure :: pak_fc_expanded procedure, private :: apt_fc_nonexpanded - procedure, private :: apt_cfupdate + procedure, public :: apt_cfupdate ! Made public for uze procedure :: apt_check_valid procedure :: apt_set_stressperiod procedure :: pak_set_stressperiod @@ -168,27 +176,24 @@ module GwtAptModule procedure :: pak_setup_budobj procedure :: apt_fill_budobj procedure :: pak_fill_budobj - procedure, private :: apt_stor_term - procedure, private :: apt_tmvr_term - procedure, private :: apt_fjf_term + procedure, public :: apt_stor_term + procedure, public :: apt_tmvr_term + procedure, public :: apt_fmvr_term ! Made public for uze + procedure, public :: apt_fjf_term ! Made public for uze procedure, private :: apt_copy2flowp procedure, private :: apt_setup_tableobj - end type GwtAptType + end type TspAptType contains + !> @brief Add package connection to matrix + !< subroutine apt_ac(this, moffset, sparse) -! ****************************************************************************** -! bnd_ac -- Add package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use MemoryManagerModule, only: mem_setptr use SparseModule, only: sparsematrix ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this integer(I4B), intent(in) :: moffset type(sparsematrix), intent(inout) :: sparse ! -- local @@ -196,7 +201,6 @@ subroutine apt_ac(this, moffset, sparse) integer(I4B) :: jj, jglo integer(I4B) :: nglo ! -- format -! ------------------------------------------------------------------------------ ! ! -- Add package rows to sparse if (this%imatrows /= 0) then @@ -229,28 +233,22 @@ subroutine apt_ac(this, moffset, sparse) end if end if ! - ! -- return + ! -- Return return end subroutine apt_ac + !> @brief Advanced package transport map package connections to matrix + !< subroutine apt_mc(this, moffset, matrix_sln) -! ****************************************************************************** -! apt_mc -- map package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use SparseModule, only: sparsematrix ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this integer(I4B), intent(in) :: moffset class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: n, j, iglo, jglo integer(I4B) :: ipos ! -- format -! ------------------------------------------------------------------------------ - ! ! ! -- allocate memory for index arrays call this%apt_allocate_index_arrays() @@ -299,20 +297,16 @@ subroutine apt_mc(this, moffset, matrix_sln) end if end if ! - ! -- return + ! -- Return return end subroutine apt_mc + !> @brief Advanced package transport allocate and read (ar) routine + !< subroutine apt_ar(this) -! ****************************************************************************** -! apt_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: j logical :: found @@ -320,7 +314,6 @@ subroutine apt_ar(this) character(len=*), parameter :: fmtapt = & "(1x,/1x,'APT -- ADVANCED PACKAGE TRANSPORT, VERSION 1, 3/5/2020', & &' INPUT READ FROM UNIT ', i0, //)" -! ------------------------------------------------------------------------------ ! ! -- Get obs setup call this%obs%obs_ar() @@ -346,8 +339,8 @@ subroutine apt_ar(this) this%fmi%datp(this%igwfaptpak)%qmfrommvr => this%qmfrommvr ! ! -- If there is an associated flow package and the user wishes to put - ! simulated concentrations into a aux variable column, then find - ! the column number. + ! simulated concentrations (or temperatures) into a aux variable + ! column, then find the column number. if (associated(this%flowpackagebnd)) then if (this%cauxfpconc /= '') then found = .false. @@ -376,18 +369,14 @@ subroutine apt_ar(this) return end subroutine apt_ar + !> @brief Advanced package transport read and prepare (rp) routine + !! + !! This subroutine calls the attached packages' read and prepare routines. + !< subroutine apt_rp(this) -! ****************************************************************************** -! apt_rp -- Read and Prepare -! Subroutine: (1) read itmp -! (2) read new boundaries if itmp>0 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use TdisModule, only: kper, nper ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: ierr integer(I4B) :: n @@ -401,7 +390,6 @@ subroutine apt_rp(this) &"('Error. Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" character(len=*), parameter :: fmtlsp = & &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')" -! ------------------------------------------------------------------------------ ! ! -- set nbound to maxbound this%nbound = this%maxbound @@ -498,22 +486,20 @@ subroutine apt_rp(this) this%nodelist(n) = igwfnode end do ! - ! -- return + ! -- Return return end subroutine apt_rp + !> @brief Advanced package transport set stress period routine. + !! + !! Set a stress period attribute for an advanced transport package feature + !! (itemno) using keywords. + !< subroutine apt_set_stressperiod(this, itemno) -! ****************************************************************************** -! apt_set_stressperiod -- Set a stress period attribute for feature (itemno) -! using keywords. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this integer(I4B), intent(in) :: itemno ! -- local character(len=LINELENGTH) :: text @@ -525,11 +511,10 @@ subroutine apt_set_stressperiod(this, itemno) real(DP), pointer :: bndElem => null() logical :: found ! -- formats -! ------------------------------------------------------------------------------ ! - ! -- Support these general options with apply to LKT, SFT, MWT, UZT + ! -- Support these general options in LKT, SFT, MWT, UZT ! STATUS - ! CONCENTRATION + ! CONCENTRATION or TEMPERATURE ! WITHDRAWAL ! AUXILIARY ! @@ -554,7 +539,7 @@ subroutine apt_set_stressperiod(this, itemno) 'Unknown '//trim(this%text)//' status keyword: ', text//'.' call store_error(errmsg) end if - case ('CONCENTRATION') + case ('CONCENTRATION', 'TEMPERATURE') ierr = this%apt_check_valid(itemno) if (ierr /= 0) then goto 999 @@ -564,7 +549,7 @@ subroutine apt_set_stressperiod(this, itemno) bndElem => this%concfeat(itemno) call read_value_or_time_series_adv(text, itemno, jj, bndElem, & this%packName, 'BND', this%tsManager, & - this%iprpak, 'CONCENTRATION') + this%iprpak, this%depvartype) case ('AUXILIARY') ierr = this%apt_check_valid(itemno) if (ierr /= 0) then @@ -601,50 +586,46 @@ subroutine apt_set_stressperiod(this, itemno) call this%parser%StoreErrorUnit() end if ! - ! -- return + ! -- Return return end subroutine apt_set_stressperiod + !> @brief Advanced package transport set stress period routine. + !! + !! Set a stress period attribute for an individual package. This routine + !! must be overridden. + !< subroutine pak_set_stressperiod(this, itemno, keyword, found) -! ****************************************************************************** -! pak_set_stressperiod -- Set a stress period attribute for individual package. -! This must be overridden. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this integer(I4B), intent(in) :: itemno character(len=*), intent(in) :: keyword logical, intent(inout) :: found ! -- local ! -- formats -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called found = .false. call store_error('Program error: pak_set_stressperiod not implemented.', & terminate=.TRUE.) ! - ! -- return + ! -- Return return end subroutine pak_set_stressperiod + !> @brief Advanced package transport routine + !! + !! Determine if a valid feature number has been specified. + !< function apt_check_valid(this, itemno) result(ierr) -! ****************************************************************************** -! apt_check_valid -- Determine if a valid feature number has been -! specified. -! ****************************************************************************** ! -- return integer(I4B) :: ierr ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this integer(I4B), intent(in) :: itemno ! -- local ! -- formats -! ------------------------------------------------------------------------------ ierr = 0 if (itemno < 1 .or. itemno > this%ncv) then write (errmsg, '(a,1x,i6,1x,a,1x,i6)') & @@ -654,21 +635,18 @@ function apt_check_valid(this, itemno) result(ierr) end if end function apt_check_valid + !> @brief Advanced package transport routine + !! + !! Add package connections to matrix + !< subroutine apt_ad(this) -! ****************************************************************************** -! apt_ad -- Add package connection to matrix -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: iFailedStepRetry ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: n integer(I4B) :: j, iaux -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -685,8 +663,8 @@ subroutine apt_ad(this) end do end if ! - ! -- copy xnew into xold and set xnewpak to specified concentration for - ! constant concentration features + ! -- copy xnew into xold and set xnewpak to specified concentration (or + ! temperature) for constant concentration/temperature features if (iFailedStepRetry == 0) then do n = 1, this%ncv this%xoldpak(n) = this%xnewpak(n) @@ -713,53 +691,34 @@ subroutine apt_ad(this) ! "current" value. call this%obs%obs_ad() ! - ! -- return + ! -- Return return end subroutine apt_ad - !> @ brief Formulate the package hcof and rhs terms. - !! - !! For the APT Package, the sole purpose here is to - !! reset the qmfrommvr term. - !! - !< - subroutine apt_cf(this, reset_mover) - ! -- modules - class(GwtAptType) :: this !< GwtAptType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover - ! -- local + !> @brief Override bnd reset for custom mover logic + !< TODO_MJR: check this + subroutine apt_reset(this) + class(TspAptType) :: this !< GwtAptType object + ! local integer(I4B) :: i - logical :: lrm - ! - ! -- reset qmfrommvr - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (lrm) then - do i = 1, size(this%qmfrommvr) - this%qmfrommvr(i) = DZERO - end do - end if ! - ! -- return + do i = 1, size(this%qmfrommvr) + this%qmfrommvr(i) = DZERO + end do + ! + ! -- Return return - end subroutine apt_cf + end subroutine apt_reset subroutine apt_fc(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! apt_fc -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this real(DP), dimension(:), intent(inout) :: rhs integer(I4B), dimension(:), intent(in) :: ia integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local -! ------------------------------------------------------------------------------ ! ! -- Call fc depending on whether or not a matrix is expanded or not if (this%imatrows == 0) then @@ -772,26 +731,23 @@ subroutine apt_fc(this, rhs, ia, idxglo, matrix_sln) return end subroutine apt_fc + !> @brief Advanced package transport fill coefficient (fc) method + !! + !! Routine to formulate the nonexpanded matrix case in which feature + !! concentrations (or temperatures) are solved explicitly + !< subroutine apt_fc_nonexpanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! apt_fc_nonexpanded -- formulate for the nonexpanded a matrix case in which -! feature concentrations are solved explicitly -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this real(DP), dimension(:), intent(inout) :: rhs integer(I4B), dimension(:), intent(in) :: ia integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: j, igwfnode, idiag -! ------------------------------------------------------------------------------ ! - ! -- solve for concentration in the features + ! -- solve for concentration (or temperatures) in the features call this%apt_solve() ! ! -- add hcof and rhs terms (from apt_solve) to the gwf matrix @@ -807,17 +763,15 @@ subroutine apt_fc_nonexpanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine apt_fc_nonexpanded + !> @brief Advanced package transport fill coefficient (fc) method + !! + !! Routine to formulate the expanded matrix case in which new rows are added + !! to the system of equations for each advanced package transport feature + !< subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! apt_fc_expanded -- formulate for the expanded matrix case in which new -! rows are added to the system of equations for each feature -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this real(DP), dimension(:), intent(inout) :: rhs integer(I4B), dimension(:), intent(in) :: ia integer(I4B), dimension(:), intent(in) :: idxglo @@ -828,12 +782,11 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) integer(I4B) :: iposd, iposoffd integer(I4B) :: ipossymd, ipossymoffd real(DP) :: cold - real(DP) :: qbnd + real(DP) :: qbnd, qbnd_scaled real(DP) :: omega real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- call the specific method for the advanced transport package, such as ! what would be overridden by @@ -842,7 +795,7 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) ! specific to the package call this%pak_fc_expanded(rhs, ia, idxglo, matrix_sln) ! - ! -- mass storage in features + ! -- mass (or energy) storage in features do n = 1, this%ncv cold = this%xoldpak(n) iloc = this%idxlocnode(n) @@ -866,7 +819,7 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) ! -- add from mover contribution if (this%idxbudfmvr /= 0) then do n = 1, this%ncv - rhsval = this%qmfrommvr(n) + rhsval = this%qmfrommvr(n) ! this will already be in terms of energy for heat transport iloc = this%idxlocnode(n) rhs(iloc) = rhs(iloc) - rhsval end do @@ -883,18 +836,19 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j) omega = DZERO if (qbnd < DZERO) omega = DONE + qbnd_scaled = qbnd * this%eqnsclfac ! ! -- add to apt row iposd = this%idxdglo(j) iposoffd = this%idxoffdglo(j) - call matrix_sln%add_value_pos(iposd, omega * qbnd) - call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd) + call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled) + call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd_scaled) ! ! -- add to gwf row for apt connection ipossymd = this%idxsymdglo(j) ipossymoffd = this%idxsymoffdglo(j) - call matrix_sln%add_value_pos(ipossymd, -(DONE - omega) * qbnd) - call matrix_sln%add_value_pos(ipossymoffd, -omega * qbnd) + call matrix_sln%add_value_pos(ipossymd, -(DONE - omega) * qbnd_scaled) + call matrix_sln%add_value_pos(ipossymoffd, -omega * qbnd_scaled) end if end do ! @@ -909,10 +863,11 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) else omega = DZERO end if + qbnd_scaled = qbnd * this%eqnsclfac iposd = this%idxfjfdglo(j) iposoffd = this%idxfjfoffdglo(j) - call matrix_sln%add_value_pos(iposd, omega * qbnd) - call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd) + call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled) + call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd_scaled) end do end if ! @@ -920,23 +875,20 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine apt_fc_expanded + !> @brief Advanced package transport fill coefficient (fc) method + !! + !! Routine to allow a subclass advanced transport package to inject + !! terms into the matrix assembly. This method must be overridden. + !< subroutine pak_fc_expanded(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! pak_fc_expanded -- allow a subclass advanced transport package to inject -! terms into the matrix assembly. This method must be overridden. -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this real(DP), dimension(:), intent(inout) :: rhs integer(I4B), dimension(:), intent(in) :: ia integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_fc_expanded not implemented.', & @@ -946,25 +898,23 @@ subroutine pak_fc_expanded(this, rhs, ia, idxglo, matrix_sln) return end subroutine pak_fc_expanded + !> @brief Advanced package transport routine + !! + !! Calculate advanced package transport hcof and rhs so transport budget is + !! calculated. + !< subroutine apt_cfupdate(this) -! ****************************************************************************** -! apt_cfupdate -- calculate package hcof and rhs so gwt budget is calculated -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: j, n real(DP) :: qbnd real(DP) :: omega -! ------------------------------------------------------------------------------ ! ! -- Calculate hcof and rhs terms so GWF exchanges are calculated correctly ! -- go through each apt-gwf connection and calculate - ! rhs and hcof terms for gwt matrix rows + ! rhs and hcof terms for gwt/gwe matrix rows do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j) this%hcof(j) = DZERO @@ -973,8 +923,8 @@ subroutine apt_cfupdate(this) qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j) omega = DZERO if (qbnd < DZERO) omega = DONE - this%hcof(j) = -(DONE - omega) * qbnd - this%rhs(j) = omega * qbnd * this%xnewpak(n) + this%hcof(j) = -(DONE - omega) * qbnd * this%eqnsclfac + this%rhs(j) = omega * qbnd * this%xnewpak(n) * this%eqnsclfac end if end do ! @@ -982,26 +932,23 @@ subroutine apt_cfupdate(this) return end subroutine apt_cfupdate + !> @brief Advanced package transport calculate flows (cq) routine + !! + !! Calculate flows for the advanced package transport feature + !< subroutine apt_cq(this, x, flowja, iadv) -! ****************************************************************************** -! apt_cq -- Calculate flows for the feature -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this real(DP), dimension(:), intent(in) :: x real(DP), dimension(:), contiguous, intent(inout) :: flowja integer(I4B), optional, intent(in) :: iadv ! -- local integer(I4B) :: n, n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! - ! -- Solve the feature concentrations again or update the feature hcof - ! and rhs terms + ! -- Solve the feature concentrations (or temperatures) again or update + ! the feature hcof and rhs terms if (this%imatrows == 0) then call this%apt_solve() else @@ -1020,19 +967,21 @@ subroutine apt_cq(this, x, flowja, iadv) this%qsto(n) = rrate end do ! - ! -- Copy concentrations into the flow package auxiliary variable + ! -- Copy concentrations (or temperatures) into the flow package auxiliary variable call this%apt_copy2flowp() ! ! -- fill the budget object - call this%apt_fill_budobj(x) + call this%apt_fill_budobj(x, flowja) ! - ! -- return + ! -- Return return end subroutine apt_cq + !> @brief Save advanced package flows routine + !< subroutine apt_ot_package_flows(this, icbcfl, ibudfl) use TdisModule, only: kstp, kper, delt, pertim, totim - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl integer(I4B) :: ibinun @@ -1052,19 +1001,26 @@ subroutine apt_ot_package_flows(this, icbcfl, ibudfl) if (ibudfl /= 0 .and. this%iprflow /= 0) then call this%budobj%write_flowtable(this%dis, kstp, kper) end if - + ! + ! -- Return + return end subroutine apt_ot_package_flows subroutine apt_ot_dv(this, idvsave, idvprint) + ! -- modules + use ConstantsModule, only: LENBUDTXT use TdisModule, only: kstp, kper, pertim, totim - use ConstantsModule, only: DHNOFLO, DHDRY + use ConstantsModule, only: DHNOFLO, DHDRY, LENBUDTXT use InputOutputModule, only: ulasav - class(GwtAptType) :: this + ! -- dummy + class(TspAptType) :: this integer(I4B), intent(in) :: idvsave integer(I4B), intent(in) :: idvprint + ! -- local integer(I4B) :: ibinun integer(I4B) :: n real(DP) :: c + character(len=LENBUDTXT) :: text ! ! -- set unit number for binary dependent variable output ibinun = 0 @@ -1082,7 +1038,8 @@ subroutine apt_ot_dv(this, idvsave, idvprint) end if this%dbuff(n) = c end do - call ulasav(this%dbuff, ' CONCENTRATION', kstp, kper, pertim, totim, & + write (text, '(a)') str_pad_left(this%depvartype, LENVARNAME) + call ulasav(this%dbuff, text, kstp, kper, pertim, totim, & this%ncv, 1, 1, ibinun) end if ! @@ -1101,14 +1058,18 @@ subroutine apt_ot_dv(this, idvsave, idvprint) call this%dvtab%add_term(this%xnewpak(n)) end do end if - + ! + ! -- Return + return end subroutine apt_ot_dv + !> @brief Print advanced package transport dependent variables + !< subroutine apt_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! -- module use TdisModule, only: totim ! -- dummy - class(GwtAptType) :: this !< GwtAptType object + class(TspAptType) :: this !< TspAptType object integer(I4B), intent(in) :: kstp !< time step number integer(I4B), intent(in) :: kper !< period number integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file @@ -1116,20 +1077,19 @@ subroutine apt_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim) ! - ! -- return + ! -- Return return end subroutine apt_ot_bdsummary !> @ brief Allocate scalars !! - !! Allocate scalar variables for this package - !! + !! Allocate scalar variables for an advanced package !< subroutine allocate_scalars(this) ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local ! ! -- allocate scalars in NumericalPackageType @@ -1151,6 +1111,8 @@ subroutine allocate_scalars(this) call mem_allocate(this%idxbudfmvr, 'IDXBUDFMVR', this%memoryPath) call mem_allocate(this%idxbudaux, 'IDXBUDAUX', this%memoryPath) call mem_allocate(this%nconcbudssm, 'NCONCBUDSSM', this%memoryPath) + call mem_allocate(this%idxprepak, 'IDXPREPAK', this%memoryPath) + call mem_allocate(this%idxlastpak, 'IDXLASTPAK', this%memoryPath) ! ! -- Initialize this%iauxfpconc = 0 @@ -1168,6 +1130,8 @@ subroutine allocate_scalars(this) this%idxbudfmvr = 0 this%idxbudaux = 0 this%nconcbudssm = 0 + this%idxprepak = 0 + this%idxlastpak = 0 ! ! -- set this package as causing asymmetric matrix terms this%iasym = 1 @@ -1178,18 +1142,16 @@ end subroutine allocate_scalars !> @ brief Allocate index arrays !! - !! Allocate arrays that map to locations in the - !! numerical solution - !! + !! Allocate arrays that map to locations in the numerical solution !< subroutine apt_allocate_index_arrays(this) ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: n - + ! if (this%imatrows /= 0) then ! ! -- count number of flow-ja-face connections @@ -1233,19 +1195,20 @@ subroutine apt_allocate_index_arrays(this) call mem_allocate(this%idxfjfoffdglo, 0, 'IDXFJFOFFDGLO', & this%memoryPath) end if + ! + ! -- Return return end subroutine apt_allocate_index_arrays !> @ brief Allocate arrays !! - !! Allocate package arrays - !! + !! Allocate advanced package transport arrays !< subroutine apt_allocate_arrays(this) ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: n ! @@ -1278,7 +1241,7 @@ subroutine apt_allocate_arrays(this) call mem_allocate(this%concbudssm, this%nconcbudssm, this%ncv, & 'CONCBUDSSM', this%memoryPath) ! - ! -- mass added from the mover transport package + ! -- mass (or energy) added from the mover transport package call mem_allocate(this%qmfrommvr, this%ncv, 'QMFROMMVR', this%memoryPath) ! ! -- initialize arrays @@ -1298,13 +1261,12 @@ end subroutine apt_allocate_arrays !> @ brief Deallocate memory !! !! Deallocate memory associated with this package - !! !< subroutine apt_da(this) ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local ! ! -- deallocate arrays @@ -1363,6 +1325,8 @@ subroutine apt_da(this) call mem_deallocate(this%idxbudaux) call mem_deallocate(this%idxbudssm) call mem_deallocate(this%nconcbudssm) + call mem_deallocate(this%idxprepak) + call mem_deallocate(this%idxlastpak) ! ! -- deallocate scalars in NumericalPackageType call this%BndType%bnd_da() @@ -1371,19 +1335,14 @@ subroutine apt_da(this) return end subroutine apt_da + !> @brief Find corresponding advanced package transport package + !< subroutine find_apt_package(this) -! ****************************************************************************** -! find corresponding flow package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_solve not implemented.', & @@ -1393,20 +1352,16 @@ subroutine find_apt_package(this) return end subroutine find_apt_package + !> @brief Set options specific to the TspAptType + !! + !! This routine overrides BndType%bnd_options + !< subroutine apt_options(this, option, found) -! ****************************************************************************** -! apt_options -- set options specific to GwtAptType -! -! apt_options overrides BndType%bnd_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: MAXCHARLEN, DZERO use OpenSpecModule, only: access, form use InputOutputModule, only: urword, getunit, openfile ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this character(len=*), intent(inout) :: option logical, intent(inout) :: found ! -- local @@ -1415,7 +1370,6 @@ subroutine apt_options(this, option, found) character(len=*), parameter :: fmtaptbin = & "(4x, a, 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, & &/4x, 'OPENED ON UNIT: ', I0)" -! ------------------------------------------------------------------------------ ! found = .true. select case (option) @@ -1439,11 +1393,12 @@ subroutine apt_options(this, option, found) write (this%iout, '(4x,a)') & trim(adjustl(this%text))// & ' WILL NOT ADD ADDITIONAL ROWS TO THE A MATRIX.' - case ('PRINT_CONCENTRATION') + case ('PRINT_CONCENTRATION', 'PRINT_TEMPERATURE') this%iprconc = 1 - write (this%iout, '(4x,a)') trim(adjustl(this%text))// & - ' CONCENTRATIONS WILL BE PRINTED TO LISTING FILE.' - case ('CONCENTRATION') + write (this%iout, '(4x,a,1x,a,1x,a)') trim(adjustl(this%text))// & + trim(adjustl(this%depvartype))//'S WILL BE PRINTED TO LISTING & + &FILE.' + case ('CONCENTRATION', 'TEMPERATURE') call this%parser%GetStringCaps(keyword) if (keyword == 'FILEOUT') then call this%parser%GetString(fname) @@ -1451,10 +1406,12 @@ subroutine apt_options(this, option, found) call openfile(this%iconcout, this%iout, fname, 'DATA(BINARY)', & form, access, 'REPLACE') write (this%iout, fmtaptbin) & - trim(adjustl(this%text)), 'CONCENTRATION', trim(fname), this%iconcout + trim(adjustl(this%text)), trim(adjustl(this%depvartype)), & + trim(fname), this%iconcout else - call store_error('Optional CONCENTRATION keyword must & - &be followed by FILEOUT') + write (errmsg, "('Optional', 1x, a, 1X, 'keyword must & + &be followed by FILEOUT')") this%depvartype + call store_error(errmsg) end if case ('BUDGET') call this%parser%GetStringCaps(keyword) @@ -1487,23 +1444,18 @@ subroutine apt_options(this, option, found) found = .false. end select ! - ! -- return + ! -- Return return end subroutine apt_options + !> @brief Determine dimensions for this advanced package + !< subroutine apt_read_dimensions(this) -! ****************************************************************************** -! apt_read_dimensions -- Determine dimensions for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: ierr ! -- format -! ------------------------------------------------------------------------------ ! ! -- Set a pointer to the GWF LAK Package budobj if (this%flowpackagename == '') then @@ -1561,22 +1513,18 @@ subroutine apt_read_dimensions(this) ! -- setup the conc table object call this%apt_setup_tableobj() ! - ! -- return + ! -- Return return end subroutine apt_read_dimensions + !> @brief Read feature information for this advanced package + !< subroutine apt_read_cvs(this) -! ****************************************************************************** -! apt_read_cvs -- Read feature information for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use TimeSeriesManagerModule, only: read_value_or_time_series_adv ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local character(len=LINELENGTH) :: text character(len=LENBOUNDNAME) :: bndName, bndNameTemp @@ -1592,7 +1540,6 @@ subroutine apt_read_cvs(this) integer(I4B) :: nconn integer(I4B), dimension(:), pointer, contiguous :: nboundchk real(DP), pointer :: bndElem => null() -! ------------------------------------------------------------------------------ ! ! -- initialize itmp itmp = 0 @@ -1655,13 +1602,13 @@ subroutine apt_read_cvs(this) call store_error(errmsg) cycle end if - + ! ! -- increment nboundchk nboundchk(n) = nboundchk(n) + 1 - + ! ! -- strt this%strt(n) = this%parser%GetDouble() - + ! ! -- get aux data do iaux = 1, this%naux call this%parser%GetString(caux(iaux)) @@ -1691,7 +1638,7 @@ subroutine apt_read_cvs(this) this%tsManager, this%iprpak, & this%auxname(jj)) end do - + ! nlak = nlak + 1 end do ! @@ -1706,7 +1653,7 @@ subroutine apt_read_cvs(this) call store_error(errmsg) end if end do - + ! write (this%iout, '(1x,a)') & 'END OF '//trim(adjustl(this%text))//' PACKAGEDATA' else @@ -1726,74 +1673,30 @@ subroutine apt_read_cvs(this) ! -- deallocate local storage for nboundchk deallocate (nboundchk) ! - ! -- return + ! -- Return return end subroutine apt_read_cvs + !> @brief Read the initial parameters for an advanced package + !< subroutine apt_read_initial_attr(this) -! ****************************************************************************** -! apt_read_initial_attr -- Read the initial parameters for this package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH use BudgetModule, only: budget_cr ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local !character(len=LINELENGTH) :: text integer(I4B) :: j, n - !integer(I4B) :: nn - !integer(I4B) :: idx - !real(DP) :: endtim - !real(DP) :: top - !real(DP) :: bot - !real(DP) :: k - !real(DP) :: area - !real(DP) :: length - !real(DP) :: s - !real(DP) :: dx - !real(DP) :: c - !real(DP) :: sa - !real(DP) :: wa - !real(DP) :: v - !real(DP) :: fact - !real(DP) :: c1 - !real(DP) :: c2 - !real(DP), allocatable, dimension(:) :: clb, caq - !character (len=14) :: cbedleak - !character (len=14) :: cbedcond - !character (len=10), dimension(0:3) :: ctype - !character (len=15) :: nodestr - !!data - !data ctype(0) /'VERTICAL '/ - !data ctype(1) /'HORIZONTAL'/ - !data ctype(2) /'EMBEDDEDH '/ - !data ctype(3) /'EMBEDDEDV '/ - ! -- format -! ------------------------------------------------------------------------------ ! - ! -- initialize xnewpak and set lake concentration + ! -- initialize xnewpak and set feature concentration (or temperature) ! -- todo: this should be a time series? do n = 1, this%ncv this%xnewpak(n) = this%strt(n) - !write(text,'(g15.7)') this%strt(n) - !endtim = DZERO - !jj = 1 ! For STAGE - !call read_single_value_or_time_series(text, & - ! this%stage(n)%value, & - ! this%stage(n)%name, & - ! endtim, & - ! this%name, 'BND', this%TsManager, & - ! this%iprpak, n, jj, 'STAGE', & - ! this%featname(n), this%inunit) - + ! ! -- todo: read aux - + ! ! -- todo: read boundname - end do ! ! -- initialize status (iboundpak) of lakes to active @@ -1818,21 +1721,20 @@ subroutine apt_read_initial_attr(this) ! -- copy boundname into boundname_cst call this%copy_boundname() ! - ! -- return + ! -- Return return end subroutine apt_read_initial_attr + !> @brief Add terms specific to advanced package transport to the explicit + !! solve + !! + !! Explicit solve for concentration (or temperature) in advaced package + !! features, which is an alternative to the iterative implicit solve. + !< subroutine apt_solve(this) -! ****************************************************************************** -! apt_solve -- explicit solve for concentration in features, which is an -! alternative to the iterative implicit solve -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: n, j, igwfnode integer(I4B) :: n1, n2 @@ -1840,10 +1742,8 @@ subroutine apt_solve(this) real(DP) :: ctmp real(DP) :: c1, qbnd real(DP) :: hcofval, rhsval -! ------------------------------------------------------------------------------ - ! ! - ! -- first initialize dbuff + ! -- initialize dbuff do n = 1, this%ncv this%dbuff(n) = DZERO end do @@ -1863,13 +1763,13 @@ subroutine apt_solve(this) ! -- add from mover contribution if (this%idxbudfmvr /= 0) then do n1 = 1, size(this%qmfrommvr) - rrate = this%qmfrommvr(n1) + rrate = this%qmfrommvr(n1) ! Will be in terms of energy for heat transport this%dbuff(n1) = this%dbuff(n1) + rrate end do end if ! ! -- go through each gwf connection and accumulate - ! total mass in dbuff mass + ! total mass (or energy) in dbuff mass do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j) this%hcof(j) = DZERO @@ -1878,17 +1778,17 @@ subroutine apt_solve(this) qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j) if (qbnd <= DZERO) then ctmp = this%xnewpak(n) - this%rhs(j) = qbnd * ctmp + this%rhs(j) = qbnd * ctmp * this%eqnsclfac else ctmp = this%xnew(igwfnode) - this%hcof(j) = -qbnd + this%hcof(j) = -qbnd * this%eqnsclfac end if - c1 = qbnd * ctmp + c1 = qbnd * ctmp * this%eqnsclfac this%dbuff(n) = this%dbuff(n) + c1 end do ! - ! -- go through each lak-lak connection and accumulate - ! total mass in dbuff mass + ! -- go through each "within apt-apt" connection (e.g., lak-lak) and + ! accumulate total mass (or energy) in dbuff mass if (this%idxbudfjf /= 0) then do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist call this%apt_fjf_term(j, n1, n2, rrate) @@ -1897,7 +1797,7 @@ subroutine apt_solve(this) end do end if ! - ! -- calulate the feature concentration + ! -- calculate the feature concentration/temperature do n = 1, this%ncv call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval) ! @@ -1916,17 +1816,15 @@ subroutine apt_solve(this) return end subroutine apt_solve + !> @brief Add terms specific to advanced package transport features to the + !! explicit solve routine + !! + !! This routine must be overridden by the specific apt package + !< subroutine pak_solve(this) -! ****************************************************************************** -! pak_solve -- must be overridden -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_solve not implemented.', & @@ -1936,15 +1834,11 @@ subroutine pak_solve(this) return end subroutine pak_solve + !> @brief Accumulate constant concentration (or temperature) terms for budget + !< subroutine apt_accumulate_ccterm(this, ilak, rrate, ccratin, ccratout) -! ****************************************************************************** -! apt_accumulate_ccterm -- Accumulate constant concentration terms for budget. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(in) :: ilak real(DP), intent(in) :: rrate real(DP), intent(inout) :: ccratin @@ -1953,7 +1847,6 @@ subroutine apt_accumulate_ccterm(this, ilak, rrate, ccratin, ccratout) real(DP) :: q ! format ! code -! ------------------------------------------------------------------------------ ! if (this%iboundpak(ilak) < 0) then q = -rrate @@ -1970,20 +1863,16 @@ subroutine apt_accumulate_ccterm(this, ilak, rrate, ccratin, ccratout) ccratin = ccratin + q end if end if - ! -- return + ! + ! -- Return return end subroutine apt_accumulate_ccterm + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used. + !< subroutine define_listlabel(this) -! ****************************************************************************** -! define_listlabel -- Define the list heading that is written to iout when -! PRINT_INPUT option is used. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - class(GwtAptType), intent(inout) :: this -! ------------------------------------------------------------------------------ + class(TspAptType), intent(inout) :: this ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -2002,19 +1891,15 @@ subroutine define_listlabel(this) write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' end if ! - ! -- return + ! -- Return return end subroutine define_listlabel + !> @brief Set pointers to model arrays and variables so that a package has + !! access to these items. + !< subroutine apt_set_pointers(this, neq, ibound, xnew, xold, flowja) -! ****************************************************************************** -! set_pointers -- Set pointers to model arrays and variables so that a package -! has access to these things. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), pointer :: neq integer(I4B), dimension(:), pointer, contiguous :: ibound real(DP), dimension(:), pointer, contiguous :: xnew @@ -2022,7 +1907,6 @@ subroutine apt_set_pointers(this, neq, ibound, xnew, xold, flowja) real(DP), dimension(:), pointer, contiguous :: flowja ! -- local integer(I4B) :: istart, iend -! ------------------------------------------------------------------------------ ! ! -- call base BndType set_pointers call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja) @@ -2037,25 +1921,21 @@ subroutine apt_set_pointers(this, neq, ibound, xnew, xold, flowja) this%xnewpak => this%xnew(istart:iend) end if ! - ! -- return + ! -- Return + return end subroutine apt_set_pointers + !> @brief Return the feature new volume and old volume + !< subroutine get_volumes(this, icv, vnew, vold, delt) -! ****************************************************************************** -! get_volumes -- return the feature new volume and old volume -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(in) :: icv real(DP), intent(inout) :: vnew, vold real(DP), intent(in) :: delt ! -- local real(DP) :: qss -! ------------------------------------------------------------------------------ ! ! -- get volumes vold = DZERO @@ -2070,39 +1950,34 @@ subroutine get_volumes(this, icv, vnew, vold, delt) return end subroutine get_volumes + !> @brief Function to return the number of budget terms just for this package + !! + !! This function must be overridden. + !< function pak_get_nbudterms(this) result(nbudterms) -! ****************************************************************************** -! pak_get_nbudterms -- function to return the number of budget terms just for -! this package. Must be overridden. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_get_nbudterms not implemented.', & terminate=.TRUE.) nbudterms = 0 + ! + ! -- Return + return end function pak_get_nbudterms + !> @brief Set up the budget object that stores advanced package flow terms + !< subroutine apt_setup_budobj(this) -! ****************************************************************************** -! apt_setup_budobj -- Set up the budget object that stores all the lake flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: nbudterm integer(I4B) :: nlen @@ -2111,9 +1986,12 @@ subroutine apt_setup_budobj(this) integer(I4B) :: idx logical :: ordered_id1 real(DP) :: q - character(len=LENBUDTXT) :: text + character(len=LENBUDTXT) :: bddim_opt + character(len=LENBUDTXT) :: text, textt character(len=LENBUDTXT), dimension(1) :: auxtxt -! ------------------------------------------------------------------------------ + ! + ! -- initialize nbudterm + nbudterm = 0 ! ! -- Determine if there are flow-ja-face terms nlen = 0 @@ -2121,17 +1999,18 @@ subroutine apt_setup_budobj(this) nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist end if ! - ! -- Determine the number of lake budget terms. These are fixed for - ! the simulation and cannot change - ! -- the first 3 is for GWF, STORAGE, and CONSTANT - nbudterm = 3 + ! -- Determine the number of budget terms associated with apt. + ! These are fixed for the simulation and cannot change + ! + ! -- add one if flow-ja-face present + if (this%idxbudfjf /= 0) nbudterm = nbudterm + 1 + ! + ! -- All the APT packages have GWF, STORAGE, and CONSTANT + nbudterm = nbudterm + 3 ! ! -- add terms for the specific package nbudterm = nbudterm + this%pak_get_nbudterms() ! - ! -- add one for flow-ja-face - if (nlen > 0) nbudterm = nbudterm + 1 - ! ! -- add for mover terms and auxiliary if (this%idxbudtmvr /= 0) nbudterm = nbudterm + 1 if (this%idxbudfmvr /= 0) nbudterm = nbudterm + 1 @@ -2139,8 +2018,10 @@ subroutine apt_setup_budobj(this) ! ! -- set up budobj call budgetobject_cr(this%budobj, this%packName) + ! + bddim_opt = this%depvarunitabbrev call this%budobj%budgetobject_df(this%ncv, nbudterm, 0, 0, & - bddim_opt='M', ibudcsv=this%ibudcsv) + bddim_opt=bddim_opt, ibudcsv=this%ibudcsv) idx = 0 ! ! -- Go through and set up each budget term @@ -2189,14 +2070,17 @@ subroutine apt_setup_budobj(this) end do ! ! -- Reserve space for the package specific terms + this%idxprepak = idx call this%pak_setup_budobj(idx) + this%idxlastpak = idx ! ! -- text = ' STORAGE' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudsto)%maxlist naux = 1 - auxtxt(1) = ' MASS' + write (textt, '(a)') str_pad_left(this%depvarunit, 16) + auxtxt(1) = textt ! ' MASS' or ' ENERGY' call this%budobj%budterm(idx)%initialize(text, & this%name_model, & this%packName, & @@ -2272,45 +2156,38 @@ subroutine apt_setup_budobj(this) call this%budobj%flowtable_df(this%iout) end if ! - ! -- return + ! -- Return return end subroutine apt_setup_budobj + !> @brief Set up a budget object that stores an advanced package flows + !! + !! Individual packages set up their budget terms. Must be overridden. + !< subroutine pak_setup_budobj(this, idx) -! ****************************************************************************** -! pak_setup_budobj -- Individual packages set up their budget terms. Must -! be overridden -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(inout) :: idx ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_setup_budobj not implemented.', & terminate=.TRUE.) ! - ! -- return + ! -- Return return end subroutine pak_setup_budobj - subroutine apt_fill_budobj(this, x) -! ****************************************************************************** -! apt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Copy flow terms into this%budobj + !< + subroutine apt_fill_budobj(this, x, flowja) ! -- modules use TdisModule, only: delt ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this real(DP), dimension(:), intent(in) :: x + real(DP), dimension(:), contiguous, intent(inout) :: flowja ! -- local integer(I4B) :: naux real(DP), dimension(:), allocatable :: auxvartmp @@ -2323,19 +2200,18 @@ subroutine apt_fill_budobj(this, x) real(DP) :: v0, v1 real(DP) :: ccratin, ccratout ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 ! - ! -- initialize ccterm, which is used to sum up all mass flows - ! into a constant concentration cell + ! -- initialize ccterm, which is used to sum up all mass (or energy) flows + ! into a constant concentration (or temperature) cell ccratin = DZERO ccratout = DZERO do n1 = 1, this%ncv this%ccterm(n1) = DZERO end do - + ! ! -- FLOW JA FACE nlen = 0 if (this%idxbudfjf /= 0) then @@ -2352,7 +2228,7 @@ subroutine apt_fill_budobj(this, x) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- GWF (LEAKAGE) idx = idx + 1 call this%budobj%budterm(idx)%reset(this%maxbound) @@ -2367,23 +2243,24 @@ subroutine apt_fill_budobj(this, x) call this%budobj%budterm(idx)%update_term(n1, igwfnode, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do - - ! -- individual package terms - call this%pak_fill_budobj(idx, x, ccratin, ccratout) - + ! + ! -- skip individual package terms for now and process them last + ! -- in case they depend on the other terms (as for uze) + idx = this%idxlastpak + ! ! -- STORAGE idx = idx + 1 call this%budobj%budterm(idx)%reset(this%ncv) allocate (auxvartmp(1)) do n1 = 1, this%ncv call this%get_volumes(n1, v1, v0, delt) - auxvartmp(1) = v1 * this%xnewpak(n1) + auxvartmp(1) = v1 * this%xnewpak(n1) ! Note: When GWE is added, check if this needs a factor of eqnsclfac q = this%qsto(n1) call this%budobj%budterm(idx)%update_term(n1, n1, q, auxvartmp) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do deallocate (auxvartmp) - + ! ! -- TO MOVER if (this%idxbudtmvr /= 0) then idx = idx + 1 @@ -2395,19 +2272,19 @@ subroutine apt_fill_budobj(this, x) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- FROM MOVER if (this%idxbudfmvr /= 0) then idx = idx + 1 nlist = this%ncv call this%budobj%budterm(idx)%reset(nlist) - do n1 = 1, nlist - q = this%qmfrommvr(n1) + do j = 1, nlist + call this%apt_fmvr_term(j, n1, n2, q) call this%budobj%budterm(idx)%update_term(n1, n1, q) call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout) end do end if - + ! ! -- CONSTANT FLOW idx = idx + 1 call this%budobj%budterm(idx)%reset(this%ncv) @@ -2415,7 +2292,7 @@ subroutine apt_fill_budobj(this, x) q = this%ccterm(n1) call this%budobj%budterm(idx)%update_term(n1, n1, q) end do - + ! ! -- AUXILIARY VARIABLES naux = this%naux if (naux > 0) then @@ -2432,43 +2309,44 @@ subroutine apt_fill_budobj(this, x) deallocate (auxvartmp) end if ! + ! -- individual package terms processed last + idx = this%idxprepak + call this%pak_fill_budobj(idx, x, ccratin, ccratout) + ! ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return end subroutine apt_fill_budobj + !> @brief Copy flow terms into this%budobj, must be overridden + !< subroutine pak_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! pak_fill_budobj -- copy flow terms into this%budobj, must be overridden -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(inout) :: idx real(DP), dimension(:), intent(in) :: x real(DP), intent(inout) :: ccratin real(DP), intent(inout) :: ccratout ! -- local ! -- formats -! ----------------------------------------------------------------------------- ! ! -- this routine should never be called call store_error('Program error: pak_fill_budobj not implemented.', & terminate=.TRUE.) ! - ! -- return + ! -- Return return end subroutine pak_fill_budobj + !> @brief Account for mass or energy storage in advanced package features + !< subroutine apt_stor_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) use TdisModule, only: delt - class(GwtAptType) :: this + class(TspAptType) :: this integer(I4B), intent(in) :: ientry integer(I4B), intent(inout) :: n1 integer(I4B), intent(inout) :: n2 @@ -2477,53 +2355,96 @@ subroutine apt_stor_term(this, ientry, n1, n2, rrate, & real(DP), intent(inout), optional :: hcofval real(DP) :: v0, v1 real(DP) :: c0, c1 + ! n1 = ientry n2 = ientry call this%get_volumes(n1, v1, v0, delt) c0 = this%xoldpak(n1) c1 = this%xnewpak(n1) - if (present(rrate)) rrate = -c1 * v1 / delt + c0 * v0 / delt - if (present(rhsval)) rhsval = -c0 * v0 / delt - if (present(hcofval)) hcofval = -v1 / delt + if (present(rrate)) then + rrate = (-c1 * v1 / delt + c0 * v0 / delt) * this%eqnsclfac + end if + if (present(rhsval)) rhsval = -c0 * v0 * this%eqnsclfac / delt + if (present(hcofval)) hcofval = -v1 * this%eqnsclfac / delt ! - ! -- return + ! -- Return return end subroutine apt_stor_term + !> @brief Account for mass or energy transferred to the MVR package + !< subroutine apt_tmvr_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) - class(GwtAptType) :: this + ! -- modules + ! -- dummy + class(TspAptType) :: this integer(I4B), intent(in) :: ientry integer(I4B), intent(inout) :: n1 integer(I4B), intent(inout) :: n2 real(DP), intent(inout), optional :: rrate real(DP), intent(inout), optional :: rhsval real(DP), intent(inout), optional :: hcofval + ! -- local real(DP) :: qbnd real(DP) :: ctmp + ! + ! -- Calculate MVR-related terms n1 = this%flowbudptr%budterm(this%idxbudtmvr)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudtmvr)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudtmvr)%flow(ientry) ctmp = this%xnewpak(n1) - if (present(rrate)) rrate = ctmp * qbnd + if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac if (present(rhsval)) rhsval = DZERO - if (present(hcofval)) hcofval = qbnd + if (present(hcofval)) hcofval = qbnd * this%eqnsclfac ! - ! -- return + ! -- Return return end subroutine apt_tmvr_term + !> @brief Account for mass or energy transferred to this package from the + !! MVR package + !< + subroutine apt_fmvr_term(this, ientry, n1, n2, rrate, & + rhsval, hcofval) + ! -- modules + ! -- dummy + class(TspAptType) :: this + integer(I4B), intent(in) :: ientry + integer(I4B), intent(inout) :: n1 + integer(I4B), intent(inout) :: n2 + real(DP), intent(inout), optional :: rrate + real(DP), intent(inout), optional :: rhsval + real(DP), intent(inout), optional :: hcofval + ! + ! -- Calculate MVR-related terms + n1 = ientry + n2 = n1 + if (present(rrate)) rrate = this%qmfrommvr(n1) ! NOTE: When bringing in GWE, ensure this is in terms of energy. Might need to apply eqnsclfac here. + if (present(rhsval)) rhsval = this%qmfrommvr(n1) + if (present(hcofval)) hcofval = DZERO + ! + ! -- Return + return + end subroutine apt_fmvr_term + + !> @brief Go through each "within apt-apt" connection (e.g., lkt-lkt, or + !! sft-sft) and accumulate total mass (or energy) in dbuff mass + !< subroutine apt_fjf_term(this, ientry, n1, n2, rrate, & rhsval, hcofval) - class(GwtAptType) :: this + ! -- modules + ! -- dummy + class(TspAptType) :: this integer(I4B), intent(in) :: ientry integer(I4B), intent(inout) :: n1 integer(I4B), intent(inout) :: n2 real(DP), intent(inout), optional :: rrate real(DP), intent(inout), optional :: rhsval real(DP), intent(inout), optional :: hcofval + ! -- local real(DP) :: qbnd real(DP) :: ctmp + ! n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(ientry) @@ -2532,27 +2453,23 @@ subroutine apt_fjf_term(this, ientry, n1, n2, rrate, & else ctmp = this%xnewpak(n2) end if - if (present(rrate)) rrate = ctmp * qbnd - if (present(rhsval)) rhsval = -rrate + if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac + if (present(rhsval)) rhsval = -rrate * this%eqnsclfac if (present(hcofval)) hcofval = DZERO ! - ! -- return + ! -- Return return end subroutine apt_fjf_term + !> @brief Copy concentrations (or temperatures) into flow package aux + !! variable + !< subroutine apt_copy2flowp(this) -! ****************************************************************************** -! apt_copy2flowp -- copy concentrations into flow package aux variable -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: n, j -! ------------------------------------------------------------------------------ ! ! -- copy if (this%iauxfpconc /= 0) then @@ -2566,82 +2483,73 @@ subroutine apt_copy2flowp(this) end do end if ! - ! -- return + ! -- Return return end subroutine apt_copy2flowp + !> @brief Determine whether an obs type is supported + !! + !! This function: + !! - returns true if APT package supports named observation. + !! - overrides BndType%bnd_obs_supported() + !< logical function apt_obs_supported(this) -! ****************************************************************************** -! apt_obs_supported -- obs are supported? -! -- Return true because APT package supports observations. -! -- Overrides BndType%bnd_obs_supported() -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this -! ------------------------------------------------------------------------------ + class(TspAptType) :: this ! ! -- Set to true apt_obs_supported = .true. ! - ! -- return + ! -- Return return end function apt_obs_supported + !> @brief Define observation type + !! + !! This routine: + !! - stores observation types supported by APT package. + !! - overrides BndType%bnd_df_obs + !< subroutine apt_df_obs(this) -! ****************************************************************************** -! apt_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- call additional specific observations for lkt, sft, mwt, and uzt call this%pak_df_obs() ! + ! -- Return return end subroutine apt_df_obs + !> @brief Define apt observation type + !! + !! This routine: + !! - stores observations supported by the APT package + !! - must be overridden by child class subroutine pak_df_obs(this) -! ****************************************************************************** -! pak_df_obs -- obs are supported? -! -- Store observation type supported by APT package. -! -- must be overridden by child class -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- this routine should never be called call store_error('Program error: pak_df_obs not implemented.', & terminate=.TRUE.) ! + ! -- Return return end subroutine pak_df_obs !> @brief Process package specific obs - !! - !! Method to process specific observations for this package. - !! + !! + !! Method to process specific observations for this package. !< subroutine pak_rp_obs(this, obsrv, found) ! -- dummy - class(GwtAptType), intent(inout) :: this !< package class + class(TspAptType), intent(inout) :: this !< package class type(ObserveType), intent(inout) :: obsrv !< observation object logical, intent(inout) :: found !< indicate whether observation was found ! -- local @@ -2650,17 +2558,17 @@ subroutine pak_rp_obs(this, obsrv, found) call store_error('Program error: pak_rp_obs not implemented.', & terminate=.TRUE.) ! + ! -- Return return end subroutine pak_rp_obs !> @brief Prepare observation - !! - !! Find the indices for this observation assuming - !! they are indexed by feature number - !! + !! + !! Find the indices for this observation assuming they are indexed by + !! feature number !< subroutine rp_obs_byfeature(this, obsrv) - class(GwtAptType), intent(inout) :: this !< object + class(TspAptType), intent(inout) :: this !< object type(ObserveType), intent(inout) :: obsrv !< observation integer(I4B) :: nn1 integer(I4B) :: j @@ -2695,18 +2603,18 @@ subroutine rp_obs_byfeature(this, obsrv) end if call obsrv%AddObsIndex(nn1) end if + ! + ! -- Return return end subroutine rp_obs_byfeature !> @brief Prepare observation - !! - !! Find the indices for this observation assuming - !! they are first indexed by feature number and - !! secondly by a connection number - !! + !! + !! Find the indices for this observation assuming they are first indexed + !! by feature number and secondly by a connection number !< subroutine rp_obs_budterm(this, obsrv, budterm) - class(GwtAptType), intent(inout) :: this !< object + class(TspAptType), intent(inout) :: this !< object type(ObserveType), intent(inout) :: obsrv !< observation type(BudgetTermType), intent(in) :: budterm !< budget term integer(I4B) :: nn1 @@ -2770,18 +2678,18 @@ subroutine rp_obs_budterm(this, obsrv, budterm) call store_error(errmsg) end if end if + ! + ! -- Return return end subroutine rp_obs_budterm !> @brief Prepare observation - !! - !! Find the indices for this observation assuming - !! they are first indexed by a feature number and - !! secondly by a second feature number - !! + !! + !! Find the indices for this observation assuming they are first indexed + !! by a feature number and secondly by a second feature number !< subroutine rp_obs_flowjaface(this, obsrv, budterm) - class(GwtAptType), intent(inout) :: this !< object + class(TspAptType), intent(inout) :: this !< object type(ObserveType), intent(inout) :: obsrv !< observation type(BudgetTermType), intent(in) :: budterm !< budget term integer(I4B) :: nn1 @@ -2847,38 +2755,38 @@ subroutine rp_obs_flowjaface(this, obsrv, budterm) call store_error(errmsg) end if end if + ! + ! -- Return return end subroutine rp_obs_flowjaface + !> @brief Read and prepare apt-related observations + !! + !! Method to process specific observations for an apt package + !< subroutine apt_rp_obs(this) -! ****************************************************************************** -! apt_rp_obs -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kper ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this ! -- local integer(I4B) :: i logical :: found class(ObserveType), pointer :: obsrv => null() -! ------------------------------------------------------------------------------ ! if (kper == 1) then do i = 1, this%obs%npakobs obsrv => this%obs%pakobs(i)%obsrv select case (obsrv%ObsTypeId) - case ('CONCENTRATION') + case ('CONCENTRATION', 'TEMPERATURE') call this%rp_obs_byfeature(obsrv) ! ! -- catch non-cumulative observation assigned to observation defined ! by a boundname that is assigned to more than one element if (obsrv%indxbnds_count > 1) then - write (errmsg, '(a, a, a)') & - 'CONCENTRATION for observation', trim(adjustl(obsrv%Name)), & + write (errmsg, '(a, a, a, a)') & + trim(adjustl(this%depvartype))// & + ' for observation', trim(adjustl(obsrv%Name)), & ' must be assigned to a feature with a unique boundname.' call store_error(errmsg) end if @@ -2927,20 +2835,20 @@ subroutine apt_rp_obs(this) end if end if ! + ! -- Return return end subroutine apt_rp_obs + !> @brief Calculate observation values + !! + !! Routine calculates observations common to SFT/LKT/MWT/UZT + !! (or SFE/LKE/MWE/UZE) for as many TspAptType observations that are common + !! among the advanced transport packages + !< subroutine apt_bd_obs(this) -! ****************************************************************************** -! apt_bd_obs -- Calculate observations common to SFT/LKT/MWT/UZT -! ObsType%SaveOneSimval for each GwtAptType observation. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: i integer(I4B) :: igwfnode @@ -2954,7 +2862,7 @@ subroutine apt_bd_obs(this) logical :: found ! ------------------------------------------------------------------------------ ! - ! -- Write simulated values for all LAK observations + ! -- Write simulated values for all Advanced Package observations if (this%obs%npakobs > 0) then call this%obs%obs_bd_clear() do i = 1, this%obs%npakobs @@ -2963,7 +2871,7 @@ subroutine apt_bd_obs(this) v = DNODATA jj = obsrv%indxbnds(j) select case (obsrv%ObsTypeId) - case ('CONCENTRATION') + case ('CONCENTRATION', 'TEMPERATURE') if (this%iboundpak(jj) /= 0) then v = this%xnewpak(jj) end if @@ -2989,7 +2897,7 @@ subroutine apt_bd_obs(this) end if case ('FROM-MVR') if (this%iboundpak(jj) /= 0 .and. this%idxbudfmvr > 0) then - v = this%qmfrommvr(jj) + call this%apt_fmvr_term(jj, n1, n2, v) end if case ('TO-MVR') if (this%idxbudtmvr > 0) then @@ -3023,38 +2931,33 @@ subroutine apt_bd_obs(this) end if end if ! + ! -- Return return end subroutine apt_bd_obs + !> @brief Check if observation exists in an advanced package + !< subroutine pak_bd_obs(this, obstypeid, jj, v, found) -! ****************************************************************************** -! pak_bd_obs -- -! -- check for observations in concrete packages. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtAptType), intent(inout) :: this + class(TspAptType), intent(inout) :: this character(len=*), intent(in) :: obstypeid integer(I4B), intent(in) :: jj real(DP), intent(inout) :: v logical, intent(inout) :: found ! -- local -! ------------------------------------------------------------------------------ ! ! -- set found = .false. because obstypeid is not known found = .false. ! + ! -- Return return end subroutine pak_bd_obs - !> @brief Process observation IDs for a package - !! - !! Method to process observation ID strings for an APT package. - !! This processor is only for observation types that support ID1 - !! and not ID2. - !! + !> @brief Process observation IDs for an advanced package + !! + !! Method to process observation ID strings for an APT package. + !! This processor is only for observation types that support ID1 + !! and not ID2. !< subroutine apt_process_obsID(obsrv, dis, inunitobs, iout) ! -- dummy variables @@ -3097,11 +3000,10 @@ subroutine apt_process_obsID(obsrv, dis, inunitobs, iout) end subroutine apt_process_obsID !> @brief Process observation IDs for a package - !! - !! Method to process observation ID strings for an APT package. - !! This processor is for the case where if ID1 is an integer - !! then ID2 must be provided. - !! + !! + !! Method to process observation ID strings for an APT package. This + !! processor is for the case where if ID1 is an integer then ID2 must be + !! provided. !< subroutine apt_process_obsID12(obsrv, dis, inunitobs, iout) ! -- dummy variables @@ -3146,28 +3048,25 @@ subroutine apt_process_obsID12(obsrv, dis, inunitobs, iout) ! -- store reach number (NodeNumber) obsrv%NodeNumber = nn1 ! - ! -- return + ! -- Return return end subroutine apt_process_obsID12 + !> @brief Setup a table object an advanced package + !! + !! Set up the table object that is used to write the apt concentration + !! (or temperature) data. The terms listed here must correspond in the + !! apt_ot method. + !< subroutine apt_setup_tableobj(this) -! ****************************************************************************** -! apt_setup_tableobj -- Set up the table object that is used to write the apt -! conc data. The terms listed here must correspond in -! in the apt_ot method. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, LENBUDTXT ! -- dummy - class(GwtAptType) :: this + class(TspAptType) :: this ! -- local integer(I4B) :: nterms character(len=LINELENGTH) :: title character(len=LINELENGTH) :: text_temp -! ------------------------------------------------------------------------------ ! ! -- setup well head table if (this%iprconc > 0) then @@ -3179,7 +3078,8 @@ subroutine apt_setup_tableobj(this) ! -- set up table title title = trim(adjustl(this%text))//' PACKAGE ('// & trim(adjustl(this%packName))// & - ') CONCENTRATION FOR EACH CONTROL VOLUME' + ') '//trim(adjustl(this%depvartype))// & + &' FOR EACH CONTROL VOLUME' ! ! -- set up dv tableobj call table_cr(this%dvtab, this%packName, title) @@ -3197,7 +3097,7 @@ subroutine apt_setup_tableobj(this) call this%dvtab%initialize_column(text_temp, 10, alignment=TABCENTER) ! ! -- feature conc - text_temp = 'CONC' + text_temp = this%depvartype(1:4) call this%dvtab%initialize_column(text_temp, 12, alignment=TABCENTER) end if ! @@ -3205,4 +3105,4 @@ subroutine apt_setup_tableobj(this) return end subroutine apt_setup_tableobj -end module GwtAptModule +end module TspAptModule diff --git a/src/Model/TransportModel/tsp1fmi1.f90 b/src/Model/TransportModel/tsp1fmi1.f90 new file mode 100644 index 00000000000..fe92e15fdcf --- /dev/null +++ b/src/Model/TransportModel/tsp1fmi1.f90 @@ -0,0 +1,973 @@ +module TspFmiModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: DONE, DZERO, DHALF, LINELENGTH, LENBUDTXT, & + LENPACKAGENAME, LENVARNAME + use SimModule, only: store_error, store_error_unit + use SimVariablesModule, only: errmsg + use FlowModelInterfaceModule, only: FlowModelInterfaceType + use BaseDisModule, only: DisBaseType + use ListModule, only: ListType + use BudgetFileReaderModule, only: BudgetFileReaderType + use HeadFileReaderModule, only: HeadFileReaderType + use PackageBudgetModule, only: PackageBudgetType + use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr_bfr + use MatrixBaseModule + + implicit none + private + public :: TspFmiType + public :: fmi_cr + + character(len=LENPACKAGENAME) :: text = ' GWTFMI' + + integer(I4B), parameter :: NBDITEMS = 2 + character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt + data budtxt/' FLOW-ERROR', ' FLOW-CORRECTION'/ + + type :: DataAdvancedPackageType + real(DP), dimension(:), contiguous, pointer :: concpack => null() + real(DP), dimension(:), contiguous, pointer :: qmfrommvr => null() + end type + + type :: BudObjPtrArray + type(BudgetObjectType), pointer :: ptr + end type BudObjPtrArray + + type, extends(FlowModelInterfaceType) :: TspFmiType + + integer(I4B), dimension(:), pointer, contiguous :: iatp => null() !< advanced transport package applied to gwfpackages + integer(I4B), pointer :: iflowerr => null() !< add the flow error correction + real(DP), dimension(:), pointer, contiguous :: flowcorrect => null() !< mass flow correction + real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy + type(DataAdvancedPackageType), & + dimension(:), pointer, contiguous :: datp => null() + type(BudObjPtrArray), dimension(:), allocatable :: aptbudobj !< flow budget objects for the advanced packages + + contains + + procedure :: allocate_arrays => gwtfmi_allocate_arrays + procedure :: allocate_gwfpackages => gwtfmi_allocate_gwfpackages + procedure :: allocate_scalars => gwtfmi_allocate_scalars + procedure :: deallocate_gwfpackages => gwtfmi_deallocate_gwfpackages + procedure :: fmi_rp + procedure :: fmi_ad + procedure :: fmi_fc + procedure :: fmi_cq + procedure :: fmi_bd + procedure :: fmi_ot_flow + procedure :: fmi_da => gwtfmi_da + procedure :: gwfsatold + procedure :: initialize_gwfterms_from_bfr + procedure :: initialize_gwfterms_from_gwfbndlist + procedure :: read_options => gwtfmi_read_options + procedure :: set_aptbudobj_pointer + procedure :: read_packagedata => gwtfmi_read_packagedata + + end type TspFmiType + +contains + + !> @breif Create a new FMI object + !< + subroutine fmi_cr(fmiobj, name_model, inunit, iout, eqnsclfac, depvartype) + ! -- dummy + type(TspFmiType), pointer :: fmiobj + character(len=*), intent(in) :: name_model + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=LENVARNAME), intent(in) :: depvartype + ! + ! -- Create the object + allocate (fmiobj) + ! + ! -- create name and memory path + call fmiobj%set_names(1, name_model, 'FMI', 'FMI') + fmiobj%text = text + ! + ! -- Allocate scalars + call fmiobj%allocate_scalars() + ! + ! -- Set variables + fmiobj%inunit = inunit + fmiobj%iout = iout + ! + ! -- Initialize block parser + call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout) + ! + ! -- Assign label based on dependent variable + fmiobj%depvartype = depvartype + ! + ! -- Store pointer to governing equation scale factor + fmiobj%eqnsclfac => eqnsclfac + ! + ! -- Return + return + end subroutine fmi_cr + + !> @brief Read and prepare + !< + subroutine fmi_rp(this, inmvr) + ! -- modules + use TdisModule, only: kper, kstp + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: inmvr + ! -- local + ! -- formats + ! + ! --Check to make sure MVT Package is active if mvr flows are available. + ! This cannot be checked until RP because exchange doesn't set a pointer + ! to mvrbudobj until exg_ar(). + if (kper * kstp == 1) then + if (associated(this%mvrbudobj) .and. inmvr == 0) then + write (errmsg, '(a)') 'GWF water mover is active but the GWT MVT & + &package has not been specified. activate GWT MVT package.' + call store_error(errmsg, terminate=.TRUE.) + end if + if (.not. associated(this%mvrbudobj) .and. inmvr > 0) then + write (errmsg, '(a)') 'GWF water mover terms are not available & + &but the GWT MVT package has been activated. Activate GWF-GWT & + &exchange or specify GWFMOVER in FMI PACKAGEDATA.' + call store_error(errmsg, terminate=.TRUE.) + end if + end if + ! + ! -- Return + return + end subroutine fmi_rp + + !> @brief Advance routine for FMI object + !< + subroutine fmi_ad(this, cnew) + ! -- modules + use ConstantsModule, only: DHDRY + ! -- dummy + class(TspFmiType) :: this + real(DP), intent(inout), dimension(:) :: cnew + ! -- local + integer(I4B) :: n + integer(I4B) :: m + integer(I4B) :: ipos + real(DP) :: crewet, tflow, flownm + character(len=15) :: nodestr + character(len=*), parameter :: fmtdry = & + &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE & + &WITH DRY CONCENTRATION = ', G13.5)" + character(len=*), parameter :: fmtrewet = & + &"(/1X,'DRY CELL REACTIVATED AT ', a,& + &' WITH STARTING CONCENTRATION =',G13.5)" + ! + ! -- Set flag to indicated that flows are being updated. For the case where + ! flows may be reused (only when flows are read from a file) then set + ! the flag to zero to indicated that flows were not updated + this%iflowsupdated = 1 + ! + ! -- If reading flows from a budget file, read the next set of records + if (this%iubud /= 0) then + call this%advance_bfr() + end if + ! + ! -- If reading heads from a head file, read the next set of records + if (this%iuhds /= 0) then + call this%advance_hfr() + end if + ! + ! -- If mover flows are being read from file, read the next set of records + if (this%iumvr /= 0) then + call this%mvrbudobj%bfr_advance(this%dis, this%iout) + end if + ! + ! -- If advanced package flows are being read from file, read the next set of records + if (this%flows_from_file .and. this%inunit /= 0) then + do n = 1, size(this%aptbudobj) + call this%aptbudobj(n)%ptr%bfr_advance(this%dis, this%iout) + end do + end if + ! + ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry + do n = 1, this%dis%nodes + ! + ! -- Calculate the ibound-like array that has 0 if saturation + ! is zero and 1 otherwise + if (this%gwfsat(n) > DZERO) then + this%ibdgwfsat0(n) = 1 + else + this%ibdgwfsat0(n) = 0 + end if + ! + ! -- Check if active transport cell is inactive for flow + if (this%ibound(n) > 0) then + if (this%gwfhead(n) == DHDRY) then + ! -- transport cell should be made inactive + this%ibound(n) = 0 + cnew(n) = DHDRY + call this%dis%noder_to_string(n, nodestr) + write (this%iout, fmtdry) trim(nodestr), DHDRY + end if + end if + ! + ! -- Convert dry transport cell to active if flow has rewet + if (cnew(n) == DHDRY) then + if (this%gwfhead(n) /= DHDRY) then + ! + ! -- obtain weighted concentration + crewet = DZERO + tflow = DZERO + do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 + m = this%dis%con%ja(ipos) + flownm = this%gwfflowja(ipos) + if (flownm > 0) then + if (this%ibound(m) /= 0) then + crewet = crewet + cnew(m) * flownm + tflow = tflow + this%gwfflowja(ipos) + end if + end if + end do + if (tflow > DZERO) then + crewet = crewet / tflow + else + crewet = DZERO + end if + ! + ! -- cell is now wet + this%ibound(n) = 1 + cnew(n) = crewet + call this%dis%noder_to_string(n, nodestr) + write (this%iout, fmtrewet) trim(nodestr), crewet + end if + end if + end do + ! + ! -- Return + return + end subroutine fmi_ad + + !> @brief Calculate coefficients and fill matrix and rhs terms associated + !! with FMI object + !< + subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) + ! -- dummy + class(TspFmiType) :: this + integer, intent(in) :: nodes + real(DP), intent(in), dimension(nodes) :: cold + integer(I4B), intent(in) :: nja + class(MatrixBaseType), pointer :: matrix_sln + integer(I4B), intent(in), dimension(nja) :: idxglo + real(DP), intent(inout), dimension(nodes) :: rhs + ! -- local + integer(I4B) :: n, idiag, idiag_sln + ! + ! -- Calculate the flow imbalance error and make a correction for it + if (this%iflowerr /= 0) then + ! + ! -- Correct the transport solution for the flow imbalance by adding + ! the flow residual to the diagonal + do n = 1, nodes + idiag = this%dis%con%ia(n) + idiag_sln = idxglo(idiag) + call matrix_sln%add_value_pos(idiag_sln, -this%gwfflowja(idiag)) + end do + end if + ! + ! -- Return + return + end subroutine fmi_fc + + !> @brief Calculate flow correction + !! + !! Where there is a flow imbalance for a given cell, a correction may be + !! applied if selected + !< + subroutine fmi_cq(this, cnew, flowja) + ! -- modules + ! -- dummy + class(TspFmiType) :: this + real(DP), intent(in), dimension(:) :: cnew + real(DP), dimension(:), contiguous, intent(inout) :: flowja + ! -- local + integer(I4B) :: n + integer(I4B) :: idiag + real(DP) :: rate + ! + ! -- If not adding flow error correction, return + if (this%iflowerr /= 0) then + ! + ! -- Accumulate the flow correction term + do n = 1, this%dis%nodes + rate = DZERO + idiag = this%dis%con%ia(n) + if (this%ibound(n) > 0) then + rate = -this%gwfflowja(idiag) * cnew(n) * this%eqnsclfac + end if + this%flowcorrect(n) = rate + flowja(idiag) = flowja(idiag) + rate + end do + end if + ! + ! -- Return + return + end subroutine fmi_cq + + !> @brief Calculate budget terms associated with FMI object + !< + subroutine fmi_bd(this, isuppress_output, model_budget) + ! -- modules + use TdisModule, only: delt + use BudgetModule, only: BudgetType, rate_accumulator + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: isuppress_output + type(BudgetType), intent(inout) :: model_budget + ! -- local + real(DP) :: rin + real(DP) :: rout + ! + ! -- flow correction + if (this%iflowerr /= 0) then + call rate_accumulator(this%flowcorrect, rin, rout) + call model_budget%addentry(rin, rout, delt, budtxt(2), isuppress_output) + end if + ! + ! -- Return + return + end subroutine fmi_bd + + !> @brief Save budget terms associated with FMI object + !< + subroutine fmi_ot_flow(this, icbcfl, icbcun) + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: icbcfl + integer(I4B), intent(in) :: icbcun + ! -- local + integer(I4B) :: ibinun + integer(I4B) :: iprint, nvaluesp, nwidthp + character(len=1) :: cdatafmp = ' ', editdesc = ' ' + real(DP) :: dinact + ! + ! -- Set unit number for binary output + if (this%ipakcb < 0) then + ibinun = icbcun + elseif (this%ipakcb == 0) then + ibinun = 0 + else + ibinun = this%ipakcb + end if + if (icbcfl == 0) ibinun = 0 + ! + ! -- Do not save flow corrections if not active + if (this%iflowerr == 0) ibinun = 0 + ! + ! -- Record the storage rates if requested + if (ibinun /= 0) then + iprint = 0 + dinact = DZERO + ! + ! -- flow correction + call this%dis%record_array(this%flowcorrect, this%iout, iprint, -ibinun, & + budtxt(2), cdatafmp, nvaluesp, & + nwidthp, editdesc, dinact) + end if + ! + ! -- Return + return + end subroutine fmi_ot_flow + + !> @brief Deallocate variables + !! + !! Deallocate memory associated with FMI object + !< + subroutine gwtfmi_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(TspFmiType) :: this + ! -- todo: finalize hfr and bfr either here or in a finalize routine + ! + ! -- deallocate any memory stored with gwfpackages + call this%deallocate_gwfpackages() + ! + ! -- deallocate fmi arrays + if (associated(this%datp)) then + deallocate (this%datp) + deallocate (this%gwfpackages) + deallocate (this%flowpacknamearray) + call mem_deallocate(this%iatp) + call mem_deallocate(this%igwfmvrterm) + end if + + deallocate (this%aptbudobj) + call mem_deallocate(this%flowcorrect) + call mem_deallocate(this%ibdgwfsat0) + if (this%flows_from_file) then + call mem_deallocate(this%gwfstrgss) + call mem_deallocate(this%gwfstrgsy) + end if + ! + ! -- special treatment, these could be from mem_checkin + call mem_deallocate(this%gwfhead, 'GWFHEAD', this%memoryPath) + call mem_deallocate(this%gwfsat, 'GWFSAT', this%memoryPath) + call mem_deallocate(this%gwfspdis, 'GWFSPDIS', this%memoryPath) + call mem_deallocate(this%gwfflowja, 'GWFFLOWJA', this%memoryPath) + ! + ! -- deallocate scalars + call mem_deallocate(this%flows_from_file) + call mem_deallocate(this%iflowsupdated) + call mem_deallocate(this%iflowerr) + call mem_deallocate(this%igwfstrgss) + call mem_deallocate(this%igwfstrgsy) + call mem_deallocate(this%iubud) + call mem_deallocate(this%iuhds) + call mem_deallocate(this%iumvr) + call mem_deallocate(this%nflowpack) + ! + ! -- deallocate parent + call this%NumericalPackageType%da() + ! + ! -- Return + return + end subroutine gwtfmi_da + + !> @ brief Allocate scalars + !! + !! Allocate scalar variables for an FMI object + !< + subroutine gwtfmi_allocate_scalars(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr + ! -- dummy + class(TspFmiType) :: this + ! -- local + ! + ! -- allocate scalars in parent + call this%FlowModelInterfaceType%allocate_scalars() + ! + ! -- Allocate + call mem_allocate(this%iflowerr, 'IFLOWERR', this%memoryPath) + ! + ! -- Although not a scalar, allocate the advanced package transport + ! budget object to zero so that it can be dynamically resized later + allocate (this%aptbudobj(0)) + ! + ! -- Initialize + this%iflowerr = 0 + ! + ! -- Return + return + end subroutine gwtfmi_allocate_scalars + + !> @ brief Allocate arrays for FMI object + !! + !! Method to allocate arrays for the FMI package. + !< + subroutine gwtfmi_allocate_arrays(this, nodes) + use MemoryManagerModule, only: mem_allocate + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: nodes + ! -- local + integer(I4B) :: n + ! + ! -- allocate parent arrays + call this%FlowModelInterfaceType%allocate_arrays(nodes) + ! + ! -- Allocate variables needed for all cases + if (this%iflowerr == 0) then + call mem_allocate(this%flowcorrect, 1, 'FLOWCORRECT', this%memoryPath) + else + call mem_allocate(this%flowcorrect, nodes, 'FLOWCORRECT', this%memoryPath) + end if + do n = 1, size(this%flowcorrect) + this%flowcorrect(n) = DZERO + end do + ! + ! -- return + return + end subroutine gwtfmi_allocate_arrays + + !> @brief Calculate the previous saturation level + !! + !! Calculate the groundwater cell head saturation for the end of + !! the last time step + !< + function gwfsatold(this, n, delt) result(satold) + ! -- modules + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: n + real(DP), intent(in) :: delt + ! -- result + real(DP) :: satold + ! -- local + real(DP) :: vcell + real(DP) :: vnew + real(DP) :: vold + ! + ! -- calculate the value + vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n)) + vnew = vcell * this%gwfsat(n) + vold = vnew + if (this%igwfstrgss /= 0) vold = vold + this%gwfstrgss(n) * delt + if (this%igwfstrgsy /= 0) vold = vold + this%gwfstrgsy(n) * delt + satold = vold / vcell + ! + ! -- Return + return + end function gwfsatold + + !> @brief Read options from input file + !< + subroutine gwtfmi_read_options(this) + ! -- modules + use ConstantsModule, only: LINELENGTH, DEM6 + use InputOutputModule, only: getunit, openfile, urdaux + use SimModule, only: store_error, store_error_unit + ! -- dummy + class(TspFmiType) :: this + ! -- local + character(len=LINELENGTH) :: keyword + integer(I4B) :: ierr + logical :: isfound, endOfBlock + character(len=*), parameter :: fmtisvflow = & + "(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY FILE & + &WHENEVER ICBCFL IS NOT ZERO AND FLOW IMBALANCE CORRECTION ACTIVE.')" + character(len=*), parameter :: fmtifc = & + &"(4x,'MASS WILL BE ADDED OR REMOVED TO COMPENSATE FOR FLOW IMBALANCE.')" + ! + ! -- get options block + call this%parser%GetBlock('OPTIONS', isfound, ierr, blockRequired=.false., & + supportOpenClose=.true.) + ! + ! -- parse options block if detected + if (isfound) then + write (this%iout, '(1x,a)') 'PROCESSING FMI OPTIONS' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('SAVE_FLOWS') + this%ipakcb = -1 + write (this%iout, fmtisvflow) + case ('FLOW_IMBALANCE_CORRECTION') + write (this%iout, fmtifc) + this%iflowerr = 1 + case default + write (errmsg, '(a,a)') 'Unknown FMI option: ', & + trim(keyword) + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end select + end do + write (this%iout, '(1x,a)') 'END OF FMI OPTIONS' + end if + ! + ! -- Return + return + end subroutine gwtfmi_read_options + + !> @brief Read PACKAGEDATA block + !! + !! Read packagedata block from input file + !< + subroutine gwtfmi_read_packagedata(this) + ! -- modules + use OpenSpecModule, only: ACCESS, FORM + use ConstantsModule, only: LINELENGTH, DEM6, LENPACKAGENAME + use InputOutputModule, only: getunit, openfile, urdaux + use SimModule, only: store_error, store_error_unit + ! -- dummy + class(TspFmiType) :: this + ! -- local + type(BudgetObjectType), pointer :: budobjptr + character(len=LINELENGTH) :: keyword, fname + character(len=LENPACKAGENAME) :: pname + integer(I4B) :: i + integer(I4B) :: ierr + integer(I4B) :: inunit + integer(I4B) :: iapt + logical :: isfound, endOfBlock + logical :: blockrequired + logical :: exist + type(BudObjPtrArray), dimension(:), allocatable :: tmpbudobj + ! + ! -- initialize + iapt = 0 + blockrequired = .true. + ! + ! -- get options block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + blockRequired=blockRequired, & + supportOpenClose=.true.) + ! + ! -- parse options block if detected + if (isfound) then + write (this%iout, '(1x,a)') 'PROCESSING FMI PACKAGEDATA' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('GWFBUDGET') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFBUDGET keyword must be followed by '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inunit = getunit() + inquire (file=trim(fname), exist=exist) + if (.not. exist) then + call store_error('Could not find file '//trim(fname)) + call this%parser%StoreErrorUnit() + end if + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iubud = inunit + call this%initialize_bfr() + case ('GWFHEAD') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFHEAD keyword must be followed by '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inquire (file=trim(fname), exist=exist) + if (.not. exist) then + call store_error('Could not find file '//trim(fname)) + call this%parser%StoreErrorUnit() + end if + inunit = getunit() + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iuhds = inunit + call this%initialize_hfr() + case ('GWFMOVER') + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('GWFMOVER keyword must be followed by '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inunit = getunit() + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + this%iumvr = inunit + call budgetobject_cr_bfr(this%mvrbudobj, 'MVT', this%iumvr, & + this%iout) + call this%mvrbudobj%fill_from_bfr(this%dis, this%iout) + case default + ! + ! --expand the size of aptbudobj, which stores a pointer to the budobj + allocate (tmpbudobj(iapt)) + do i = 1, size(this%aptbudobj) + tmpbudobj(i)%ptr => this%aptbudobj(i)%ptr + end do + deallocate (this%aptbudobj) + allocate (this%aptbudobj(iapt + 1)) + do i = 1, size(tmpbudobj) + this%aptbudobj(i)%ptr => tmpbudobj(i)%ptr + end do + deallocate (tmpbudobj) + ! + ! -- Open the budget file and start filling it + iapt = iapt + 1 + pname = keyword(1:LENPACKAGENAME) + call this%parser%GetStringCaps(keyword) + if (keyword /= 'FILEIN') then + call store_error('Package name must be followed by '// & + '"FILEIN" then by filename.') + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + inunit = getunit() + call openfile(inunit, this%iout, fname, 'DATA(BINARY)', FORM, & + ACCESS, 'UNKNOWN') + call budgetobject_cr_bfr(budobjptr, pname, inunit, & + this%iout, colconv2=['GWF ']) + call budobjptr%fill_from_bfr(this%dis, this%iout) + this%aptbudobj(iapt)%ptr => budobjptr + end select + end do + write (this%iout, '(1x,a)') 'END OF FMI PACKAGEDATA' + end if + ! + ! -- Return + return + end subroutine gwtfmi_read_packagedata + + !> @brief Set the pointer to a budget object + !! + !! An advanced transport can pass in a name and a + !! pointer budget object, and this routine will look through the budget + !! objects managed by FMI and point to the one with the same name, such as + !! LAK-1, SFR-1, etc. + !< + subroutine set_aptbudobj_pointer(this, name, budobjptr) + ! -- modules + class(TspFmiType) :: this + ! -- dumm + character(len=*), intent(in) :: name + type(BudgetObjectType), pointer :: budobjptr + ! -- local + integer(I4B) :: i + ! + ! -- find and set the pointer + do i = 1, size(this%aptbudobj) + if (this%aptbudobj(i)%ptr%name == name) then + budobjptr => this%aptbudobj(i)%ptr + exit + end if + end do + ! + ! -- Return + return + end subroutine set_aptbudobj_pointer + + !> @brief Initialize the groundwater flow terms based on the budget file + !! reader + !! + !! Initalize terms and figure out how many different terms and packages + !! are contained within the file + !< + subroutine initialize_gwfterms_from_bfr(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use SimModule, only: store_error, store_error_unit, count_errors + ! -- dummy + class(TspFmiType) :: this + ! -- local + integer(I4B) :: nflowpack + integer(I4B) :: i, ip + integer(I4B) :: naux + logical :: found_flowja + logical :: found_dataspdis + logical :: found_datasat + logical :: found_stoss + logical :: found_stosy + integer(I4B), dimension(:), allocatable :: imap + ! + ! -- Calculate the number of gwf flow packages + allocate (imap(this%bfr%nbudterms)) + imap(:) = 0 + nflowpack = 0 + found_flowja = .false. + found_dataspdis = .false. + found_datasat = .false. + found_stoss = .false. + found_stosy = .false. + do i = 1, this%bfr%nbudterms + select case (trim(adjustl(this%bfr%budtxtarray(i)))) + case ('FLOW-JA-FACE') + found_flowja = .true. + case ('DATA-SPDIS') + found_dataspdis = .true. + case ('DATA-SAT') + found_datasat = .true. + case ('STO-SS') + found_stoss = .true. + this%igwfstrgss = 1 + case ('STO-SY') + found_stosy = .true. + this%igwfstrgsy = 1 + case default + nflowpack = nflowpack + 1 + imap(i) = 1 + end select + end do + ! + ! -- allocate gwfpackage arrays (gwfpackages, iatp, datp, ...) + call this%allocate_gwfpackages(nflowpack) + ! + ! -- Copy the package name and aux names from budget file reader + ! to the gwfpackages derived-type variable + ip = 1 + do i = 1, this%bfr%nbudterms + if (imap(i) == 0) cycle + call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), & + this%bfr%budtxtarray(i)) + naux = this%bfr%nauxarray(i) + call this%gwfpackages(ip)%set_auxname(naux, & + this%bfr%auxtxtarray(1:naux, i)) + ip = ip + 1 + end do + ! + ! -- Copy just the package names for the boundary packages into + ! the flowpacknamearray + ip = 1 + do i = 1, size(imap) + if (imap(i) == 1) then + this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i) + ip = ip + 1 + end if + end do + ! + ! -- Error if specific discharge, saturation or flowja not found + if (.not. found_dataspdis) then + write (errmsg, '(a)') 'Specific discharge not found in & + &budget file. SAVE_SPECIFIC_DISCHARGE and & + &SAVE_FLOWS must be activated in the NPF package.' + call store_error(errmsg) + end if + if (.not. found_datasat) then + write (errmsg, '(a)') 'Saturation not found in & + &budget file. SAVE_SATURATION and & + &SAVE_FLOWS must be activated in the NPF package.' + call store_error(errmsg) + end if + if (.not. found_flowja) then + write (errmsg, '(a)') 'FLOWJA not found in & + &budget file. SAVE_FLOWS must & + &be activated in the NPF package.' + call store_error(errmsg) + end if + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + ! + ! -- Return + return + end subroutine initialize_gwfterms_from_bfr + + !> @brief Initialize groundwater flow terms from the groundwater budget + !! + !! Flows are coming from a gwf-gwt exchange object + !< + subroutine initialize_gwfterms_from_gwfbndlist(this) + ! -- modules + use BndModule, only: BndType, GetBndFromList + ! -- dummy + class(TspFmiType) :: this + ! -- local + integer(I4B) :: ngwfpack + integer(I4B) :: ngwfterms + integer(I4B) :: ip + integer(I4B) :: imover + integer(I4B) :: ntomvr + integer(I4B) :: iterm + character(len=LENPACKAGENAME) :: budtxt + class(BndType), pointer :: packobj => null() + ! + ! -- determine size of gwf terms + ngwfpack = this%gwfbndlist%Count() + ! + ! -- Count number of to-mvr terms, but do not include advanced packages + ! as those mover terms are not losses from the cell, but rather flows + ! within the advanced package + ntomvr = 0 + do ip = 1, ngwfpack + packobj => GetBndFromList(this%gwfbndlist, ip) + imover = packobj%imover + if (packobj%isadvpak /= 0) imover = 0 + if (imover /= 0) then + ntomvr = ntomvr + 1 + end if + end do + ! + ! -- Allocate arrays in fmi of size ngwfterms, which is the number of + ! packages plus the number of packages with mover terms. + ngwfterms = ngwfpack + ntomvr + call this%allocate_gwfpackages(ngwfterms) + ! + ! -- Assign values in the fmi package + iterm = 1 + do ip = 1, ngwfpack + ! + ! -- set and store names + packobj => GetBndFromList(this%gwfbndlist, ip) + budtxt = adjustl(packobj%text) + call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) + this%flowpacknamearray(iterm) = packobj%packName + call this%gwfpackages(iterm)%set_auxname(packobj%naux, & + packobj%auxname) + iterm = iterm + 1 + ! + ! -- if this package has a mover associated with it, then add another + ! term that corresponds to the mover flows + imover = packobj%imover + if (packobj%isadvpak /= 0) imover = 0 + if (imover /= 0) then + budtxt = trim(adjustl(packobj%text))//'-TO-MVR' + call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt) + this%flowpacknamearray(iterm) = packobj%packName + call this%gwfpackages(iterm)%set_auxname(packobj%naux, & + packobj%auxname) + this%igwfmvrterm(iterm) = 1 + iterm = iterm + 1 + end if + end do + ! + ! -- Return + return + end subroutine initialize_gwfterms_from_gwfbndlist + + !> @brief Initialize an array for storing PackageBudget objects. + !! + !! This routine allocates gwfpackages (an array of PackageBudget + !! objects) to the proper size and initializes member variables. + !< + subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms) + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_allocate + ! -- dummy + class(TspFmiType) :: this + integer(I4B), intent(in) :: ngwfterms + ! -- local + integer(I4B) :: n + character(len=LENMEMPATH) :: memPath + ! + ! -- direct allocate + allocate (this%gwfpackages(ngwfterms)) + allocate (this%flowpacknamearray(ngwfterms)) + allocate (this%datp(ngwfterms)) + ! + ! -- mem_allocate + call mem_allocate(this%iatp, ngwfterms, 'IATP', this%memoryPath) + call mem_allocate(this%igwfmvrterm, ngwfterms, 'IGWFMVRTERM', this%memoryPath) + ! + ! -- initialize + this%nflowpack = ngwfterms + do n = 1, this%nflowpack + this%iatp(n) = 0 + this%igwfmvrterm(n) = 0 + this%flowpacknamearray(n) = '' + ! + ! -- Create a mempath for each individual flow package data set + ! of the form, MODELNAME/FMI-FTn + write (memPath, '(a, i0)') trim(this%memoryPath)//'-FT', n + call this%gwfpackages(n)%initialize(memPath) + end do + ! + ! -- Return + return + end subroutine gwtfmi_allocate_gwfpackages + + !> @brief Deallocate memory + !! + !! Deallocate memory that stores the gwfpackages array + !< + subroutine gwtfmi_deallocate_gwfpackages(this) + ! -- modules + ! -- dummy + class(TspFmiType) :: this + ! -- local + integer(I4B) :: n + ! + ! -- initialize + do n = 1, this%nflowpack + call this%gwfpackages(n)%da() + end do + ! + ! -- Return + return + end subroutine gwtfmi_deallocate_gwfpackages + +end module TspFmiModule diff --git a/src/Model/TransportModel/tsp1ic1.f90 b/src/Model/TransportModel/tsp1ic1.f90 new file mode 100644 index 00000000000..e36ca15a88e --- /dev/null +++ b/src/Model/TransportModel/tsp1ic1.f90 @@ -0,0 +1,53 @@ +module TspIcModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: LENVARNAME + use GwfIcModule, only: GwfIcType + use BlockParserModule, only: BlockParserType + use BaseDisModule, only: DisBaseType + + implicit none + private + public :: TspIcType + public :: ic_cr + + ! -- Most of the TspIcType functionality comes from GwfIcType + type, extends(GwfIcType) :: TspIcType + ! -- strings + character(len=LENVARNAME) :: depvartype = '' + end type TspIcType + +contains + + !> @brief Create a new initial conditions object + !< + subroutine ic_cr(ic, name_model, input_mempath, inunit, iout, dis, depvartype) + ! -- dummy + type(TspIcType), pointer :: ic + character(len=*), intent(in) :: name_model + character(len=*), intent(in) :: input_mempath + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + class(DisBaseType), pointer, intent(in) :: dis + character(len=LENVARNAME), intent(in) :: depvartype + ! + ! -- Create the object + allocate (ic) + ! + ! -- create name and memory path + call ic%set_names(1, name_model, 'IC', 'IC', input_mempath) + ! + ! -- Allocate scalars + call ic%allocate_scalars() + ! + ic%inunit = inunit + ic%iout = iout + ! + ! -- set pointers + ic%dis => dis + ! + ! -- Give package access to the assigned labelsd based on dependent variable + ic%depvartype = depvartype + end subroutine ic_cr + +end module TspIcModule diff --git a/src/Model/GroundWaterTransport/gwt1mvt1.f90 b/src/Model/TransportModel/tsp1mvt1.f90 similarity index 78% rename from src/Model/GroundWaterTransport/gwt1mvt1.f90 rename to src/Model/TransportModel/tsp1mvt1.f90 index 732b2e59ac3..a0b1530dc80 100644 --- a/src/Model/GroundWaterTransport/gwt1mvt1.f90 +++ b/src/Model/TransportModel/tsp1mvt1.f90 @@ -2,7 +2,7 @@ ! -- This module is responsible for sending mass from providers into ! -- receiver qmfrommvr arrays and writing a mover transport budget -module GwtMvtModule +module TspMvtModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, LENPAKLOC, & @@ -11,7 +11,7 @@ module GwtMvtModule use SimModule, only: store_error use BaseDisModule, only: DisBaseType use NumericalPackageModule, only: NumericalPackageType - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use BudgetModule, only: BudgetType, budget_cr use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr use TableModule, only: TableType, table_cr @@ -19,17 +19,18 @@ module GwtMvtModule implicit none private - public :: GwtMvtType + public :: TspMvtType public :: mvt_cr - type, extends(NumericalPackageType) :: GwtMvtType + type, extends(NumericalPackageType) :: TspMvtType character(len=LENMODELNAME) :: gwfmodelname1 = '' !< name of model 1 character(len=LENMODELNAME) :: gwfmodelname2 = '' !< name of model 2 (set to modelname 1 for single model MVT) integer(I4B), pointer :: maxpackages !< max number of packages integer(I4B), pointer :: ibudgetout => null() !< unit number for budget output file integer(I4B), pointer :: ibudcsv => null() !< unit number for csv budget output file - type(GwtFmiType), pointer :: fmi1 => null() !< pointer to fmi object for model 1 - type(GwtFmiType), pointer :: fmi2 => null() !< pointer to fmi object for model 2 (set to fmi1 for single model) + real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy + type(TspFmiType), pointer :: fmi1 => null() !< pointer to fmi object for model 1 + type(TspFmiType), pointer :: fmi2 => null() !< pointer to fmi object for model 2 (set to fmi1 for single model) type(BudgetType), pointer :: budget => null() !< mover transport budget object (used to write balance table) type(BudgetObjectType), pointer :: budobj => null() !< budget container (used to write binary file) type(BudgetObjectType), pointer :: mvrbudobj => null() !< pointer to the water mover budget object @@ -58,27 +59,24 @@ module GwtMvtModule procedure :: set_fmi_pr_rc procedure, private :: mvt_setup_outputtab procedure, private :: mvt_print_outputtab - end type GwtMvtType + end type TspMvtType contains - subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, gwfmodelname1, & - gwfmodelname2, fmi2) -! ****************************************************************************** -! mvt_cr -- Create a new initial conditions object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new mover transport object + !< + subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, & + gwfmodelname1, gwfmodelname2, fmi2) ! -- dummy - type(GwtMvtType), pointer :: mvt + type(TspMvtType), pointer :: mvt character(len=*), intent(in) :: name_model integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout - type(GwtFmiType), intent(in), target :: fmi1 + type(TspFmiType), intent(in), target :: fmi1 + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor character(len=*), intent(in), optional :: gwfmodelname1 character(len=*), intent(in), optional :: gwfmodelname2 - type(GwtFmiType), intent(in), target, optional :: fmi2 + type(TspFmiType), intent(in), target, optional :: fmi2 ! ------------------------------------------------------------------------------ ! ! -- Create the object @@ -113,20 +111,19 @@ subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, gwfmodelname1, & ! -- create the budget object call budgetobject_cr(mvt%budobj, 'TRANSPORT MOVER') ! + ! -- Store pointer to governing equation scale factor + mvt%eqnsclfac => eqnsclfac + ! ! -- Return return end subroutine mvt_cr + !> @brief Define mover transport object + !< subroutine mvt_df(this, dis) -! ****************************************************************************** -! mvt_df -- Define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this class(DisBaseType), pointer, intent(in) :: dis ! -- local ! -- formats @@ -162,21 +159,17 @@ end subroutine mvt_df !! !< subroutine set_pointer_mvrbudobj(this, mvrbudobj) - class(GwtMvtType) :: this + class(TspMvtType) :: this type(BudgetObjectType), intent(in), target :: mvrbudobj this%mvrbudobj => mvrbudobj end subroutine set_pointer_mvrbudobj + !> @brief Allocate and read mover-for-transport information + !< subroutine mvt_ar(this) -! ****************************************************************************** -! mvt_ar -- Allocate and read water mover information -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- locals ! ------------------------------------------------------------------------------ ! @@ -187,17 +180,13 @@ subroutine mvt_ar(this) return end subroutine mvt_ar + !> @brief Read and prepare mover transport object + !< subroutine mvt_rp(this) -! ****************************************************************************** -! mvt_rp -- Read and prepare -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kper, kstp ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- local ! -- formats ! ------------------------------------------------------------------------------ @@ -224,22 +213,18 @@ subroutine mvt_rp(this) return end subroutine mvt_rp + !> @brief Calculate coefficients and fill amat and rhs + !! + !! The mvt package adds the mass flow rate to the provider qmfrommvr array. + !! The advanced packages know enough to subract any mass that is leaving, so + !! the mvt just adds mass coming in from elsewhere. Because the movers + !! change by stress period, their solute effects must be added to the right- + !! hand side of the transport matrix equations. + !< subroutine mvt_fc(this, cnew1, cnew2) -! ****************************************************************************** -! mvt_fc -- Calculate coefficients and fill amat and rhs -! -! The mvt package adds the mass flow rate to the provider qmfrommvr -! array. The advanced packages know enough to subract any mass that is -! leaving, so the mvt just adds mass coming in from elsewhere. Because the -! movers change change by stress period, their solute effects must be -! added to the right-hand side of the gwt matrix equations. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this real(DP), intent(in), dimension(:), contiguous, target :: cnew1 real(DP), intent(in), dimension(:), contiguous, target :: cnew2 ! -- local @@ -251,8 +236,8 @@ subroutine mvt_fc(this, cnew1, cnew2) real(DP) :: q, cp real(DP), dimension(:), pointer :: concpak real(DP), dimension(:), contiguous, pointer :: cnew - type(GwtFmiType), pointer :: fmi_pr !< pointer to provider model fmi package - type(GwtFmiType), pointer :: fmi_rc !< pointer to receiver model fmi package + type(TspFmiType), pointer :: fmi_pr !< pointer to provider model fmi package + type(TspFmiType), pointer :: fmi_rc !< pointer to receiver model fmi package ! ------------------------------------------------------------------------------ ! ! -- Add mover QC terms to the receiver packages @@ -313,7 +298,7 @@ subroutine mvt_fc(this, cnew1, cnew2) ! water into the same receiver if (fmi_rc%iatp(irc) /= 0) then fmi_rc%datp(irc)%qmfrommvr(id2) = fmi_rc%datp(irc)%qmfrommvr(id2) - & - q * cp + q * cp * this%eqnsclfac end if end do end if @@ -325,20 +310,19 @@ end subroutine mvt_fc !> @ brief Set the fmi_pr and fmi_rc pointers !! - !! The fmi_pr and fmi_rc arguments are pointers to the provider - !! and receiver FMI Packages. If this MVT Package is owned by - !! a single GWT model, then these pointers are both set to the - !! FMI Package of this GWT model's FMI Package. If this MVT - !! Package is owned by a GWTGWT Exchange, then the fmi_pr and - !! fmi_rc pointers may be assigned to FMI Packages in different models. - !! + !! The fmi_pr and fmi_rc arguments are pointers to the provider and receiver + !! FMI Packages. If this MVT Package is owned by a single GWT model, then + !! these pointers are both set to the FMI Package of this GWT model's FMI + !! package. If this MVT package is owned by a GWTGWT exchange, then the + !! fmi_pr and fmi_rc pointers may be assigned to FMI Packages in different + !! models. !< subroutine set_fmi_pr_rc(this, ibudterm, fmi_pr, fmi_rc) ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this integer(I4B), intent(in) :: ibudterm - type(GwtFmiType), pointer :: fmi_pr - type(GwtFmiType), pointer :: fmi_rc + type(TspFmiType), pointer :: fmi_pr + type(TspFmiType), pointer :: fmi_rc fmi_pr => null() fmi_rc => null() @@ -389,19 +373,16 @@ subroutine set_fmi_pr_rc(this, ibudterm, fmi_pr, fmi_rc) print *, 'Could not find FMI Package...' stop "error in set_fmi_pr_rc" end if - + ! + ! -- Return return end subroutine set_fmi_pr_rc + !> @brief Extra convergence check for mover + !< subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak) -! ****************************************************************************** -! mvt_cc -- extra convergence check for mover -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this integer(I4B), intent(in) :: kiter integer(I4B), intent(in) :: iend integer(I4B), intent(in) :: icnvgmod @@ -412,7 +393,6 @@ subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak) character(len=*), parameter :: fmtmvrcnvg = & "(/,1x,'MOVER PACKAGE REQUIRES AT LEAST TWO OUTER ITERATIONS. CONVERGE & &FLAG HAS BEEN RESET TO FALSE.')" -! ------------------------------------------------------------------------------ ! ! -- If there are active movers, then at least 2 outers required if (associated(this%mvrbudobj)) then @@ -427,16 +407,12 @@ subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak) return end subroutine mvt_cc + !> @brief Write mover terms to listing file + !< subroutine mvt_bd(this, cnew1, cnew2) -! ****************************************************************************** -! mvt_bd -- Write mover terms to listing file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this real(DP), dimension(:), contiguous, intent(in) :: cnew1 real(DP), dimension(:), contiguous, intent(in) :: cnew2 ! -- local @@ -449,17 +425,13 @@ subroutine mvt_bd(this, cnew1, cnew2) return end subroutine mvt_bd + !> @brief Write mover budget terms + !< subroutine mvt_ot_saveflow(this, icbcfl, ibudfl) -! ****************************************************************************** -! mvt_bd -- Write mover terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper, delt, pertim, totim ! -- dummy - class(GwtMvttype) :: this + class(TspMvttype) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl ! -- locals @@ -481,16 +453,12 @@ subroutine mvt_ot_saveflow(this, icbcfl, ibudfl) return end subroutine mvt_ot_saveflow + !> @brief Print mover flow table + !< subroutine mvt_ot_printflow(this, icbcfl, ibudfl) -! ****************************************************************************** -! mvr_ot_printflow -- Print mover flow table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl ! -- locals @@ -505,18 +473,14 @@ subroutine mvt_ot_printflow(this, icbcfl, ibudfl) return end subroutine mvt_ot_printflow + !> @brief Write mover budget to listing file + !< subroutine mvt_ot_bdsummary(this, ibudfl) -! ****************************************************************************** -! mvt_ot_bdsummary -- Write mover budget to listing file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper, delt, totim use ArrayHandlersModule, only: ifind, expandarray ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this integer(I4B), intent(in) :: ibudfl ! -- locals integer(I4B) :: i, j, n @@ -582,17 +546,15 @@ subroutine mvt_ot_bdsummary(this, ibudfl) return end subroutine mvt_ot_bdsummary + !> @ brief Deallocate memory + !! + !! Method to deallocate memory for the package. + !< subroutine mvt_da(this) -! ****************************************************************************** -! mvt_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- local ! ------------------------------------------------------------------------------ ! @@ -634,17 +596,15 @@ subroutine mvt_da(this) return end subroutine mvt_da + !> @ brief Allocate scalar variables for package + !! + !! Method to allocate scalar variables for the MVT package. + !< subroutine allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- local ! ------------------------------------------------------------------------------ ! @@ -665,18 +625,14 @@ subroutine allocate_scalars(this) return end subroutine allocate_scalars + !> @brief Read mover-for-transport options block + !< subroutine read_options(this) -! ****************************************************************************** -! read_options -- Read Options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use OpenSpecModule, only: access, form use InputOutputModule, only: getunit, openfile ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- local character(len=LINELENGTH) :: errmsg, keyword character(len=MAXCHARLEN) :: fname @@ -751,17 +707,13 @@ subroutine read_options(this) return end subroutine read_options + !> @brief Set up the budget object that stores all the mvr flows + !< subroutine mvt_setup_budobj(this) -! ****************************************************************************** -! mvt_setup_budobj -- Set up the budget object that stores all the mvr flows -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this ! -- local integer(I4B) :: nbudterm integer(I4B) :: ncv @@ -798,27 +750,22 @@ subroutine mvt_setup_budobj(this) maxlist, .false., .false., & naux) end do - ! - ! -- return + ! -- Return return end subroutine mvt_setup_budobj + !> @brief Copy mover-for-transport flow terms into this%budobj + !< subroutine mvt_fill_budobj(this, cnew1, cnew2) -! ****************************************************************************** -! mvt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy - class(GwtMvtType) :: this + class(TspMvtType) :: this real(DP), intent(in), dimension(:), contiguous, target :: cnew1 real(DP), intent(in), dimension(:), contiguous, target :: cnew2 ! -- local - type(GwtFmiType), pointer :: fmi_pr - type(GwtFmiType), pointer :: fmi_rc + type(TspFmiType), pointer :: fmi_pr + type(TspFmiType), pointer :: fmi_rc real(DP), dimension(:), contiguous, pointer :: cnew integer(I4B) :: nbudterm integer(I4B) :: nlist @@ -864,7 +811,7 @@ subroutine mvt_fill_budobj(this, cnew1, cnew2) ! -- Calculate solute mover rate rate = DZERO if (fmi_rc%iatp(irc) /= 0) then - rate = -q * cp + rate = -q * cp * this%eqnsclfac end if ! ! -- add the rate to the budterm @@ -879,21 +826,18 @@ subroutine mvt_fill_budobj(this, cnew1, cnew2) return end subroutine mvt_fill_budobj + !> @brief Determine max number of packages in use + !! + !! Scan through the gwf water mover budget object and determine the maximum + !! number of packages and unique package names + !< subroutine mvt_scan_mvrbudobj(this) -! ****************************************************************************** -! mvt_scan_mvrbudobj -- scan through the gwf water mover budget object and -! determine the maximum number of packages and unique package names -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - class(GwtMvtType) :: this + class(TspMvtType) :: this integer(I4B) :: nbudterm integer(I4B) :: maxpackages integer(I4B) :: i, j integer(I4B) :: ipos logical :: found -! ------------------------------------------------------------------------------ ! ! -- Calculate maxpackages, which is the the square of nbudterm nbudterm = this%mvrbudobj%nbudterm @@ -931,22 +875,17 @@ subroutine mvt_scan_mvrbudobj(this) return end subroutine mvt_scan_mvrbudobj + !> @brief Set up the mover-for-transport output table + !< subroutine mvt_setup_outputtab(this) -! ****************************************************************************** -! mvt_setup_outputtab -- set up output table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtMvtType), intent(inout) :: this + class(TspMvtType), intent(inout) :: this ! -- local character(len=LINELENGTH) :: title character(len=LINELENGTH) :: text integer(I4B) :: ntabcol integer(I4B) :: maxrow integer(I4B) :: ilen -! ------------------------------------------------------------------------------ ! ! -- allocate and initialize the output table if (this%iprflow /= 0) then @@ -984,17 +923,13 @@ subroutine mvt_setup_outputtab(this) return end subroutine mvt_setup_outputtab + !> @brief Set up mover-for-transport output table + !< subroutine mvt_print_outputtab(this) -! ****************************************************************************** -! mvt_print_outputtab -- set up output table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- module use TdisModule, only: kstp, kper ! -- dummy - class(GwtMvttype), intent(inout) :: this + class(TspMvttype), intent(inout) :: this ! -- local character(len=LINELENGTH) :: title character(len=LENMODELNAME + LENPACKAGENAME + 1) :: cloc1, cloc2 @@ -1045,5 +980,5 @@ subroutine mvt_print_outputtab(this) return end subroutine mvt_print_outputtab -end module GwtMvtModule +end module TspMvtModule diff --git a/src/Model/GroundWaterTransport/gwt1obs1.f90 b/src/Model/TransportModel/tsp1obs1.f90 similarity index 54% rename from src/Model/GroundWaterTransport/gwt1obs1.f90 rename to src/Model/TransportModel/tsp1obs1.f90 index 48dd58f0e7c..55e4114bf0a 100644 --- a/src/Model/GroundWaterTransport/gwt1obs1.f90 +++ b/src/Model/TransportModel/tsp1obs1.f90 @@ -1,9 +1,9 @@ -module GwtObsModule +module TspObsModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, MAXOBSTYPES use BaseDisModule, only: DisBaseType - use GwtIcModule, only: GwtIcType + use TspIcModule, only: TspIcType use ObserveModule, only: ObserveType use ObsModule, only: ObsType use SimModule, only: count_errors, store_error, & @@ -11,40 +11,37 @@ module GwtObsModule implicit none private - public :: GwtObsType, gwt_obs_cr + public :: TspObsType, tsp_obs_cr - type, extends(ObsType) :: GwtObsType + type, extends(ObsType) :: TspObsType ! -- Private members - type(GwtIcType), pointer, private :: ic => null() ! initial conditions + type(TspIcType), pointer, private :: ic => null() ! initial conditions real(DP), dimension(:), pointer, contiguous, private :: x => null() ! concentration real(DP), dimension(:), pointer, contiguous, private :: flowja => null() ! intercell flows contains ! -- Public procedures - procedure, public :: gwt_obs_ar - procedure, public :: obs_bd => gwt_obs_bd - procedure, public :: obs_df => gwt_obs_df - procedure, public :: obs_rp => gwt_obs_rp - procedure, public :: obs_da => gwt_obs_da + procedure, public :: tsp_obs_ar + procedure, public :: obs_bd => tsp_obs_bd + procedure, public :: obs_df => tsp_obs_df + procedure, public :: obs_rp => tsp_obs_rp + procedure, public :: obs_da => tsp_obs_da ! -- Private procedures procedure, private :: set_pointers - end type GwtObsType + end type TspObsType contains - subroutine gwt_obs_cr(obs, inobs) -! ****************************************************************************** -! gwt_obs_cr -- Create a new GwtObsType object -! Subroutine: (1) creates object -! (2) allocates pointers -! (3) initializes values -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a new TspObsType object + !! + !! This routine: + !! - creates an observation object + !! - allocates pointers + !! - initializes values + !< + subroutine tsp_obs_cr(obs, inobs) ! -- dummy - type(GwtObsType), pointer, intent(out) :: obs + type(TspObsType), pointer, intent(out) :: obs integer(I4B), pointer, intent(in) :: inobs -! ------------------------------------------------------------------------------ ! allocate (obs) call obs%allocate_scalars() @@ -52,22 +49,20 @@ subroutine gwt_obs_cr(obs, inobs) obs%inputFilename = '' obs%inUnitObs => inobs ! + ! -- Return return - end subroutine gwt_obs_cr + end subroutine tsp_obs_cr - subroutine gwt_obs_ar(this, ic, x, flowja) -! ****************************************************************************** -! gwt_obs_ar -- allocate and read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Allocate and read method for package + !! + !! Method to allocate and read static data for the package. + !< + subroutine tsp_obs_ar(this, ic, x, flowja) ! -- dummy - class(GwtObsType), intent(inout) :: this - type(GwtIcType), pointer, intent(in) :: ic + class(TspObsType), intent(inout) :: this + type(TspIcType), pointer, intent(in) :: ic real(DP), dimension(:), pointer, contiguous, intent(in) :: x real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja -! ------------------------------------------------------------------------------ ! ! Call ar method of parent class call this%obs_ar() @@ -75,25 +70,21 @@ subroutine gwt_obs_ar(this, ic, x, flowja) ! set pointers call this%set_pointers(ic, x, flowja) ! + ! -- Return return - end subroutine gwt_obs_ar + end subroutine tsp_obs_ar - subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis) -! ****************************************************************************** -! gwt_obs_df -- define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Define observation object + !< + subroutine tsp_obs_df(this, iout, pkgname, filtyp, dis) ! -- dummy - class(GwtObsType), intent(inout) :: this + class(TspObsType), intent(inout) :: this integer(I4B), intent(in) :: iout character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: filtyp class(DisBaseType), pointer :: dis ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! Call overridden method of parent class call this%ObsType%obs_df(iout, pkgname, filtyp, dis) @@ -107,25 +98,21 @@ subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis) ! ! -- Store obs type and assign procedure pointer for flow-ja-face observation type call this%StoreObsType('flow-ja-face', .true., indx) - this%obsData(indx)%ProcessIdPtr => gwt_process_intercell_obs_id + this%obsData(indx)%ProcessIdPtr => tsp_process_intercell_obs_id ! + ! -- Return return - end subroutine gwt_obs_df + end subroutine tsp_obs_df - subroutine gwt_obs_bd(this) -! ****************************************************************************** -! gwt_obs_bd -- save obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Save observations + !< + subroutine tsp_obs_bd(this) ! -- dummy - class(GwtObsType), intent(inout) :: this + class(TspObsType), intent(inout) :: this ! -- local integer(I4B) :: i, jaindex, nodenumber character(len=100) :: msg class(ObserveType), pointer :: obsrv => null() -! ------------------------------------------------------------------------------ ! call this%obs_bd_clear() ! @@ -148,72 +135,60 @@ subroutine gwt_obs_bd(this) end do end if ! + ! -- Return return - end subroutine gwt_obs_bd + end subroutine tsp_obs_bd - subroutine gwt_obs_rp(this) -! ****************************************************************************** -! gwt_obs_rp -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - class(GwtObsType), intent(inout) :: this -! ------------------------------------------------------------------------------ + !> @brief If transport model observations need checks, add them here + !< + subroutine tsp_obs_rp(this) + ! -- dummy + class(TspObsType), intent(inout) :: this ! ! Do GWT observations need any checking? If so, add checks here + ! + ! -- Return return - end subroutine gwt_obs_rp + end subroutine tsp_obs_rp - subroutine gwt_obs_da(this) -! ****************************************************************************** -! gwt_obs_da -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> Deallocate memory + !! + !! Deallocate memory associated with transport model + subroutine tsp_obs_da(this) ! -- dummy - class(GwtObsType), intent(inout) :: this -! ------------------------------------------------------------------------------ + class(TspObsType), intent(inout) :: this ! nullify (this%ic) nullify (this%x) nullify (this%flowja) call this%ObsType%obs_da() ! + ! -- Return return - end subroutine gwt_obs_da + end subroutine tsp_obs_da + !> @brief Set pointers needed by the transport OBS package + !< subroutine set_pointers(this, ic, x, flowja) -! ****************************************************************************** -! set_pointers -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy - class(GwtObsType), intent(inout) :: this - type(GwtIcType), pointer, intent(in) :: ic + class(TspObsType), intent(inout) :: this + type(TspIcType), pointer, intent(in) :: ic real(DP), dimension(:), pointer, contiguous, intent(in) :: x real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja -! ------------------------------------------------------------------------------ ! this%ic => ic this%x => x this%flowja => flowja ! + ! -- Return return end subroutine set_pointers - ! -- Procedures related to GWF observations (NOT type-bound) - + !> @brief Procedure related to Tsp observations (NOT type-bound) + !! + !! Process a specific observation ID + !< subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout) -! ****************************************************************************** -! gwt_process_concentration_obs_id -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -223,7 +198,6 @@ subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout) integer(I4B) :: nn1 integer(I4B) :: icol, istart, istop character(len=LINELENGTH) :: ermsg, strng -! ------------------------------------------------------------------------------ ! ! -- Initialize variables strng = obsrv%IDstring @@ -242,16 +216,15 @@ subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout) call store_error_unit(inunitobs) end if ! + ! -- Return return end subroutine gwt_process_concentration_obs_id - subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout) -! ****************************************************************************** -! gwt_process_intercell_obs_id -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Procedure related to Tsp observations (NOT type-bound) + !! + !! Process an intercell observation requested by the user + !< + subroutine tsp_process_intercell_obs_id(obsrv, dis, inunitobs, iout) ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -263,7 +236,6 @@ subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout) character(len=LINELENGTH) :: ermsg, strng ! formats 70 format('Error: No connection exists between cells identified in text: ', a) -! ------------------------------------------------------------------------------ ! ! -- Initialize variables strng = obsrv%IDstring @@ -304,7 +276,8 @@ subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout) call store_error_unit(inunitobs) end if ! + ! -- Return return - end subroutine gwt_process_intercell_obs_id + end subroutine tsp_process_intercell_obs_id -end module GwtObsModule +end module TspObsModule diff --git a/src/Model/GroundWaterTransport/gwt1oc1.f90 b/src/Model/TransportModel/tsp1oc1.f90 similarity index 68% rename from src/Model/GroundWaterTransport/gwt1oc1.f90 rename to src/Model/TransportModel/tsp1oc1.f90 index d186d713259..cdad8682249 100644 --- a/src/Model/GroundWaterTransport/gwt1oc1.f90 +++ b/src/Model/TransportModel/tsp1oc1.f90 @@ -1,4 +1,4 @@ -module GwtOcModule +module TspOcModule use BaseDisModule, only: DisBaseType use KindModule, only: DP, I4B @@ -8,29 +8,28 @@ module GwtOcModule implicit none private - public GwtOcType, oc_cr + public TspOcType, oc_cr - !> @ brief Output control for GWT + !> @ brief Output control !! - !! Concrete implementation of OutputControlType for the - !! GWT Model + !! Concrete implementation of OutputControlType for a + !! Transport Model !< - type, extends(OutputControlType) :: GwtOcType + type, extends(OutputControlType) :: TspOcType contains procedure :: oc_ar - end type GwtOcType + end type TspOcType contains - !> @ brief Create GwtOcType + !> @ brief Create TspOcType !! - !! Create by allocating a new GwtOcType object and initializing + !! Create by allocating a new TspOcType object and initializing !! member variables. - !! !< subroutine oc_cr(ocobj, name_model, inunit, iout) ! -- dummy - type(GwtOcType), pointer :: ocobj !< GwtOcType object + type(TspOcType), pointer :: ocobj !< TspOcType object character(len=*), intent(in) :: name_model !< name of the model integer(I4B), intent(in) :: inunit !< unit number for input integer(I4B), intent(in) :: iout !< unit number for output @@ -52,15 +51,17 @@ subroutine oc_cr(ocobj, name_model, inunit, iout) return end subroutine oc_cr - !> @ brief Allocate and read GwtOcType + !> @ brief Allocate and read TspOcType !! - !! Setup concentration and budget as output control variables. + !! Setup dependent variable (e.g., concentration or temperature) + !! and budget as output control variables. !! !< - subroutine oc_ar(this, conc, dis, dnodata) + subroutine oc_ar(this, depvar, dis, dnodata, dvname) ! -- dummy - class(GwtOcType) :: this !< GwtOcType object - real(DP), dimension(:), pointer, contiguous, intent(in) :: conc !< model concentration + class(TspOcType) :: this !< TspOcType object + real(DP), dimension(:), pointer, contiguous, intent(in) :: depvar !< model concentration + character(len=*), intent(in) :: dvname !< name of dependent variable solved by generalized transport model (concentration, temperature) class(DisBaseType), pointer, intent(in) :: dis !< model discretization package real(DP), intent(in) :: dnodata !< no data value ! -- local @@ -80,7 +81,7 @@ subroutine oc_ar(this, conc, dis, dnodata) 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', & this%iout, dnodata) case (2) - call ocdobjptr%init_dbl('CONCENTRATION', conc, dis, 'PRINT LAST ', & + call ocdobjptr%init_dbl(trim(dvname), depvar, dis, 'PRINT LAST ', & 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', & this%iout, dnodata) end select @@ -97,4 +98,4 @@ subroutine oc_ar(this, conc, dis, dnodata) return end subroutine oc_ar -end module GwtOcModule +end module TspOcModule diff --git a/src/Model/GroundWaterTransport/gwt1ssm1.f90 b/src/Model/TransportModel/tsp1ssm1.f90 similarity index 92% rename from src/Model/GroundWaterTransport/gwt1ssm1.f90 rename to src/Model/TransportModel/tsp1ssm1.f90 index e8684820918..ef1e806da4d 100644 --- a/src/Model/GroundWaterTransport/gwt1ssm1.f90 +++ b/src/Model/TransportModel/tsp1ssm1.f90 @@ -1,27 +1,27 @@ -!> @brief This module contains the GwtSsm Module +!> @brief This module contains the TspSsm Module !! !! This module contains the code for handling sources and sinks !! associated with groundwater flow model stress packages. !! !! todo: need observations for SSM terms !< -module GwtSsmModule +module TspSsmModule use KindModule, only: DP, I4B, LGP use ConstantsModule, only: DONE, DZERO, LENAUXNAME, LENFTYPE, & LENPACKAGENAME, LINELENGTH, & - TABLEFT, TABCENTER, LENBUDROWLABEL + TABLEFT, TABCENTER, LENBUDROWLABEL, LENVARNAME use SimModule, only: store_error, count_errors, store_error_unit use SimVariablesModule, only: errmsg use NumericalPackageModule, only: NumericalPackageType use BaseDisModule, only: DisBaseType - use GwtFmiModule, only: GwtFmiType + use TspFmiModule, only: TspFmiType use TableModule, only: TableType, table_cr use GwtSpcModule, only: GwtSpcType use MatrixBaseModule implicit none - public :: GwtSsmType + public :: TspSsmType public :: ssm_cr character(len=LENFTYPE) :: ftype = 'SSM' @@ -32,18 +32,19 @@ module GwtSsmModule !! This derived type corresponds to the SSM Package, which adds !! the effects of groundwater sources and sinks to the solute transport !! equation. - !! !< - type, extends(NumericalPackageType) :: GwtSsmType + type, extends(NumericalPackageType) :: TspSsmType integer(I4B), pointer :: nbound !< total number of flow boundaries in this time step integer(I4B), dimension(:), pointer, contiguous :: isrctype => null() !< source type 0 is unspecified, 1 is aux, 2 is auxmixed, 3 is ssmi, 4 is ssmimixed integer(I4B), dimension(:), pointer, contiguous :: iauxpak => null() !< aux col for concentration integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound real(DP), dimension(:), pointer, contiguous :: cnew => null() !< pointer to gwt%x - type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object + type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object type(TableType), pointer :: outputtab => null() !< output table object type(GwtSpcType), dimension(:), pointer :: ssmivec => null() !< array of stress package concentration objects + real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy + character(len=LENVARNAME) :: depvartype = '' contains @@ -68,7 +69,7 @@ module GwtSsmModule procedure, private :: set_ssmivec procedure, private :: get_ssm_conc - end type GwtSsmType + end type TspSsmType contains @@ -76,15 +77,17 @@ module GwtSsmModule !! !! Create a new SSM package by defining names, allocating scalars !! and initializing the parser. - !! !< - subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi) + subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi, eqnsclfac, & + depvartype) ! -- dummy - type(GwtSsmType), pointer :: ssmobj !< GwtSsmType object + type(TspSsmType), pointer :: ssmobj !< TspSsmType object character(len=*), intent(in) :: name_model !< name of the model integer(I4B), intent(in) :: inunit !< fortran unit for input integer(I4B), intent(in) :: iout !< fortran unit for output - type(GwtFmiType), intent(in), target :: fmi !< GWT FMI package + type(TspFmiType), intent(in), target :: fmi !< Transport FMI package + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor + character(len=LENVARNAME), intent(in) :: depvartype ! ! -- Create the object allocate (ssmobj) @@ -99,10 +102,15 @@ subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi) ssmobj%inunit = inunit ssmobj%iout = iout ssmobj%fmi => fmi + ssmobj%eqnsclfac => eqnsclfac ! ! -- Initialize block parser call ssmobj%parser%Initialize(ssmobj%inunit, ssmobj%iout) ! + ! -- Store pointer to labels associated with the current model so that the + ! package has access to the corresponding dependent variable type + ssmobj%depvartype = depvartype + ! ! -- Return return end subroutine ssm_cr @@ -112,13 +120,12 @@ end subroutine ssm_cr !! This routine is called from gwt_df(), but does not do anything because !! df is typically used to set up dimensions. For the ssm package, the !! total number of ssm entries is defined by the flow model. - !! !< subroutine ssm_df(this) ! -- modules use MemoryManagerModule, only: mem_setptr ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local ! -- formats ! @@ -130,13 +137,12 @@ end subroutine ssm_df !! !! This routine is called from gwt_ar(). It allocates arrays, reads !! options and data, and sets up the output table. - !! !< subroutine ssm_ar(this, dis, ibound, cnew) ! -- modules use MemoryManagerModule, only: mem_setptr ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object class(DisBaseType), pointer, intent(in) :: dis !< discretization package integer(I4B), dimension(:), pointer, contiguous :: ibound !< GWT model ibound real(DP), dimension(:), pointer, contiguous :: cnew !< GWT model dependent variable @@ -188,12 +194,11 @@ end subroutine ssm_ar !! each stress period. If any SPC input files are used to provide source !! and sink concentrations, then period blocks for the current stress period !! are read. - !! !< subroutine ssm_rp(this) ! -- modules ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local integer(I4B) :: ip type(GwtSpcType), pointer :: ssmiptr @@ -219,12 +224,11 @@ end subroutine ssm_rp !! in this%nbound. Also, if any SPC input files are used to provide source !! and sink concentrations and time series are referenced in those files, !! then ssm concenrations must be interpolated for the time step. - !! !< subroutine ssm_ad(this) ! -- modules ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local integer(I4B) :: ip type(GwtSpcType), pointer :: ssmiptr @@ -267,12 +271,11 @@ end subroutine ssm_ad !! and right-hand-side value for any package and package entry. It returns !! several different optional variables that are used throughout this !! package to update matrix terms, budget calculations, and output tables. - !! !< subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, & cssm, qssm) ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType + class(TspSsmType) :: this !< TspSsmType integer(I4B), intent(in) :: ipackage !< package number integer(I4B), intent(in) :: ientry !< bound number real(DP), intent(out), optional :: rrate !< calculated mass flow rate @@ -342,9 +345,9 @@ subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, & ! ! -- Add terms based on qbnd sign if (qbnd <= DZERO) then - hcoftmp = qbnd * omega + hcoftmp = qbnd * omega * this%eqnsclfac else - rhstmp = -qbnd * ctmp * (DONE - omega) + rhstmp = -qbnd * ctmp * (DONE - omega) * this%eqnsclfac end if ! ! -- end of active ibound @@ -357,23 +360,23 @@ subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, & if (present(cssm)) cssm = ctmp if (present(qssm)) qssm = qbnd ! - ! -- return + ! -- Return return end subroutine ssm_term - !> @ brief Provide bound concentration and mixed flag - !! - !! SSM concentrations can be provided in auxiliary variables or - !! through separate SPC files. If not provided, the default - !! concentration is zero. This single routine provides the SSM - !! bound concentration based on these different approaches. - !! The mixed flag indicates whether or not + !> @ brief Provide bound concentration (or temperature) and mixed flag !! + !! SSM concentrations and temperatures can be provided in auxiliary variables + !! or through separate SPC files. If not provided, the default + !! concentration (or temperature) is zero. This single routine provides + !! the SSM bound concentration (or temperature) based on these different + !! approaches. The mixed flag indicates whether or not the boundary as a + !! mixed type. !< subroutine get_ssm_conc(this, ipackage, ientry, nbound_flow, conc, & lauxmixed) ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType + class(TspSsmType) :: this !< TspSsmType integer(I4B), intent(in) :: ipackage !< package number integer(I4B), intent(in) :: ientry !< bound number integer(I4B), intent(in) :: nbound_flow !< size of flow package bound list @@ -396,7 +399,8 @@ subroutine get_ssm_conc(this, ipackage, ientry, nbound_flow, conc, & conc = this%ssmivec(ipackage)%get_value(ientry, nbound_flow) if (isrctype == 4) lauxmixed = .true. end select - + ! + ! -- Return return end subroutine get_ssm_conc @@ -404,12 +408,11 @@ end subroutine get_ssm_conc !! !! This routine adds the effects of the SSM to the matrix equations by !! updating the a matrix and right-hand side vector. - !! !< subroutine ssm_fc(this, matrix_sln, idxglo, rhs) ! -- modules ! -- dummy - class(GwtSsmType) :: this + class(TspSsmType) :: this class(MatrixBaseType), pointer :: matrix_sln integer(I4B), intent(in), dimension(:) :: idxglo real(DP), intent(inout), dimension(:) :: rhs @@ -451,12 +454,11 @@ end subroutine ssm_fc !! Calulate the resulting mass flow between the boundary and the connected !! GWT model cell. Update the diagonal position of the flowja array so that !! it ultimately contains the solute balance residual. - !! !< subroutine ssm_cq(this, flowja) ! -- modules ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow across each face in the model grid ! -- local integer(I4B) :: ip @@ -491,14 +493,13 @@ end subroutine ssm_cq !! !! Calculate the global SSM budget terms using separate in and out entries !! for each flow package. - !! !< subroutine ssm_bd(this, isuppress_output, model_budget) ! -- modules use TdisModule, only: delt use BudgetModule, only: BudgetType ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object integer(I4B), intent(in) :: isuppress_output !< flag to suppress output type(BudgetType), intent(inout) :: model_budget !< budget object for the GWT model ! -- local @@ -549,14 +550,13 @@ end subroutine ssm_bd !! Based on user-specified controls, print SSM mass flow rates to the GWT !! listing file and/or write the SSM mass flow rates to the GWT binary !! budget file. - !! !< subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun) ! -- modules use TdisModule, only: kstp, kper use ConstantsModule, only: LENPACKAGENAME, LENBOUNDNAME, LENAUXNAME, DZERO ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object integer(I4B), intent(in) :: icbcfl !< flag for writing binary budget terms integer(I4B), intent(in) :: ibudfl !< flag for printing budget terms to list file integer(I4B), intent(in) :: icbcun !< fortran unit number for binary budget file @@ -672,20 +672,19 @@ subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun) end if end if ! - ! -- return + ! -- Return return end subroutine ssm_ot_flow !> @ brief Deallocate !! !! Deallocate the memory associated with this derived type - !! !< subroutine ssm_da(this) ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local integer(I4B) :: ip type(GwtSpcType), pointer :: ssmiptr @@ -729,13 +728,12 @@ end subroutine ssm_da !> @ brief Allocate scalars !! !! Allocate scalar variables for this derived type - !! !< subroutine allocate_scalars(this) ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local ! ! -- allocate scalars in NumericalPackageType @@ -754,13 +752,12 @@ end subroutine allocate_scalars !> @ brief Allocate arrays !! !! Allocate array variables for this derived type - !! !< subroutine allocate_arrays(this) ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr ! -- dummy - class(GwtSsmType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local integer(I4B) :: nflowpack integer(I4B) :: i @@ -786,12 +783,11 @@ end subroutine allocate_arrays !> @ brief Read package options !! !! Read and set the SSM Package options - !! !< subroutine read_options(this) ! -- modules ! -- dummy - class(GwtSSMType) :: this !< GwtSsmType object + class(TspSsmType) :: this !< TspSsmType object ! -- local character(len=LINELENGTH) :: keyword integer(I4B) :: ierr @@ -838,17 +834,18 @@ end subroutine read_options !> @ brief Read package data !! !! Read and set the SSM Package data - !! !< subroutine read_data(this) ! -- dummy - class(GwtSsmtype) :: this !< GwtSsmtype object + class(TspSsmType) :: this !< TspSsmType object ! ! -- read and process required SOURCES block call this%read_sources_aux() ! ! -- read and process optional FILEINPUT block call this%read_sources_fileinput() + ! + ! -- Return return end subroutine read_data @@ -856,11 +853,10 @@ end subroutine read_data !! !! Read SOURCES block and look for auxiliary columns in !! corresponding flow data. - !! !< subroutine read_sources_aux(this) ! -- dummy - class(GwtSsmtype) :: this !< GwtSsmtype object + class(TspSsmType) :: this !< TspSsmType object ! -- local character(len=LINELENGTH) :: keyword character(len=20) :: srctype @@ -959,11 +955,10 @@ end subroutine read_sources_aux !! !! Read optional FILEINPUT block and initialize an !! SPC input file reader for each entry. - !! !< subroutine read_sources_fileinput(this) ! -- dummy - class(GwtSsmtype) :: this !< GwtSsmtype object + class(TspSsmType) :: this !< TspSsmType object ! -- local character(len=LINELENGTH) :: keyword character(len=LINELENGTH) :: keyword2 @@ -1080,11 +1075,10 @@ end subroutine read_sources_fileinput !! through the auxiliary names in package ip and sets iauxpak !! to the column number corresponding to the correct auxiliary !! column. - !! !< subroutine set_iauxpak(this, ip, packname) ! -- dummy - class(GwtSsmtype), intent(inout) :: this !< GwtSsmtype + class(TspSsmType), intent(inout) :: this !< TspSsmType integer(I4B), intent(in) :: ip !< package number character(len=*), intent(in) :: packname !< name of package ! -- local @@ -1114,7 +1108,7 @@ subroutine set_iauxpak(this, ip, packname) write (this%iout, '(4x, a, i0, a, a)') 'USING AUX COLUMN ', & iaux, ' IN PACKAGE ', trim(packname) ! - ! -- return + ! -- Return return end subroutine set_iauxpak @@ -1123,13 +1117,12 @@ end subroutine set_iauxpak !! The next call to parser will return the input file name for !! package ip in the SSM SOURCES block. The routine then !! initializes the SPC input file. - !! !< subroutine set_ssmivec(this, ip, packname) ! -- module use InputOutputModule, only: openfile, getunit ! -- dummy - class(GwtSsmtype), intent(inout) :: this !< GwtSsmtype + class(TspSsmType), intent(inout) :: this !< TspSsmType integer(I4B), intent(in) :: ip !< package number character(len=*), intent(in) :: packname !< name of package ! -- local @@ -1147,21 +1140,21 @@ subroutine set_ssmivec(this, ip, packname) call ssmiptr%initialize(this%dis, ip, inunit, this%iout, this%name_model, & trim(packname)) - write (this%iout, '(4x, a, a, a, a)') 'USING SPC INPUT FILE ', & - trim(filename), ' TO SET CONCENTRATIONS FOR PACKAGE ', trim(packname) + write (this%iout, '(4x, a, a, a, a, a)') 'USING SPC INPUT FILE ', & + trim(filename), ' TO SET ', trim(this%depvartype), & + 'S FOR PACKAGE ', trim(packname) ! - ! -- return + ! -- Return return end subroutine set_ssmivec !> @ brief Setup the output table !! !! Setup the output table by creating the column headers. - !! !< subroutine pak_setup_outputtab(this) ! -- dummy - class(GwtSsmtype), intent(inout) :: this + class(TspSsmType), intent(inout) :: this ! -- local character(len=LINELENGTH) :: title character(len=LINELENGTH) :: text @@ -1199,8 +1192,8 @@ subroutine pak_setup_outputtab(this) !end if end if ! - ! -- return + ! -- Return return end subroutine pak_setup_outputtab -end module GwtSsmModule +end module TspSsmModule diff --git a/src/RunControl.f90 b/src/RunControl.f90 index fd1b9b0611b..6872f119da0 100644 --- a/src/RunControl.f90 +++ b/src/RunControl.f90 @@ -22,6 +22,7 @@ module RunControlModule procedure :: finish => ctrl_finish ! private procedure, private :: init_handler + procedure, private :: after_con_cr_handler procedure, private :: before_con_df_handler procedure, private :: after_con_df_handler procedure, private :: destroy @@ -69,6 +70,8 @@ subroutine ctrl_at_stage(this, stage) if (stage == STG_BFR_MDL_DF) then call this%init_handler() + else if (stage == STG_AFT_CON_CR) then + call this%after_con_cr_handler() else if (stage == STG_BFR_CON_DF) then call this%before_con_df_handler() else if (stage == STG_AFT_CON_DF) then @@ -90,6 +93,15 @@ subroutine init_handler(this) end subroutine init_handler + !> @brief Actions after connections have been created + !< + subroutine after_con_cr_handler(this) + class(RunControlType), target :: this + + call this%virtual_data_mgr%set_halo() + + end subroutine after_con_cr_handler + !> @brief Actions before defining the connections !! !! Set up the virtual data manager: diff --git a/src/SimulationCreate.f90 b/src/SimulationCreate.f90 index 6407097b7b2..ce5c0fc1a19 100644 --- a/src/SimulationCreate.f90 +++ b/src/SimulationCreate.f90 @@ -8,7 +8,6 @@ module SimulationCreateModule use SimVariablesModule, only: iout, simulation_mode, proc_id, & nr_procs, model_names, model_ranks, & model_loc_idx - use GenericUtilitiesModule, only: sim_message, write_centered use SimModule, only: store_error, count_errors, & store_error_filename, MaxErrors use VersionModule, only: write_listfile_header @@ -341,11 +340,14 @@ subroutine exchanges_create() pointer :: emnames_a !< model a names type(CharacterStringType), dimension(:), contiguous, & pointer :: emnames_b !< model b names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: emempaths character(len=LINELENGTH) :: exgtype integer(I4B) :: exg_id integer(I4B) :: m1_id, m2_id character(len=LINELENGTH) :: fname, name1, name2 character(len=LENEXCHANGENAME) :: exg_name + character(len=LENMEMPATH) :: exg_mempath integer(I4B) :: n character(len=LINELENGTH) :: errmsg logical(LGP) :: terminate = .true. @@ -362,6 +364,7 @@ subroutine exchanges_create() call mem_setptr(efiles, 'EXGFILE', input_mempath) call mem_setptr(emnames_a, 'EXGMNAMEA', input_mempath) call mem_setptr(emnames_b, 'EXGMNAMEB', input_mempath) + call mem_setptr(emempaths, 'EXGMEMPATHS', input_mempath) ! ! -- open exchange logging block write (iout, '(/1x,a)') 'READING SIMULATION EXCHANGES' @@ -377,6 +380,7 @@ subroutine exchanges_create() fname = efiles(n) name1 = emnames_a(n) name2 = emnames_b(n) + exg_mempath = emempaths(n) exg_id = exg_id + 1 @@ -407,7 +411,8 @@ subroutine exchanges_create() case ('GWF6-GWF6') write (exg_name, '(a,i0)') 'GWF-GWF_', exg_id if (.not. both_remote) then - call gwfexchange_create(fname, exg_name, exg_id, m1_id, m2_id) + call gwfexchange_create(fname, exg_name, exg_id, m1_id, m2_id, & + exg_mempath) end if call add_virtual_gwf_exchange(exg_name, exg_id, m1_id, m2_id) case ('GWF6-GWT6') @@ -417,7 +422,8 @@ subroutine exchanges_create() case ('GWT6-GWT6') write (exg_name, '(a,i0)') 'GWT-GWT_', exg_id if (.not. both_remote) then - call gwtexchange_create(fname, exg_name, exg_id, m1_id, m2_id) + call gwtexchange_create(fname, exg_name, exg_id, m1_id, m2_id, & + exg_mempath) end if call add_virtual_gwt_exchange(exg_name, exg_id, m1_id, m2_id) case default @@ -521,7 +527,7 @@ subroutine solution_groups_create() call mem_setptr(slntype, 'SLNTYPE', input_mempath) call mem_setptr(slnfname, 'SLNFNAME', input_mempath) call mem_setptr(slnmnames, 'SLNMNAMES', input_mempath) - call mem_setptr(blocknum, 'SOLUTIONGROUPnum', input_mempath) + call mem_setptr(blocknum, 'SOLUTIONGROUPNUM', input_mempath) ! ! -- open solution group logging block write (iout, '(/1x,a)') 'READING SOLUTIONGROUP' diff --git a/src/Solution/ConvergenceSummary.f90 b/src/Solution/ConvergenceSummary.f90 new file mode 100644 index 00000000000..5e85ccc7aaf --- /dev/null +++ b/src/Solution/ConvergenceSummary.f90 @@ -0,0 +1,138 @@ +module ConvergenceSummaryModule + use KindModule, only: I4B, DP + use ConstantsModule, only: LENMEMPATH, DZERO + use MemoryManagerModule, only: mem_allocate, mem_deallocate, mem_reallocate + + implicit none + private + + public :: ConvergenceSummaryType + + !> This structure stores the generic convergence info for a solution + !< + type :: ConvergenceSummaryType + character(len=LENMEMPATH) :: memory_path !< the path for storing solution variables in the memory manager + integer(I4B) :: iter_cnt !< tracks the iteration number within the timestep + integer(I4B), pointer :: convnmod => null() !< number of models in the solution + integer(I4B), dimension(:), pointer :: model_bounds => null() !< the start and stop index of the models in the solution + integer(I4B), pointer :: nitermax => null() !< max. nr. of iterations in a timestep + integer(I4B), dimension(:), pointer, contiguous :: itinner => null() !< inner iteration number within each picard iteration + integer(I4B), dimension(:), pointer, contiguous :: locdv => null() !< location of the maximum dependent-variable change in the solution + real(DP), dimension(:), pointer, contiguous :: dvmax => null() !< maximum dependent-variable change in the solution + integer(I4B), dimension(:), pointer, contiguous :: locdr => null() !< location of the maximum flow change in the solution + real(DP), dimension(:), pointer, contiguous :: drmax => null() !< maximum flow change in the solution + integer(I4B), pointer, dimension(:, :), contiguous :: convlocdv => null() !< location of the maximum dependent-variable change in each model in the solution + real(DP), pointer, dimension(:, :), contiguous :: convdvmax => null() !< maximum dependent-variable change for each model in the solution + integer(I4B), pointer, dimension(:, :), contiguous :: convlocdr => null() !< location of the maximum flow change in each model in the solution + real(DP), pointer, dimension(:, :), contiguous :: convdrmax => null() !< maximum flow change in each model in the solution + contains + procedure :: init + procedure :: reinit + procedure :: destroy + ! private + procedure, private :: set_defaults + end type ConvergenceSummaryType + +contains + + !> @brief Initialize the convergence summary for a solution + subroutine init(this, nr_models, model_bounds, mem_path) + class(ConvergenceSummaryType) :: this + integer(I4B) :: nr_models !< the number of models in the solution + integer(I4B), dimension(:), pointer :: model_bounds !< the start and stop index of the models + character(len=*) :: mem_path !< the memory path of the owning solution + + this%memory_path = 'TMP'//mem_path + this%iter_cnt = 0 + this%model_bounds => model_bounds + + call mem_allocate(this%convnmod, 'CONVNMOD', this%memory_path) + call mem_allocate(this%nitermax, 'NITERMAX', this%memory_path) + this%convnmod = nr_models + this%nitermax = 0 + + call mem_allocate(this%itinner, 0, 'ITINNER', this%memory_path) + call mem_allocate(this%locdv, this%convnmod, 'LOCDV', this%memory_path) + call mem_allocate(this%dvmax, this%convnmod, 'DVMAX', this%memory_path) + call mem_allocate(this%locdr, this%convnmod, 'LOCDR', this%memory_path) + call mem_allocate(this%drmax, this%convnmod, 'DRMAX', this%memory_path) + call mem_allocate(this%convdvmax, this%convnmod, 0, 'CONVDVMAX', & + this%memory_path) + call mem_allocate(this%convlocdv, this%convnmod, 0, 'CONVLOCDV', & + this%memory_path) + call mem_allocate(this%convdrmax, this%convnmod, 0, 'CONVDRMAX', & + this%memory_path) + call mem_allocate(this%convlocdr, this%convnmod, 0, 'CONVLOCDR', & + this%memory_path) + + call this%set_defaults() + + end subroutine init + + subroutine reinit(this, niter_max) + class(ConvergenceSummaryType) :: this + integer(I4B) :: niter_max !< max. nr. of iterations in a timestep + + this%nitermax = niter_max + call mem_reallocate(this%itinner, niter_max, 'ITINNER', this%memory_path) + call mem_reallocate(this%convdvmax, this%convnmod, niter_max, 'CONVDVMAX', & + this%memory_path) + call mem_reallocate(this%convlocdv, this%convnmod, niter_max, 'CONVLOCDV', & + this%memory_path) + call mem_reallocate(this%convdrmax, this%convnmod, niter_max, 'CONVDRMAX', & + this%memory_path) + call mem_reallocate(this%convlocdr, this%convnmod, niter_max, 'CONVLOCDR', & + this%memory_path) + + call this%set_defaults() + + end subroutine reinit + + subroutine set_defaults(this) + class(ConvergenceSummaryType) :: this + ! local + integer(I4B) :: i, j + + do i = 1, this%convnmod + this%locdr(i) = 0 + this%dvmax(i) = DZERO + this%locdv(i) = 0 + this%drmax(i) = DZERO + end do + + do i = 1, this%nitermax + this%itinner(i) = 0 + do j = 1, this%convnmod + this%convdvmax(j, i) = DZERO + this%convlocdv(j, i) = 0 + this%convdrmax(j, i) = DZERO + this%convlocdr(j, i) = 0 + end do + end do + + end subroutine set_defaults + + !> @brief Cleanup + !< + subroutine destroy(this) + class(ConvergenceSummaryType) :: this + + ! scalars + call mem_deallocate(this%convnmod) + call mem_deallocate(this%nitermax) + + call mem_deallocate(this%locdr) + call mem_deallocate(this%drmax) + call mem_deallocate(this%locdv) + call mem_deallocate(this%dvmax) + + ! arrays + call mem_deallocate(this%itinner) + call mem_deallocate(this%convdvmax) + call mem_deallocate(this%convlocdv) + call mem_deallocate(this%convdrmax) + call mem_deallocate(this%convlocdr) + + end subroutine destroy + +end module ConvergenceSummaryModule diff --git a/src/Solution/ExplicitSolution.f90 b/src/Solution/ExplicitSolution.f90 index 8cd8fb7f24b..d40a2fe4046 100644 --- a/src/Solution/ExplicitSolution.f90 +++ b/src/Solution/ExplicitSolution.f90 @@ -1,11 +1,4 @@ -!> @brief Explicit Solution Module -!! -!! This module contains the Explicit Solution, which is a -!! class for solving explicit models. The explicit solution -!! scrolls through a list of explicit models and calls -!! methods in a prescribed sequence. -!! -!< +!> @brief Explicit model solution module ExplicitSolutionModule use KindModule, only: I4B, DP use TimerModule, only: code_timer @@ -22,19 +15,20 @@ module ExplicitSolutionModule use ListsModule, only: basesolutionlist use SimVariablesModule, only: iout, isim_mode use BlockParserModule, only: BlockParserType + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use InputOutputModule, only: getunit implicit none private - !> @brief Derived type for the Explicit Solution Type - !! - !! This derived type describes the solution for managing and - !! solving explicit models. - !! - !< public :: create_explicit_solution public :: ExplicitSolutionType + !> @brief Manages and solves explicit models. + !! + !! An explicit solution simply scrolls through a list of explicit + !! models and calls solution procedures in a prescribed sequence. + !< type, extends(BaseSolutionType) :: ExplicitSolutionType character(len=LENMEMPATH) :: memoryPath !< the path for storing solution variables in the memory manager type(ListType), pointer :: modellist !< list of models in solution @@ -71,10 +65,9 @@ module ExplicitSolutionModule !> @ brief Create a new solution !! - !! Create a new solution using the data in filename, assign this new - !! solution an id number and store the solution in the basesolutionlist. - !! Also open the filename for later reading. - !! + !! Create a new solution using the data in filename, assign this new + !! solution an id number and store the solution in the basesolutionlist. + !! Also open the filename for later reading. !< subroutine create_explicit_solution(exp_sol, filename, id) ! -- modules @@ -87,101 +80,77 @@ subroutine create_explicit_solution(exp_sol, filename, id) integer(I4B) :: inunit class(BaseSolutionType), pointer :: solbase => null() character(len=LENSOLUTIONNAME) :: solutionname - ! + ! -- Create a new solution and add it to the basesolutionlist container solbase => exp_sol write (solutionname, '(a, i0)') 'SLN_', id - exp_sol%name = solutionname exp_sol%memoryPath = create_mem_path(solutionname) allocate (exp_sol%modellist) !todo: do we need this? allocate (exp_sol%exchangelist) - ! call exp_sol%allocate_scalars() - ! call AddBaseSolutionToList(basesolutionlist, solbase) - ! exp_sol%id = id - ! + ! -- Open solution input file for reading later after problem size is known ! Check to see if the file is already opened, which can happen when ! running in single model mode inquire (file=filename, number=inunit) - if (inunit < 0) inunit = getunit() exp_sol%iu = inunit write (iout, '(/a,a/)') ' Creating explicit solution (EMS): ', exp_sol%name call openfile(exp_sol%iu, iout, filename, 'IMS') - ! + ! -- Initialize block parser call exp_sol%parser%Initialize(exp_sol%iu, iout) - ! - ! -- return - return end subroutine create_explicit_solution !> @ brief Allocate scalars - !! - !! Allocate scalars for a new solution. - !! !< subroutine allocate_scalars(this) - ! -- modules - use MemoryManagerModule, only: mem_allocate - ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance - ! + ! -- allocate scalars call mem_allocate(this%id, 'ID', this%memoryPath) call mem_allocate(this%iu, 'IU', this%memoryPath) call mem_allocate(this%ttsoln, 'TTSOLN', this%memoryPath) call mem_allocate(this%icnvg, 'ICNVG', this%memoryPath) - ! + ! -- initialize this%id = 0 this%iu = 0 this%ttsoln = DZERO this%icnvg = 0 - ! - ! -- return - return end subroutine allocate_scalars - !> @ brief Solution define + !> @ brief Define the solution !< subroutine sln_df(this) class(ExplicitSolutionType) :: this end subroutine - !> @ brief Solution allocate and read + !> @ brief Allocate and read !< subroutine sln_ar(this) - ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance - ! + ! -- close ems input file call this%parser%Clear() - ! - ! -- return - return end subroutine sln_ar - !> @ brief Solution calculate time step length + !> @ brief Calculate time step length !< subroutine sln_calculate_delt(this) class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance end subroutine sln_calculate_delt - !> @ brief Solution advance + !> @ brief Advance the solution !< subroutine sln_ad(this) - ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance - ! + ! -- reset convergence flag this%icnvg = 0 - - return end subroutine sln_ad !> @ brief Solution output @@ -194,33 +163,25 @@ subroutine sln_fp(this) class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance end subroutine sln_fp - !> @ brief Solution deallocate + !> @ brief Deallocate !< subroutine sln_da(this) - ! -- modules - use MemoryManagerModule, only: mem_deallocate - ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance - ! + ! -- lists call this%modellist%Clear() deallocate (this%modellist) - ! - ! + ! -- Scalars call mem_deallocate(this%id) call mem_deallocate(this%iu) call mem_deallocate(this%ttsoln) call mem_deallocate(this%icnvg) - ! - ! -- return - return end subroutine sln_da - !> @ brief Solution calculate + !> @ brief Calculate !< subroutine sln_ca(this, isgcnvg, isuppress_output) - ! -- modules ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance integer(I4B), intent(inout) :: isgcnvg !< solution group convergence flag @@ -250,13 +211,9 @@ subroutine sln_ca(this, isgcnvg, isuppress_output) ! finish up call this%finalizeSolve(isgcnvg, isuppress_output) end select - ! - ! -- return - return - end subroutine sln_ca - !> @ brief Solution prepare to solve + !> @ brief Prepare to solve !< subroutine prepareSolve(this) ! -- dummy variables @@ -273,10 +230,9 @@ subroutine prepareSolve(this) ! advance solution call this%sln_ad() - end subroutine prepareSolve - !> @ brief Solution solve each model + !> @ brief Solve each model !< subroutine solve(this) ! -- dummy variables @@ -285,20 +241,17 @@ subroutine solve(this) class(ExplicitModelType), pointer :: mp => null() integer(I4B) :: im real(DP) :: ttsoln - ! - ! -- particle solve + call code_timer(0, ttsoln, this%ttsoln) do im = 1, this%modellist%Count() mp => GetExplicitModelFromList(this%modellist, im) call mp%model_solve() end do call code_timer(1, ttsoln, this%ttsoln) - ! this%icnvg = 1 - end subroutine solve - !> @ brief Solution finalize solve + !> @ brief Finalize solve !< subroutine finalizeSolve(this, isgcnvg, isuppress_output) ! -- dummy variables @@ -308,42 +261,36 @@ subroutine finalizeSolve(this, isgcnvg, isuppress_output) ! -- local variables integer(I4B) :: im class(ExplicitModelType), pointer :: mp => null() - ! + ! -- Calculate flow for each model do im = 1, this%modellist%Count() mp => GetExplicitModelFromList(this%modellist, im) call mp%model_cq(this%icnvg, isuppress_output) end do - ! + ! -- Budget terms for each model do im = 1, this%modellist%Count() mp => GetExplicitModelFromList(this%modellist, im) call mp%model_bd(this%icnvg, isuppress_output) end do - ! end subroutine finalizeSolve - !> @ brief Solution save + !> @ brief Save output !< subroutine save(this, filename) - ! -- modules - use InputOutputModule, only: getunit ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance character(len=*), intent(in) :: filename !< filename to save solution data ! -- local variables integer(I4B) :: inunit - ! + inunit = getunit() open (unit=inunit, file=filename, status='unknown') write (inunit, *) 'The save routine currently writes nothing' close (inunit) - ! - ! -- return - return end subroutine save - !> @ brief Solution explicit model to list + !> @ brief Add explicit model to list !< subroutine add_model(this, mp) ! -- dummy variables @@ -351,41 +298,32 @@ subroutine add_model(this, mp) class(BaseModelType), pointer, intent(in) :: mp !< model instance ! -- local variables class(ExplicitModelType), pointer :: m => null() - ! + ! -- add a model select type (mp) class is (ExplicitModelType) m => mp call AddExplicitModelToList(this%modellist, m) end select - ! - ! -- return - return end subroutine add_model - !> @brief Get a list of models - !! - !! Returns a pointer to the list of models in this solution. - !! + !> @brief Get a pointer to a list of models in the solution !< function get_models(this) result(models) - ! -- return variable type(ListType), pointer :: models !< pointer to the model list - ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance models => this%modellist - end function get_models - !> @ brief Solution add exchange to list of exchanges + !> @ brief Add exchange to list of exchanges !< subroutine add_exchange(this, exchange) class(ExplicitSolutionType) :: this class(BaseExchangeType), pointer, intent(in) :: exchange end subroutine add_exchange - !> @ brief Solution get list of exchanges + !> @ brief Get list of exchanges !< function get_exchanges(this) result(exchanges) class(ExplicitSolutionType) :: this diff --git a/src/Solution/LinearMethods/ImsLinearSettings.f90 b/src/Solution/LinearMethods/ImsLinearSettings.f90 new file mode 100644 index 00000000000..675076ab941 --- /dev/null +++ b/src/Solution/LinearMethods/ImsLinearSettings.f90 @@ -0,0 +1,273 @@ +module ImsLinearSettingsModule + use KindModule + use ConstantsModule + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use BlockParserModule, only: BlockParserType + use SimModule, only: store_error, deprecation_warning + implicit none + private + + integer(I4B), public, parameter :: CG_METHOD = 1 + integer(I4B), public, parameter :: BCGS_METHOD = 2 + + type, public :: ImsLinearSettingsType + character(len=LENMEMPATH) :: memory_path + real(DP), pointer :: dvclose => null() !< dependent variable closure criterion + real(DP), pointer :: rclose => null() !< residual closure criterion + integer(I4B), pointer :: icnvgopt => null() !< convergence option + integer(I4B), pointer :: iter1 => null() !< max. iterations + integer(I4B), pointer :: ilinmeth => null() !< linear solver method + integer(I4B), pointer :: iscl => null() !< scaling method + integer(I4B), pointer :: iord => null() !< reordering method + integer(I4B), pointer :: north => null() !< number of orthogonalizations + real(DP), pointer :: relax => null() !< relaxation factor + integer(I4B), pointer :: level => null() !< nr. of preconditioner levels + real(DP), pointer :: droptol => null() !< drop tolerance for preconditioner + integer(I4B), pointer :: ifdparam => null() !< complexity option + contains + procedure :: init + procedure :: preset_config + procedure :: read_from_file + procedure :: destroy + end type + +contains + + subroutine init(this, mem_path) + use MemoryHelperModule, only: create_mem_path + class(ImsLinearSettingsType) :: this !< linear settings + character(len=LENMEMPATH) :: mem_path !< solution memory path + + this%memory_path = create_mem_path(mem_path, 'IMSLINEAR') + + call mem_allocate(this%dvclose, 'DVCLOSE', this%memory_path) + call mem_allocate(this%rclose, 'RCLOSE', this%memory_path) + call mem_allocate(this%icnvgopt, 'ICNVGOPT', this%memory_path) + call mem_allocate(this%iter1, 'ITER1', this%memory_path) + call mem_allocate(this%ilinmeth, 'ILINMETH', this%memory_path) + call mem_allocate(this%iscl, 'ISCL', this%memory_path) + call mem_allocate(this%iord, 'IORD', this%memory_path) + call mem_allocate(this%north, 'NORTH', this%memory_path) + call mem_allocate(this%relax, 'RELAX', this%memory_path) + call mem_allocate(this%level, 'LEVEL', this%memory_path) + call mem_allocate(this%droptol, 'DROPTOL', this%memory_path) + call mem_allocate(this%ifdparam, 'IDFPARAM', this%memory_path) + + ! defaults + this%dvclose = DZERO + this%rclose = DZERO + this%icnvgopt = 0 + this%iter1 = 0 + this%ilinmeth = 0 + this%iscl = 0 + this%iord = 0 + this%north = 0 + this%relax = DZERO + this%level = 0 + this%droptol = DZERO + this%ifdparam = 0 + + end subroutine init + + !> @brief Set solver pre-configured settings based on complexity option + !< + subroutine preset_config(this, idfparam) + class(ImsLinearSettingsType) :: this !< linear settings + integer(I4B) :: idfparam !< complexity option + + this%ifdparam = idfparam + + select case (idfparam) + case (1) ! Simple option + this%iter1 = 50 + this%ilinmeth = 1 + this%iscl = 0 + this%iord = 0 + this%dvclose = DEM3 + this%rclose = DEM1 + this%relax = DZERO + this%level = 0 + this%droptol = DZERO + this%north = 0 + case (2) ! Moderate + this%iter1 = 100 + this%ilinmeth = 2 + this%iscl = 0 + this%iord = 0 + this%dvclose = DEM2 + this%rclose = DEM1 + this%relax = 0.97D0 + this%level = 0 + this%droptol = DZERO + this%north = 0 + case (3) ! Complex + this%iter1 = 500 + this%ilinmeth = 2 + this%iscl = 0 + this%iord = 0 + this%dvclose = DEM1 + this%rclose = DEM1 + this%relax = DZERO + this%level = 5 + this%droptol = DEM4 + this%north = 2 + end select + + end subroutine preset_config + + !> @brief Read the settings for the linear solver from the .ims file, + !< overriding a possible pre-set configuration with set_complexity + subroutine read_from_file(this, parser, iout) + class(ImsLinearSettingsType) :: this !< linear settings + type(BlockParserType) :: parser !< block parser + integer(I4B) :: iout !< listing file + ! local + logical(LGP) :: block_found, end_of_block + integer(I4B) :: ierr + character(len=LINELENGTH) :: errmsg + character(len=LINELENGTH) :: warnmsg + character(len=LINELENGTH) :: keyword + integer(I4B) :: iscaling, iordering + + call parser%GetBlock('LINEAR', block_found, ierr, supportOpenClose=.true., & + blockRequired=.FALSE.) + + if (block_found) then + write (iout, '(/1x,a)') 'PROCESSING LINEAR DATA' + do + call parser%GetNextLine(end_of_block) + if (end_of_block) exit + call parser%GetStringCaps(keyword) + ! -- parse keyword + select case (keyword) + case ('INNER_DVCLOSE') + this%dvclose = parser%GetDouble() + case ('INNER_RCLOSE') + this%rclose = parser%GetDouble() + ! -- look for additional key words + call parser%GetStringCaps(keyword) + if (keyword == 'STRICT') then + this%icnvgopt = 1 + else if (keyword == 'L2NORM_RCLOSE') then + this%icnvgopt = 2 + else if (keyword == 'RELATIVE_RCLOSE') then + this%icnvgopt = 3 + else if (keyword == 'L2NORM_RELATIVE_RCLOSE') then + this%icnvgopt = 4 + end if + case ('INNER_MAXIMUM') + this%iter1 = parser%GetInteger() + case ('LINEAR_ACCELERATION') + call parser%GetStringCaps(keyword) + if (keyword .eq. 'CG') then + this%ilinmeth = 1 + else if (keyword .eq. 'BICGSTAB') then + this%ilinmeth = 2 + else + this%ilinmeth = 0 + write (errmsg, '(3a)') & + 'Unknown IMSLINEAR LINEAR_ACCELERATION method (', & + trim(keyword), ').' + call store_error(errmsg) + end if + case ('SCALING_METHOD') + call parser%GetStringCaps(keyword) + iscaling = 0 + if (keyword .eq. 'NONE') then + iscaling = 0 + else if (keyword .eq. 'DIAGONAL') then + iscaling = 1 + else if (keyword .eq. 'L2NORM') then + iscaling = 2 + else + write (errmsg, '(3a)') & + 'Unknown IMSLINEAR SCALING_METHOD (', trim(keyword), ').' + call store_error(errmsg) + end if + this%iscl = iscaling + case ('RED_BLACK_ORDERING') + iordering = 0 + case ('REORDERING_METHOD') + call parser%GetStringCaps(keyword) + iordering = 0 + if (keyword == 'NONE') then + iordering = 0 + else if (keyword == 'RCM') then + iordering = 1 + else if (keyword == 'MD') then + iordering = 2 + else + write (errmsg, '(3a)') & + 'Unknown IMSLINEAR REORDERING_METHOD (', trim(keyword), ').' + call store_error(errmsg) + end if + this%iord = iordering + case ('NUMBER_ORTHOGONALIZATIONS') + this%north = parser%GetInteger() + case ('RELAXATION_FACTOR') + this%relax = parser%GetDouble() + case ('PRECONDITIONER_LEVELS') + this%level = parser%GetInteger() + if (this%level < 0) then + write (errmsg, '(a,1x,a)') & + 'IMSLINEAR PRECONDITIONER_LEVELS must be greater than', & + 'or equal to zero' + call store_error(errmsg) + end if + case ('PRECONDITIONER_DROP_TOLERANCE') + this%droptol = parser%GetDouble() + if (this%droptol < DZERO) then + write (errmsg, '(a,1x,a)') & + 'IMSLINEAR PRECONDITIONER_DROP_TOLERANCE', & + 'must be greater than or equal to zero' + call store_error(errmsg) + end if + ! + ! -- deprecated variables + case ('INNER_HCLOSE') + this%dvclose = parser%GetDouble() + ! + ! -- create warning message + write (warnmsg, '(a)') & + 'SETTING INNER_DVCLOSE TO INNER_HCLOSE VALUE' + ! + ! -- create deprecation warning + call deprecation_warning('LINEAR', 'INNER_HCLOSE', '6.1.1', & + warnmsg, parser%GetUnit()) + ! + ! -- default + case default + write (errmsg, '(3a)') & + 'Unknown IMSLINEAR keyword (', trim(keyword), ').' + call store_error(errmsg) + end select + end do + write (iout, '(1x,a)') 'END OF LINEAR DATA' + else + if (this%ifdparam == 0) THEN + write (errmsg, '(a)') 'NO LINEAR block detected.' + call store_error(errmsg) + end if + end if + + end subroutine read_from_file + + subroutine destroy(this) + class(ImsLinearSettingsType) :: this !< linear settings + + call mem_deallocate(this%dvclose) + call mem_deallocate(this%rclose) + call mem_deallocate(this%icnvgopt) + call mem_deallocate(this%iter1) + call mem_deallocate(this%ilinmeth) + call mem_deallocate(this%iscl) + call mem_deallocate(this%iord) + call mem_deallocate(this%north) + call mem_deallocate(this%relax) + call mem_deallocate(this%level) + call mem_deallocate(this%droptol) + call mem_deallocate(this%ifdparam) + + end subroutine destroy + +end module diff --git a/src/Solution/LinearMethods/ImsLinearSolver.f90 b/src/Solution/LinearMethods/ImsLinearSolver.f90 index de63b9c8a38..b69a055abbd 100644 --- a/src/Solution/LinearMethods/ImsLinearSolver.f90 +++ b/src/Solution/LinearMethods/ImsLinearSolver.f90 @@ -4,6 +4,9 @@ module ImsLinearSolverModule use MatrixBaseModule use VectorBaseModule use SparseMatrixModule + use ImsLinearSettingsModule + use ConvergenceSummaryModule + implicit none private @@ -12,6 +15,7 @@ module ImsLinearSolverModule type, public, extends(LinearSolverBaseType) :: ImsLinearSolverType contains procedure :: initialize => ims_initialize + procedure :: print_summary => ims_print_summary procedure :: solve => ims_solve procedure :: get_result => ims_get_result procedure :: destroy => ims_destroy @@ -31,16 +35,23 @@ function create_ims_solver() result(solver) end function create_ims_solver - subroutine ims_initialize(this, matrix) + subroutine ims_initialize(this, matrix, linear_settings, convergence_summary) class(ImsLinearSolverType) :: this class(MatrixBaseType), pointer :: matrix + type(ImsLinearSettingsType), pointer :: linear_settings + type(ConvergenceSummaryType), pointer :: convergence_summary end subroutine ims_initialize - subroutine ims_solve(this, kiter, rhs, x) + subroutine ims_print_summary(this) + class(ImsLinearSolverType) :: this + end subroutine ims_print_summary + + subroutine ims_solve(this, kiter, rhs, x, cnvg_summary) class(ImsLinearSolverType) :: this integer(I4B) :: kiter class(VectorBaseType), pointer :: rhs class(VectorBaseType), pointer :: x + type(ConvergenceSummaryType) :: cnvg_summary end subroutine ims_solve subroutine ims_get_result(this) diff --git a/src/Solution/LinearMethods/ims8base.f90 b/src/Solution/LinearMethods/ims8base.f90 index 7e927e6d0b7..4c82d9f87af 100644 --- a/src/Solution/LinearMethods/ims8base.f90 +++ b/src/Solution/LinearMethods/ims8base.f90 @@ -9,9 +9,10 @@ MODULE IMSLinearBaseModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, IZERO, & DZERO, DPREC, DEM6, DEM3, DHALF, DONE - use GenericUtilitiesModule, only: sim_message, is_same + use MathUtilModule, only: is_close use BlockParserModule, only: BlockParserType use IMSReorderingModule, only: ims_odrv + use ConvergenceSummaryModule IMPLICIT NONE @@ -28,14 +29,13 @@ MODULE IMSLinearBaseModule !< SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & NEQ, NJA, NIAPC, NJAPC, & - IPC, NITERC, ICNVGOPT, NORTH, & + IPC, ICNVGOPT, NORTH, & DVCLOSE, RCLOSE, L2NORM0, EPFACT, & IA0, JA0, A0, IAPC, JAPC, APC, & X, B, D, P, Q, Z, & NJLU, IW, JLU, & - NCONV, CONVNMOD, CONVMODSTART, LOCDV, LOCDR, & - CACCEL, ITINNER, CONVLOCDV, CONVLOCDR, & - DVMAX, DRMAX, CONVDVMAX, CONVDRMAX) + NCONV, CONVNMOD, CONVMODSTART, & + CACCEL, summary) ! -- dummy variables integer(I4B), INTENT(INOUT) :: ICNVG !< convergence flag (1) non-convergence (0) integer(I4B), INTENT(IN) :: ITMAX !< maximum number of inner iterations @@ -45,7 +45,6 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & integer(I4B), INTENT(IN) :: NIAPC !< preconditioner number of rows integer(I4B), INTENT(IN) :: NJAPC !< preconditioner number of non-zero entries integer(I4B), INTENT(IN) :: IPC !< preconditioner option - integer(I4B), INTENT(INOUT) :: NITERC !< total number of inner iterations integer(I4B), INTENT(IN) :: ICNVGOPT !< flow convergence criteria option integer(I4B), INTENT(IN) :: NORTH !< orthogonalization frequency real(DP), INTENT(IN) :: DVCLOSE !< dependent-variable closure criteria @@ -72,16 +71,8 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & integer(I4B), INTENT(IN) :: NCONV !< maximum number of inner iterations in a time step (maxiter * maxinner) integer(I4B), INTENT(IN) :: CONVNMOD !< number of models in the solution integer(I4B), DIMENSION(CONVNMOD + 1), INTENT(INOUT) :: CONVMODSTART !< pointer to the start of each model in the convmod* arrays - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDV !< location of the maximum dependent-variable change in the solution - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDR !< location of the maximum flow change in the solution character(len=31), DIMENSION(NCONV), INTENT(INOUT) :: CACCEL !< convergence string - integer(I4B), DIMENSION(NCONV), INTENT(INOUT) :: ITINNER !< actual number of inner iterations in each Picard iteration - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDV !< location of the maximum dependent-variable change in each model in the solution - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDR !< location of the maximum flow change in each model in the solution - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DVMAX !< maximum dependent-variable change in the solution - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DRMAX !< maximum flow change in the solution - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDVMAX !< maximum dependent-variable change in each model in the solution - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDRMAX !< maximum flow change in each model in the solution + type(ConvergenceSummaryType), pointer, intent(in) :: summary !< Convergence summary report ! -- local variables LOGICAL :: lorth logical :: lsame @@ -108,7 +99,7 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & ! -- INNER ITERATION INNER: DO iiter = 1, itmax INNERIT = INNERIT + 1 - NITERC = NITERC + 1 + summary%iter_cnt = summary%iter_cnt + 1 ! ! -- APPLY PRECONDITIONER SELECT CASE (IPC) @@ -148,8 +139,8 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & rmax = DZERO l2norm = DZERO DO im = 1, CONVNMOD - DVMAX(im) = DZERO - DRMAX(im) = DZERO + summary%dvmax(im) = DZERO + summary%drmax(im) = DZERO END DO im = 1 im0 = CONVMODSTART(1) @@ -170,9 +161,9 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & deltax = tv xloc = n END IF - IF (ABS(tv) > ABS(DVMAX(im))) THEN - DVMAX(im) = tv - LOCDV(im) = n + IF (ABS(tv) > ABS(summary%dvmax(im))) THEN + summary%dvmax(im) = tv + summary%locdv(im) = n END IF tv = D(n) tv = tv - alpha * Q(n) @@ -181,9 +172,9 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & rmax = tv rloc = n END IF - IF (ABS(tv) > ABS(DRMAX(im))) THEN - DRMAX(im) = tv - LOCDR(im) = n + IF (ABS(tv) > ABS(summary%drmax(im))) THEN + summary%drmax(im) = tv + summary%locdr(im) = n END IF l2norm = l2norm + tv * tv END DO @@ -191,15 +182,15 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & ! ! -- SAVE SOLVER convergence information dummy variables IF (NCONV > 1) THEN !< - n = NITERC + n = summary%iter_cnt WRITE (cval, '(g15.7)') alpha CACCEL(n) = cval - ITINNER(n) = iiter + summary%itinner(n) = iiter DO im = 1, CONVNMOD - CONVLOCDV(im, n) = LOCDV(im) - CONVLOCDR(im, n) = LOCDR(im) - CONVDVMAX(im, n) = DVMAX(im) - CONVDRMAX(im, n) = DRMAX(im) + summary%convlocdv(im, n) = summary%locdv(im) + summary%convlocdr(im, n) = summary%locdr(im) + summary%convdvmax(im, n) = summary%dvmax(im) + summary%convdrmax(im, n) = summary%drmax(im) END DO END IF ! @@ -220,7 +211,7 @@ SUBROUTINE ims_base_cg(ICNVG, ITMAX, INNERIT, & IF (ICNVG .NE. 0) EXIT INNER ! ! -- CHECK THAT CURRENT AND PREVIOUS rho ARE DIFFERENT - lsame = is_same(rho, rho0) + lsame = is_close(rho, rho0) IF (lsame) THEN EXIT INNER END IF @@ -258,15 +249,14 @@ END SUBROUTINE ims_base_cg !< SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & NEQ, NJA, NIAPC, NJAPC, & - IPC, NITERC, ICNVGOPT, NORTH, ISCL, DSCALE, & + IPC, ICNVGOPT, NORTH, ISCL, DSCALE, & DVCLOSE, RCLOSE, L2NORM0, EPFACT, & IA0, JA0, A0, IAPC, JAPC, APC, & X, B, D, P, Q, & T, V, DHAT, PHAT, QHAT, & NJLU, IW, JLU, & - NCONV, CONVNMOD, CONVMODSTART, LOCDV, LOCDR, & - CACCEL, ITINNER, CONVLOCDV, CONVLOCDR, & - DVMAX, DRMAX, CONVDVMAX, CONVDRMAX) + NCONV, CONVNMOD, CONVMODSTART, & + CACCEL, summary) ! -- dummy variables integer(I4B), INTENT(INOUT) :: ICNVG !< convergence flag (1) non-convergence (0) integer(I4B), INTENT(IN) :: ITMAX !< maximum number of inner iterations @@ -276,7 +266,6 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & integer(I4B), INTENT(IN) :: NIAPC !< preconditioner number of rows integer(I4B), INTENT(IN) :: NJAPC !< preconditioner number of non-zero entries integer(I4B), INTENT(IN) :: IPC !< preconditioner option - integer(I4B), INTENT(INOUT) :: NITERC !< total number of inner iterations integer(I4B), INTENT(IN) :: ICNVGOPT !< flow convergence criteria option integer(I4B), INTENT(IN) :: NORTH !< orthogonalization frequency integer(I4B), INTENT(IN) :: ISCL !< scaling option @@ -309,16 +298,8 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & integer(I4B), INTENT(IN) :: NCONV !< maximum number of inner iterations in a time step (maxiter * maxinner) integer(I4B), INTENT(IN) :: CONVNMOD !< number of models in the solution integer(I4B), DIMENSION(CONVNMOD + 1), INTENT(INOUT) :: CONVMODSTART !< pointer to the start of each model in the convmod* arrays - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDV !< location of the maximum dependent-variable change in the solution - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDR !< location of the maximum flow change in the solution character(len=31), DIMENSION(NCONV), INTENT(INOUT) :: CACCEL !< convergence string - integer(I4B), DIMENSION(NCONV), INTENT(INOUT) :: ITINNER !< actual number of inner iterations in each Picard iteration - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDV !< location of the maximum dependent-variable change in each model in the solution - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDR !< location of the maximum flow change in each model in the solution - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DVMAX !< maximum dependent-variable change in the solution - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DRMAX !< maximum flow change in the solution - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDVMAX !< maximum dependent-variable change in each model in the solution - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDRMAX !< maximum flow change in each model in the solution + type(ConvergenceSummaryType), pointer, intent(in) :: summary !< Convergence summary report ! -- local variables LOGICAL :: LORTH logical :: lsame @@ -357,7 +338,7 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & ! -- INNER ITERATION INNER: DO iiter = 1, itmax INNERIT = INNERIT + 1 - NITERC = NITERC + 1 + summary%iter_cnt = summary%iter_cnt + 1 ! ! -- CALCULATE rho rho = ddot(NEQ, DHAT, 1, D, 1) @@ -451,8 +432,8 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & rmax = DZERO l2norm = DZERO DO im = 1, CONVNMOD - DVMAX(im) = DZERO - DRMAX(im) = DZERO + summary%dvmax(im) = DZERO + summary%drmax(im) = DZERO END DO im = 1 im0 = CONVMODSTART(1) @@ -476,9 +457,9 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & deltax = tv xloc = n END IF - IF (ABS(tv) > ABS(DVMAX(im))) THEN - DVMAX(im) = tv - LOCDV(im) = n + IF (ABS(tv) > ABS(summary%dvmax(im))) THEN + summary%dvmax(im) = tv + summary%locdv(im) = n END IF ! ! -- RESIDUAL @@ -491,9 +472,9 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & rmax = tv rloc = n END IF - IF (ABS(tv) > ABS(DRMAX(im))) THEN - DRMAX(im) = tv - LOCDR(im) = n + IF (ABS(tv) > ABS(summary%drmax(im))) THEN + summary%drmax(im) = tv + summary%locdr(im) = n END IF l2norm = l2norm + tv * tv END DO @@ -501,16 +482,16 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & ! ! -- SAVE SOLVER convergence information dummy variables IF (NCONV > 1) THEN !< - n = NITERC + n = summary%iter_cnt WRITE (cval1, '(g15.7)') alpha WRITE (cval2, '(g15.7)') omega CACCEL(n) = trim(adjustl(cval1))//','//trim(adjustl(cval2)) - ITINNER(n) = iiter + summary%itinner(n) = iiter DO im = 1, CONVNMOD - CONVLOCDV(im, n) = LOCDV(im) - CONVLOCDR(im, n) = LOCDR(im) - CONVDVMAX(im, n) = DVMAX(im) - CONVDRMAX(im, n) = DRMAX(im) + summary%convdvmax(im, n) = summary%dvmax(im) + summary%convlocdv(im, n) = summary%locdv(im) + summary%convdrmax(im, n) = summary%drmax(im) + summary%convlocdr(im, n) = summary%locdr(im) END DO END IF ! @@ -532,15 +513,15 @@ SUBROUTINE ims_base_bcgs(ICNVG, ITMAX, INNERIT, & ! ! -- CHECK THAT CURRENT AND PREVIOUS rho, alpha, AND omega ARE ! DIFFERENT - lsame = is_same(rho, rho0) + lsame = is_close(rho, rho0) IF (lsame) THEN EXIT INNER END IF - lsame = is_same(alpha, alpha0) + lsame = is_close(alpha, alpha0) IF (lsame) THEN EXIT INNER END IF - lsame = is_same(omega, omega0) + lsame = is_close(omega, omega0) IF (lsame) THEN EXIT INNER END IF diff --git a/src/Solution/LinearMethods/ims8linear.f90 b/src/Solution/LinearMethods/ims8linear.f90 index ecb7c2f16d7..4838ff1cd88 100644 --- a/src/Solution/LinearMethods/ims8linear.f90 +++ b/src/Solution/LinearMethods/ims8linear.f90 @@ -6,13 +6,14 @@ MODULE IMSLinearModule DEM8, DEM6, DEM5, DEM4, DEM3, DEM2, DEM1, & DHALF, DONE, DTWO, & VDEBUG - use GenericUtilitiesModule, only: sim_message use IMSLinearBaseModule, only: ims_base_cg, ims_base_bcgs, & ims_base_pccrs, ims_base_calc_order, & ims_base_scale, ims_base_pcu, & ims_base_residual use BlockParserModule, only: BlockParserType use MatrixBaseModule + use ConvergenceSummaryModule + use ImsLinearSettingsModule IMPLICIT NONE private @@ -21,26 +22,28 @@ MODULE IMSLinearModule character(len=LENMEMPATH) :: memoryPath !< the path for storing variables in the memory manager integer(I4B), POINTER :: iout => NULL() !< simulation listing file unit integer(I4B), POINTER :: IPRIMS => NULL() !< print flag - integer(I4B), POINTER :: ILINMETH => NULL() !< linear accelerator (1) cg, (2) bicgstab - integer(I4B), POINTER :: ITER1 => NULL() !< maximum inner iterations + ! input variables (pointing to fields in input structure) + real(DP), pointer :: DVCLOSE => null() !< dependent variable closure criterion + real(DP), pointer :: RCLOSE => null() !< residual closure criterion + integer(I4B), pointer :: ICNVGOPT => null() !< convergence option + integer(I4B), pointer :: ITER1 => null() !< max. iterations + integer(I4B), pointer :: ILINMETH => null() !< linear solver method + integer(I4B), pointer :: iSCL => null() !< scaling method + integer(I4B), pointer :: IORD => null() !< reordering method + integer(I4B), pointer :: NORTH => null() !< number of orthogonalizations + real(DP), pointer :: RELAX => null() !< relaxation factor + integer(I4B), pointer :: LEVEL => null() !< nr. of preconditioner levels + real(DP), pointer :: DROPTOL => null() !< drop tolerance for preconditioner + ! integer(I4B), POINTER :: IPC => NULL() !< preconditioner flag - integer(I4B), POINTER :: ISCL => NULL() !< scaling flag - integer(I4B), POINTER :: IORD => NULL() !< reordering flag - integer(I4B), POINTER :: NORTH => NULL() !< orthogonalization interval - integer(I4B), POINTER :: ICNVGOPT => NULL() !< rclose convergence option flag integer(I4B), POINTER :: IACPC => NULL() !< preconditioner CRS row pointers integer(I4B), POINTER :: NITERC => NULL() !< integer(I4B), POINTER :: NIABCGS => NULL() !< size of working vectors for BCGS linear accelerator integer(I4B), POINTER :: NIAPC => NULL() !< preconditioner number of rows integer(I4B), POINTER :: NJAPC => NULL() !< preconditioner number of non-zero entries - real(DP), POINTER :: DVCLOSE => NULL() !< dependent variable convergence criteria - real(DP), POINTER :: RCLOSE => NULL() !< flow convergence criteria - real(DP), POINTER :: RELAX => NULL() !< preconditioner MILU0/MILUT relaxation factor real(DP), POINTER :: EPFACT => NULL() !< factor for decreasing convergence criteria in seubsequent Picard iterations real(DP), POINTER :: L2NORM0 => NULL() !< initial L2 norm ! -- ilut variables - integer(I4B), POINTER :: LEVEL => NULL() !< preconditioner number of levels - real(DP), POINTER :: DROPTOL => NULL() !< preconditioner drop tolerance integer(I4B), POINTER :: NJLU => NULL() !< length of jlu work vector integer(I4B), POINTER :: NJW => NULL() !< length of jw work vector integer(I4B), POINTER :: NWLU => NULL() !< length of wlu work vector @@ -104,8 +107,8 @@ MODULE IMSLinearModule !! Allocate storage for linear accelerators and read data !! !< - SUBROUTINE imslinear_ar(this, NAME, parser, IOUT, IPRIMS, MXITER, IFDPARAM, & - IMSLINEARM, NEQ, matrix, RHS, X, NINNER, LFINDBLOCK) + SUBROUTINE imslinear_ar(this, NAME, IOUT, IPRIMS, MXITER, & + NEQ, matrix, RHS, X, linear_settings) ! -- modules use MemoryManagerModule, only: mem_allocate use MemoryHelperModule, only: create_mem_path @@ -114,49 +117,40 @@ SUBROUTINE imslinear_ar(this, NAME, parser, IOUT, IPRIMS, MXITER, IFDPARAM, & ! -- dummy variables CLASS(ImsLinearDataType), INTENT(INOUT) :: this !< ImsLinearDataType instance CHARACTER(LEN=LENSOLUTIONNAME), INTENT(IN) :: NAME !< solution name - type(BlockParserType) :: parser !< block parser integer(I4B), INTENT(IN) :: IOUT !< simulation listing file unit integer(I4B), TARGET, INTENT(IN) :: IPRIMS !< print option integer(I4B), INTENT(IN) :: MXITER !< maximum outer iterations - integer(I4B), INTENT(IN) :: IFDPARAM !< complexity option - integer(I4B), INTENT(INOUT) :: IMSLINEARM !< linear method option (1) CG (2) BICGSTAB integer(I4B), TARGET, INTENT(IN) :: NEQ !< number of equations class(MatrixBaseType), pointer :: matrix real(DP), DIMENSION(NEQ), TARGET, INTENT(INOUT) :: RHS !< right-hand side real(DP), DIMENSION(NEQ), TARGET, INTENT(INOUT) :: X !< dependent variables - integer(I4B), TARGET, INTENT(INOUT) :: NINNER !< maximum number of inner iterations - integer(I4B), INTENT(IN), OPTIONAL :: LFINDBLOCK !< flag indicating if the linear block is present (1) or missing (0) - + type(ImsLinearSettingsType), pointer :: linear_settings !< the settings form the IMS file ! -- local variables - LOGICAL :: lreaddata character(len=LINELENGTH) :: errmsg - character(len=LINELENGTH) :: warnmsg - character(len=LINELENGTH) :: keyword integer(I4B) :: i, n integer(I4B) :: i0 integer(I4B) :: iscllen, iolen - integer(I4B) :: ierr - real(DP) :: r - logical :: isfound, endOfBlock integer(I4B) :: ijlu integer(I4B) :: ijw integer(I4B) :: iwlu integer(I4B) :: iwk ! - ! -- SET LREADDATA - IF (PRESENT(LFINDBLOCK)) THEN - IF (LFINDBLOCK < 1) THEN - lreaddata = .FALSE. - ELSE - lreaddata = .TRUE. - END IF - ELSE - lreaddata = .TRUE. - END IF - ! ! -- DEFINE NAME this%memoryPath = create_mem_path(name, 'IMSLINEAR') ! + ! -- SET pointers to IMS settings + this%DVCLOSE => linear_settings%dvclose + this%RCLOSE => linear_settings%rclose + this%ICNVGOPT => linear_settings%icnvgopt + this%ITER1 => linear_settings%iter1 + this%ILINMETH => linear_settings%ilinmeth + this%iSCL => linear_settings%iscl + this%IORD => linear_settings%iord + this%NORTH => linear_settings%north + this%RELAX => linear_settings%relax + this%LEVEL => linear_settings%level + this%DROPTOL => linear_settings%droptol + ! ! -- SET POINTERS TO SOLUTION STORAGE this%IPRIMS => IPRIMS this%NEQ => NEQ @@ -173,165 +167,15 @@ SUBROUTINE imslinear_ar(this, NAME, parser, IOUT, IPRIMS, MXITER, IFDPARAM, & this%iout = iout ! ! -- DEFAULT VALUES - this%IORD = 0 - this%ISCL = 0 this%IPC = 0 - this%LEVEL = 0 ! - ! -- TRANSFER COMMON VARIABLES FROM IMS TO IMSLINEAR - this%ILINMETH = 0 - this%IACPC = 0 - this%RELAX = DZERO !0.97 - - this%DROPTOL = DZERO - - this%NORTH = 0 - - this%ICNVGOPT = 0 ! ! -- PRINT A MESSAGE IDENTIFYING IMSLINEAR SOLVER PACKAGE write (iout, 2000) 02000 FORMAT(1X, /1X, 'IMSLINEAR -- UNSTRUCTURED LINEAR SOLUTION', & ' PACKAGE, VERSION 8, 04/28/2017') ! - ! -- SET DEFAULT IMSLINEAR PARAMETERS - CALL this%SET_IMSLINEAR_INPUT(IFDPARAM) - NINNER = this%iter1 - ! - ! -- get IMSLINEAR block - if (lreaddata) then - call parser%GetBlock('LINEAR', isfound, ierr, & - supportOpenClose=.true., blockRequired=.FALSE.) - else - isfound = .FALSE. - end if - ! - ! -- parse IMSLINEAR block if detected - if (isfound) then - write (iout, '(/1x,a)') 'PROCESSING LINEAR DATA' - do - call parser%GetNextLine(endOfBlock) - if (endOfBlock) exit - call parser%GetStringCaps(keyword) - ! -- parse keyword - select case (keyword) - case ('INNER_DVCLOSE') - this%DVCLOSE = parser%GetDouble() - case ('INNER_RCLOSE') - this%rclose = parser%GetDouble() - ! -- look for additional key words - call parser%GetStringCaps(keyword) - if (keyword == 'STRICT') then - this%ICNVGOPT = 1 - else if (keyword == 'L2NORM_RCLOSE') then - this%ICNVGOPT = 2 - else if (keyword == 'RELATIVE_RCLOSE') then - this%ICNVGOPT = 3 - else if (keyword == 'L2NORM_RELATIVE_RCLOSE') then - this%ICNVGOPT = 4 - end if - case ('INNER_MAXIMUM') - i = parser%GetInteger() - this%iter1 = i - NINNER = i - case ('LINEAR_ACCELERATION') - call parser%GetStringCaps(keyword) - if (keyword .eq. 'CG') then - this%ILINMETH = 1 - else if (keyword .eq. 'BICGSTAB') then - this%ILINMETH = 2 - else - this%ILINMETH = 0 - write (errmsg, '(3a)') & - 'Unknown IMSLINEAR LINEAR_ACCELERATION method (', & - trim(keyword), ').' - call store_error(errmsg) - end if - case ('SCALING_METHOD') - call parser%GetStringCaps(keyword) - i = 0 - if (keyword .eq. 'NONE') then - i = 0 - else if (keyword .eq. 'DIAGONAL') then - i = 1 - else if (keyword .eq. 'L2NORM') then - i = 2 - else - write (errmsg, '(3a)') & - 'Unknown IMSLINEAR SCALING_METHOD (', trim(keyword), ').' - call store_error(errmsg) - end if - this%ISCL = i - case ('RED_BLACK_ORDERING') - i = 0 - case ('REORDERING_METHOD') - call parser%GetStringCaps(keyword) - i = 0 - if (keyword == 'NONE') then - i = 0 - else if (keyword == 'RCM') then - i = 1 - else if (keyword == 'MD') then - i = 2 - else - write (errmsg, '(3a)') & - 'Unknown IMSLINEAR REORDERING_METHOD (', trim(keyword), ').' - call store_error(errmsg) - end if - this%IORD = i - case ('NUMBER_ORTHOGONALIZATIONS') - this%north = parser%GetInteger() - case ('RELAXATION_FACTOR') - this%relax = parser%GetDouble() - case ('PRECONDITIONER_LEVELS') - i = parser%GetInteger() - this%level = i - if (i < 0) then - write (errmsg, '(a,1x,a)') & - 'IMSLINEAR PRECONDITIONER_LEVELS must be greater than', & - 'or equal to zero' - call store_error(errmsg) - end if - case ('PRECONDITIONER_DROP_TOLERANCE') - r = parser%GetDouble() - this%DROPTOL = r - if (r < DZERO) then - write (errmsg, '(a,1x,a)') & - 'IMSLINEAR PRECONDITIONER_DROP_TOLERANCE', & - 'must be greater than or equal to zero' - call store_error(errmsg) - end if - ! - ! -- deprecated variables - case ('INNER_HCLOSE') - this%DVCLOSE = parser%GetDouble() - ! - ! -- create warning message - write (warnmsg, '(a)') & - 'SETTING INNER_DVCLOSE TO INNER_HCLOSE VALUE' - ! - ! -- create deprecation warning - call deprecation_warning('LINEAR', 'INNER_HCLOSE', '6.1.1', & - warnmsg, parser%GetUnit()) - ! - ! -- default - case default - write (errmsg, '(3a)') & - 'Unknown IMSLINEAR keyword (', trim(keyword), ').' - call store_error(errmsg) - end select - end do - write (iout, '(1x,a)') 'END OF LINEAR DATA' - else - if (IFDPARAM == 0) THEN - write (errmsg, '(a)') 'NO LINEAR block detected.' - call store_error(errmsg) - end if - end if - - IMSLINEARM = this%ILINMETH - ! ! -- DETERMINE PRECONDITIONER IF (this%LEVEL > 0 .OR. this%DROPTOL > DZERO) THEN this%IPC = 3 @@ -372,11 +216,6 @@ SUBROUTINE imslinear_ar(this, NAME, parser, IOUT, IPRIMS, MXITER, IFDPARAM, & call store_error(errmsg) END IF ! - ! -- CHECK FOR ERRORS IN IMSLINEAR - if (count_errors() > 0) then - call parser%StoreErrorUnit() - end if - ! ! -- INITIALIZE IMSLINEAR VARIABLES this%NITERC = 0 ! @@ -658,50 +497,28 @@ subroutine allocate_scalars(this) ! ! -- allocate scalars call mem_allocate(this%iout, 'IOUT', this%memoryPath) - call mem_allocate(this%ilinmeth, 'ILINMETH', this%memoryPath) - call mem_allocate(this%iter1, 'ITER1', this%memoryPath) call mem_allocate(this%ipc, 'IPC', this%memoryPath) - call mem_allocate(this%iscl, 'ISCL', this%memoryPath) - call mem_allocate(this%iord, 'IORD', this%memoryPath) - call mem_allocate(this%north, 'NORTH', this%memoryPath) - call mem_allocate(this%icnvgopt, 'ICNVGOPT', this%memoryPath) call mem_allocate(this%iacpc, 'IACPC', this%memoryPath) call mem_allocate(this%niterc, 'NITERC', this%memoryPath) call mem_allocate(this%niabcgs, 'NIABCGS', this%memoryPath) call mem_allocate(this%niapc, 'NIAPC', this%memoryPath) call mem_allocate(this%njapc, 'NJAPC', this%memoryPath) - call mem_allocate(this%dvclose, 'DVCLOSE', this%memoryPath) - call mem_allocate(this%rclose, 'RCLOSE', this%memoryPath) - call mem_allocate(this%relax, 'RELAX', this%memoryPath) call mem_allocate(this%epfact, 'EPFACT', this%memoryPath) call mem_allocate(this%l2norm0, 'L2NORM0', this%memoryPath) - call mem_allocate(this%droptol, 'DROPTOL', this%memoryPath) - call mem_allocate(this%level, 'LEVEL', this%memoryPath) call mem_allocate(this%njlu, 'NJLU', this%memoryPath) call mem_allocate(this%njw, 'NJW', this%memoryPath) call mem_allocate(this%nwlu, 'NWLU', this%memoryPath) ! ! -- initialize scalars this%iout = 0 - this%ilinmeth = 0 - this%iter1 = 0 this%ipc = 0 - this%iscl = 0 - this%iord = 0 - this%north = 0 - this%icnvgopt = 0 this%iacpc = 0 this%niterc = 0 this%niabcgs = 0 this%niapc = 0 this%njapc = 0 - this%dvclose = DZERO - this%rclose = DZERO - this%relax = DZERO this%epfact = DZERO this%l2norm0 = 0 - this%droptol = DZERO - this%level = 0 this%njlu = 0 this%njw = 0 this%nwlu = 0 @@ -750,25 +567,14 @@ subroutine imslinear_da(this) ! ! -- scalars call mem_deallocate(this%iout) - call mem_deallocate(this%ilinmeth) - call mem_deallocate(this%iter1) call mem_deallocate(this%ipc) - call mem_deallocate(this%iscl) - call mem_deallocate(this%iord) - call mem_deallocate(this%north) - call mem_deallocate(this%icnvgopt) call mem_deallocate(this%iacpc) call mem_deallocate(this%niterc) call mem_deallocate(this%niabcgs) call mem_deallocate(this%niapc) call mem_deallocate(this%njapc) - call mem_deallocate(this%dvclose) - call mem_deallocate(this%rclose) - call mem_deallocate(this%relax) call mem_deallocate(this%epfact) call mem_deallocate(this%l2norm0) - call mem_deallocate(this%droptol) - call mem_deallocate(this%level) call mem_deallocate(this%njlu) call mem_deallocate(this%njw) call mem_deallocate(this%nwlu) @@ -855,9 +661,8 @@ END SUBROUTINE imslinear_set_input !! !< SUBROUTINE imslinear_ap(this, ICNVG, KSTP, KITER, IN_ITER, & - NCONV, CONVNMOD, CONVMODSTART, LOCDV, LOCDR, & - CACCEL, ITINNER, CONVLOCDV, CONVLOCDR, & - DVMAX, DRMAX, CONVDVMAX, CONVDRMAX) + NCONV, CONVNMOD, CONVMODSTART, & + CACCEL, summary) ! -- modules USE SimModule ! -- dummy variables @@ -870,16 +675,8 @@ SUBROUTINE imslinear_ap(this, ICNVG, KSTP, KITER, IN_ITER, & integer(I4B), INTENT(IN) :: NCONV !< integer(I4B), INTENT(IN) :: CONVNMOD !< integer(I4B), DIMENSION(CONVNMOD + 1), INTENT(INOUT) :: CONVMODSTART !< - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDV !< - integer(I4B), DIMENSION(CONVNMOD), INTENT(INOUT) :: LOCDR !< character(len=31), DIMENSION(NCONV), INTENT(INOUT) :: CACCEL !< - integer(I4B), DIMENSION(NCONV), INTENT(INOUT) :: ITINNER !< - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDV !< - integer(I4B), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVLOCDR !< - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DVMAX !< - real(DP), DIMENSION(CONVNMOD), INTENT(INOUT) :: DRMAX !< - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDVMAX !< - real(DP), DIMENSION(CONVNMOD, NCONV), INTENT(INOUT) :: CONVDRMAX !< + type(ConvergenceSummaryType), pointer, intent(in) :: summary !< Convergence summary report ! -- local variables integer(I4B) :: n integer(I4B) :: innerit @@ -932,7 +729,10 @@ SUBROUTINE imslinear_ap(this, ICNVG, KSTP, KITER, IN_ITER, & this%NWLU, this%JLU, this%JW, this%WLU) ! ! -- INITIALIZE SOLUTION VARIABLE AND ARRAYS - IF (KITER == 1) this%NITERC = 0 + IF (KITER == 1) then + this%NITERC = 0 + summary%iter_cnt = 0 + end if irc = 1 ICNVG = 0 DO n = 1, this%NEQ @@ -958,21 +758,20 @@ SUBROUTINE imslinear_ap(this, ICNVG, KSTP, KITER, IN_ITER, & IF (this%ILINMETH == 1) THEN CALL ims_base_cg(ICNVG, itmax, innerit, & this%NEQ, this%NJA, this%NIAPC, this%NJAPC, & - this%IPC, this%NITERC, this%ICNVGOPT, this%NORTH, & + this%IPC, this%ICNVGOPT, this%NORTH, & this%DVCLOSE, this%RCLOSE, this%L2NORM0, & this%EPFACT, this%IA0, this%JA0, this%A0, & this%IAPC, this%JAPC, this%APC, & this%X, this%RHS, this%D, this%P, this%Q, this%Z, & this%NJLU, this%IW, this%JLU, & - NCONV, CONVNMOD, CONVMODSTART, LOCDV, LOCDR, & - CACCEL, ITINNER, CONVLOCDV, CONVLOCDR, & - DVMAX, DRMAX, CONVDVMAX, CONVDRMAX) + NCONV, CONVNMOD, CONVMODSTART, & + CACCEL, summary) ! ! -- SOLUTION BY THE BICONJUGATE GRADIENT STABILIZED METHOD ELSE IF (this%ILINMETH == 2) THEN CALL ims_base_bcgs(ICNVG, itmax, innerit, & this%NEQ, this%NJA, this%NIAPC, this%NJAPC, & - this%IPC, this%NITERC, this%ICNVGOPT, this%NORTH, & + this%IPC, this%ICNVGOPT, this%NORTH, & this%ISCL, this%DSCALE, & this%DVCLOSE, this%RCLOSE, this%L2NORM0, & this%EPFACT, this%IA0, this%JA0, this%A0, & @@ -980,9 +779,8 @@ SUBROUTINE imslinear_ap(this, ICNVG, KSTP, KITER, IN_ITER, & this%X, this%RHS, this%D, this%P, this%Q, & this%T, this%V, this%DHAT, this%PHAT, this%QHAT, & this%NJLU, this%IW, this%JLU, & - NCONV, CONVNMOD, CONVMODSTART, LOCDV, LOCDR, & - CACCEL, ITINNER, CONVLOCDV, CONVLOCDR, & - DVMAX, DRMAX, CONVDVMAX, CONVDRMAX) + NCONV, CONVNMOD, CONVMODSTART, & + CACCEL, summary) END IF ! ! -- BACK PERMUTE AMAT, SOLUTION, AND RHS diff --git a/src/Solution/LinearSolverBase.f90 b/src/Solution/LinearSolverBase.f90 index 3bb8566d9c3..afa5eef722c 100644 --- a/src/Solution/LinearSolverBase.f90 +++ b/src/Solution/LinearSolverBase.f90 @@ -2,6 +2,9 @@ module LinearSolverBaseModule use KindModule, only: I4B, DP use MatrixBaseModule use VectorBaseModule + use ImsLinearSettingsModule + use ConvergenceSummaryModule + implicit none private @@ -16,6 +19,7 @@ module LinearSolverBaseModule integer(I4B) :: is_converged contains procedure(initialize_if), deferred :: initialize + procedure(print_summary_if), deferred :: print_summary procedure(solve_if), deferred :: solve procedure(get_result_if), deferred :: get_result procedure(destroy_if), deferred :: destroy @@ -24,17 +28,25 @@ module LinearSolverBaseModule end type LinearSolverBaseType abstract interface - subroutine initialize_if(this, matrix) - import LinearSolverBaseType, MatrixBaseType + subroutine initialize_if(this, matrix, linear_settings, convergence_summary) + import LinearSolverBaseType, MatrixBaseType, & + ImsLinearSettingsType, ConvergenceSummaryType class(LinearSolverBaseType) :: this class(MatrixBaseType), pointer :: matrix + type(ImsLinearSettingsType), pointer :: linear_settings + type(ConvergenceSummaryType), pointer :: convergence_summary + end subroutine + subroutine print_summary_if(this) + import LinearSolverBaseType + class(LinearSolverBaseType) :: this end subroutine - subroutine solve_if(this, kiter, rhs, x) - import LinearSolverBaseType, I4B, VectorBaseType + subroutine solve_if(this, kiter, rhs, x, cnvg_summary) + import LinearSolverBaseType, I4B, VectorBaseType, ConvergenceSummaryType class(LinearSolverBaseType) :: this integer(I4B) :: kiter class(VectorBaseType), pointer :: rhs class(VectorBaseType), pointer :: x + type(ConvergenceSummaryType) :: cnvg_summary end subroutine subroutine get_result_if(this) import LinearSolverBaseType diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index 1641c57b48e..41bc43e576b 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -2,6 +2,7 @@ module NumericalSolutionModule use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop use TimerModule, only: code_timer use ConstantsModule, only: LINELENGTH, LENSOLUTIONNAME, LENPAKLOC, & DPREC, DZERO, DEM20, DEM15, DEM6, & @@ -12,14 +13,15 @@ module NumericalSolutionModule LENMEMPATH use MemoryHelperModule, only: create_mem_path use TableModule, only: TableType, table_cr - use GenericUtilitiesModule, only: is_same, sim_message, stop_with_error + Use MessageModule, only: write_message + use MathUtilModule, only: is_close use VersionModule, only: IDEVELOPMODE use BaseModelModule, only: BaseModelType use BaseExchangeModule, only: BaseExchangeType use BaseSolutionModule, only: BaseSolutionType, AddBaseSolutionToList use ListModule, only: ListType use ListsModule, only: basesolutionlist - use InputOutputModule, only: getunit + use InputOutputModule, only: getunit, append_processor_id use NumericalModelModule, only: NumericalModelType, & AddNumericalModelToList, & GetNumericalModelFromList @@ -27,26 +29,32 @@ module NumericalSolutionModule AddNumericalExchangeToList, & GetNumericalExchangeFromList use SparseModule, only: sparsematrix - use SimVariablesModule, only: iout, isim_mode + use SimVariablesModule, only: iout, isim_mode, errmsg, & + proc_id, nr_procs, simulation_mode use SimStagesModule use BlockParserModule, only: BlockParserType use IMSLinearModule use MatrixBaseModule use VectorBaseModule use LinearSolverBaseModule + use ImsLinearSettingsModule use LinearSolverFactory, only: create_linear_solver - use SparseMatrixModule use MatrixBaseModule + use ConvergenceSummaryModule implicit none private public :: NumericalSolutionType public :: GetNumericalSolutionFromList + public :: CastAsNumericalSolutionClass public :: create_numerical_solution + integer(I4B), parameter :: IMS_SOLVER = 1 + integer(I4B), parameter :: PETSC_SOLVER = 2 + type, extends(BaseSolutionType) :: NumericalSolutionType - character(len=LENMEMPATH) :: memoryPath !< the path for storing solution variables in the memory manager + character(len=LENMEMPATH) :: memory_path !< the path for storing solution variables in the memory manager character(len=LINELENGTH) :: fname !< input file name character(len=16) :: solver_mode !< the type of solve: sequential, parallel, mayve block, etc. type(ListType), pointer :: modellist !< list of models in solution @@ -58,10 +66,10 @@ module NumericalSolutionModule integer(I4B), pointer :: isymmetric => null() !< flag indicating if matrix symmetry is required integer(I4B), pointer :: neq => null() !< number of equations integer(I4B), pointer :: matrix_offset => null() !< offset of linear system when part of distributed solution - class(LinearSolverBaseType), pointer :: linear_solver !< the linear solver for this solution - class(MatrixBaseType), pointer :: system_matrix !< sparse A-matrix for the system of equations - class(VectorBaseType), pointer :: vec_rhs !< the right-hand side vector - class(VectorBaseType), pointer :: vec_x !< the dependent-variable vector + class(LinearSolverBaseType), pointer :: linear_solver => null() !< the linear solver for this solution + class(MatrixBaseType), pointer :: system_matrix => null() !< sparse A-matrix for the system of equations + class(VectorBaseType), pointer :: vec_rhs => null() !< the right-hand side vector + class(VectorBaseType), pointer :: vec_x => null() !< the dependent-variable vector real(DP), dimension(:), pointer, contiguous :: rhs => null() !< right-hand side vector values real(DP), dimension(:), pointer, contiguous :: x => null() !< dependent-variable vector values integer(I4B), dimension(:), pointer, contiguous :: active => null() !< active cell array @@ -87,7 +95,7 @@ module NumericalSolutionModule integer(I4B), pointer :: iouttot_timestep => null() !< total nr. of outer iterations per call to sln_ca integer(I4B), pointer :: itertot_sim => null() !< total nr. of inner iterations for simulation integer(I4B), pointer :: mxiter => null() !< maximum number of Picard iterations - integer(I4B), pointer :: linmeth => null() !< linear acceleration method used + integer(I4B), pointer :: linsolver => null() !< linear solver used (IMS, PETSC, ...) integer(I4B), pointer :: nonmeth => null() !< under-relaxation method used integer(I4B), pointer :: numtrack => null() !< maximum number of backtracks integer(I4B), pointer :: iprims => null() !< solver print option @@ -106,15 +114,10 @@ module NumericalSolutionModule integer(I4B), pointer :: nitermax => null() !< maximum number of iterations in a time step (maxiter * maxinner) integer(I4B), pointer :: convnmod => null() !< number of models in the solution integer(I4B), dimension(:), pointer, contiguous :: convmodstart => null() !< pointer to the start of each model in the convmod* arrays - integer(I4B), dimension(:), pointer, contiguous :: locdv => null() !< location of the maximum dependent-variable change in the solution - integer(I4B), dimension(:), pointer, contiguous :: locdr => null() !< location of the maximum flow change in the solution - integer(I4B), dimension(:), pointer, contiguous :: itinner => null() !< actual number of inner iterations in each Picard iteration - integer(I4B), pointer, dimension(:, :), contiguous :: convlocdv => null() !< location of the maximum dependent-variable change in each model in the solution - integer(I4B), pointer, dimension(:, :), contiguous :: convlocdr => null() !< location of the maximum flow change in each model in the solution - real(DP), dimension(:), pointer, contiguous :: dvmax => null() !< maximum dependent-variable change in the solution - real(DP), dimension(:), pointer, contiguous :: drmax => null() !< maximum flow change in the solution - real(DP), pointer, dimension(:, :), contiguous :: convdvmax => null() !< maximum dependent-variable change in each model in the solution - real(DP), pointer, dimension(:, :), contiguous :: convdrmax => null() !< maximum flow change in each model in the solution + ! + ! -- refactoring + type(ConvergenceSummaryType), pointer :: cnvg_summary => null() !< details on the convergence behavior within a timestep + type(ImsLinearSettingsType), pointer :: linear_settings => null() !< IMS settings for linear solver ! ! -- pseudo-transient continuation integer(I4B), pointer :: iallowptc => null() !< flag indicating if ptc applied this time step @@ -159,8 +162,12 @@ module NumericalSolutionModule ! 'protected' (this can be overridden) procedure :: sln_has_converged + procedure :: sln_package_convergence + procedure :: sln_sync_newtonur_flag + procedure :: sln_nur_has_converged procedure :: sln_calc_ptc procedure :: sln_underrelax + procedure :: sln_backtracking_xupdate ! private procedure, private :: sln_connect @@ -168,7 +175,6 @@ module NumericalSolutionModule procedure, private :: sln_ls procedure, private :: sln_setouter procedure, private :: sln_backtracking - procedure, private :: sln_backtracking_xupdate procedure, private :: sln_maxval procedure, private :: sln_calcdx procedure, private :: sln_calc_residual @@ -222,20 +228,16 @@ subroutine create_numerical_solution(num_sol, filename, id) integer(I4B) :: inunit class(BaseSolutionType), pointer :: solbase => null() character(len=LENSOLUTIONNAME) :: solutionname - class(SparseMatrixType), pointer :: matrix_impl ! ! -- Create a new solution and add it to the basesolutionlist container solbase => num_sol write (solutionname, '(a, i0)') 'SLN_', id ! num_sol%name = solutionname - num_sol%memoryPath = create_mem_path(solutionname) + num_sol%memory_path = create_mem_path(solutionname) allocate (num_sol%modellist) allocate (num_sol%exchangelist) ! - allocate (matrix_impl) - num_sol%system_matrix => matrix_impl - ! call num_sol%allocate_scalars() ! call AddBaseSolutionToList(basesolutionlist, solbase) @@ -271,48 +273,48 @@ subroutine allocate_scalars(this) class(NumericalSolutionType) :: this ! ! -- allocate scalars - call mem_allocate(this%id, 'ID', this%memoryPath) - call mem_allocate(this%iu, 'IU', this%memoryPath) - call mem_allocate(this%ttform, 'TTFORM', this%memoryPath) - call mem_allocate(this%ttsoln, 'TTSOLN', this%memoryPath) - call mem_allocate(this%isymmetric, 'ISYMMETRIC', this%memoryPath) - call mem_allocate(this%neq, 'NEQ', this%memoryPath) - call mem_allocate(this%matrix_offset, 'MATRIX_OFFSET', this%memoryPath) - call mem_allocate(this%dvclose, 'DVCLOSE', this%memoryPath) - call mem_allocate(this%bigchold, 'BIGCHOLD', this%memoryPath) - call mem_allocate(this%bigch, 'BIGCH', this%memoryPath) - call mem_allocate(this%relaxold, 'RELAXOLD', this%memoryPath) - call mem_allocate(this%res_prev, 'RES_PREV', this%memoryPath) - call mem_allocate(this%res_new, 'RES_NEW', this%memoryPath) - call mem_allocate(this%icnvg, 'ICNVG', this%memoryPath) - call mem_allocate(this%itertot_timestep, 'ITERTOT_TIMESTEP', this%memoryPath) - call mem_allocate(this%iouttot_timestep, 'IOUTTOT_TIMESTEP', this%memoryPath) - call mem_allocate(this%itertot_sim, 'INNERTOT_SIM', this%memoryPath) - call mem_allocate(this%mxiter, 'MXITER', this%memoryPath) - call mem_allocate(this%linmeth, 'LINMETH', this%memoryPath) - call mem_allocate(this%nonmeth, 'NONMETH', this%memoryPath) - call mem_allocate(this%iprims, 'IPRIMS', this%memoryPath) - call mem_allocate(this%theta, 'THETA', this%memoryPath) - call mem_allocate(this%akappa, 'AKAPPA', this%memoryPath) - call mem_allocate(this%gamma, 'GAMMA', this%memoryPath) - call mem_allocate(this%amomentum, 'AMOMENTUM', this%memoryPath) - call mem_allocate(this%breduc, 'BREDUC', this%memoryPath) - call mem_allocate(this%btol, 'BTOL', this%memoryPath) - call mem_allocate(this%res_lim, 'RES_LIM', this%memoryPath) - call mem_allocate(this%numtrack, 'NUMTRACK', this%memoryPath) - call mem_allocate(this%ibflag, 'IBFLAG', this%memoryPath) - call mem_allocate(this%icsvouterout, 'ICSVOUTEROUT', this%memoryPath) - call mem_allocate(this%icsvinnerout, 'ICSVINNEROUT', this%memoryPath) - call mem_allocate(this%nitermax, 'NITERMAX', this%memoryPath) - call mem_allocate(this%convnmod, 'CONVNMOD', this%memoryPath) - call mem_allocate(this%iallowptc, 'IALLOWPTC', this%memoryPath) - call mem_allocate(this%iptcopt, 'IPTCOPT', this%memoryPath) - call mem_allocate(this%iptcout, 'IPTCOUT', this%memoryPath) - call mem_allocate(this%l2norm0, 'L2NORM0', this%memoryPath) - call mem_allocate(this%ptcdel, 'PTCDEL', this%memoryPath) - call mem_allocate(this%ptcdel0, 'PTCDEL0', this%memoryPath) - call mem_allocate(this%ptcexp, 'PTCEXP', this%memoryPath) - call mem_allocate(this%atsfrac, 'ATSFRAC', this%memoryPath) + call mem_allocate(this%id, 'ID', this%memory_path) + call mem_allocate(this%iu, 'IU', this%memory_path) + call mem_allocate(this%ttform, 'TTFORM', this%memory_path) + call mem_allocate(this%ttsoln, 'TTSOLN', this%memory_path) + call mem_allocate(this%isymmetric, 'ISYMMETRIC', this%memory_path) + call mem_allocate(this%neq, 'NEQ', this%memory_path) + call mem_allocate(this%matrix_offset, 'MATRIX_OFFSET', this%memory_path) + call mem_allocate(this%dvclose, 'DVCLOSE', this%memory_path) + call mem_allocate(this%bigchold, 'BIGCHOLD', this%memory_path) + call mem_allocate(this%bigch, 'BIGCH', this%memory_path) + call mem_allocate(this%relaxold, 'RELAXOLD', this%memory_path) + call mem_allocate(this%res_prev, 'RES_PREV', this%memory_path) + call mem_allocate(this%res_new, 'RES_NEW', this%memory_path) + call mem_allocate(this%icnvg, 'ICNVG', this%memory_path) + call mem_allocate(this%itertot_timestep, 'ITERTOT_TIMESTEP', this%memory_path) + call mem_allocate(this%iouttot_timestep, 'IOUTTOT_TIMESTEP', this%memory_path) + call mem_allocate(this%itertot_sim, 'INNERTOT_SIM', this%memory_path) + call mem_allocate(this%mxiter, 'MXITER', this%memory_path) + call mem_allocate(this%linsolver, 'LINSOLVER', this%memory_path) + call mem_allocate(this%nonmeth, 'NONMETH', this%memory_path) + call mem_allocate(this%iprims, 'IPRIMS', this%memory_path) + call mem_allocate(this%theta, 'THETA', this%memory_path) + call mem_allocate(this%akappa, 'AKAPPA', this%memory_path) + call mem_allocate(this%gamma, 'GAMMA', this%memory_path) + call mem_allocate(this%amomentum, 'AMOMENTUM', this%memory_path) + call mem_allocate(this%breduc, 'BREDUC', this%memory_path) + call mem_allocate(this%btol, 'BTOL', this%memory_path) + call mem_allocate(this%res_lim, 'RES_LIM', this%memory_path) + call mem_allocate(this%numtrack, 'NUMTRACK', this%memory_path) + call mem_allocate(this%ibflag, 'IBFLAG', this%memory_path) + call mem_allocate(this%icsvouterout, 'ICSVOUTEROUT', this%memory_path) + call mem_allocate(this%icsvinnerout, 'ICSVINNEROUT', this%memory_path) + call mem_allocate(this%nitermax, 'NITERMAX', this%memory_path) + call mem_allocate(this%convnmod, 'CONVNMOD', this%memory_path) + call mem_allocate(this%iallowptc, 'IALLOWPTC', this%memory_path) + call mem_allocate(this%iptcopt, 'IPTCOPT', this%memory_path) + call mem_allocate(this%iptcout, 'IPTCOUT', this%memory_path) + call mem_allocate(this%l2norm0, 'L2NORM0', this%memory_path) + call mem_allocate(this%ptcdel, 'PTCDEL', this%memory_path) + call mem_allocate(this%ptcdel0, 'PTCDEL0', this%memory_path) + call mem_allocate(this%ptcexp, 'PTCEXP', this%memory_path) + call mem_allocate(this%atsfrac, 'ATSFRAC', this%memory_path) ! ! -- initialize scalars this%isymmetric = 0 @@ -331,7 +333,7 @@ subroutine allocate_scalars(this) this%iouttot_timestep = 0 this%itertot_sim = 0 this%mxiter = 0 - this%linmeth = 1 + this%linsolver = IMS_SOLVER this%nonmeth = 0 this%iprims = 0 this%theta = DONE @@ -379,29 +381,16 @@ subroutine allocate_arrays(this) this%convnmod = this%modellist%Count() ! ! -- allocate arrays - call mem_allocate(this%active, this%neq, 'IACTIVE', this%memoryPath) - call mem_allocate(this%xtemp, this%neq, 'XTEMP', this%memoryPath) - call mem_allocate(this%dxold, this%neq, 'DXOLD', this%memoryPath) - call mem_allocate(this%hncg, 0, 'HNCG', this%memoryPath) - call mem_allocate(this%lrch, 3, 0, 'LRCH', this%memoryPath) - call mem_allocate(this%wsave, 0, 'WSAVE', this%memoryPath) - call mem_allocate(this%hchold, 0, 'HCHOLD', this%memoryPath) - call mem_allocate(this%deold, 0, 'DEOLD', this%memoryPath) + call mem_allocate(this%active, this%neq, 'IACTIVE', this%memory_path) + call mem_allocate(this%xtemp, this%neq, 'XTEMP', this%memory_path) + call mem_allocate(this%dxold, this%neq, 'DXOLD', this%memory_path) + call mem_allocate(this%hncg, 0, 'HNCG', this%memory_path) + call mem_allocate(this%lrch, 3, 0, 'LRCH', this%memory_path) + call mem_allocate(this%wsave, 0, 'WSAVE', this%memory_path) + call mem_allocate(this%hchold, 0, 'HCHOLD', this%memory_path) + call mem_allocate(this%deold, 0, 'DEOLD', this%memory_path) call mem_allocate(this%convmodstart, this%convnmod + 1, 'CONVMODSTART', & - this%memoryPath) - call mem_allocate(this%locdv, this%convnmod, 'LOCDV', this%memoryPath) - call mem_allocate(this%locdr, this%convnmod, 'LOCDR', this%memoryPath) - call mem_allocate(this%itinner, 0, 'ITINNER', this%memoryPath) - call mem_allocate(this%convlocdv, this%convnmod, 0, 'CONVLOCDV', & - this%memoryPath) - call mem_allocate(this%convlocdr, this%convnmod, 0, 'CONVLOCDR', & - this%memoryPath) - call mem_allocate(this%dvmax, this%convnmod, 'DVMAX', this%memoryPath) - call mem_allocate(this%drmax, this%convnmod, 'DRMAX', this%memoryPath) - call mem_allocate(this%convdvmax, this%convnmod, 0, 'CONVDVMAX', & - this%memoryPath) - call mem_allocate(this%convdrmax, this%convnmod, 0, 'CONVDRMAX', & - this%memoryPath) + this%memory_path) ! ! -- initialize allocated arrays do i = 1, this%neq @@ -409,12 +398,6 @@ subroutine allocate_arrays(this) this%dxold(i) = DZERO this%active(i) = 1 !default is active end do - do i = 1, this%convnmod - this%locdv(i) = 0 - this%locdr(i) = 0 - this%dvmax(i) = DZERO - this%drmax(i) = DZERO - end do ! ! -- initialize convmodstart ieq = 1 @@ -464,13 +447,18 @@ subroutine sln_df(this) else this%solver_mode = 'IMS' end if + ! + ! -- allocate settings structure + allocate (this%linear_settings) + ! ! -- create linear system matrix and compatible vectors this%linear_solver => create_linear_solver(this%solver_mode) this%system_matrix => this%linear_solver%create_matrix() - this%vec_x => this%system_matrix%create_vec_mm(this%neq, 'X', this%memoryPath) + this%vec_x => this%system_matrix%create_vec_mm(this%neq, 'X', & + this%memory_path) this%x => this%vec_x%get_array() this%vec_rhs => this%system_matrix%create_vec_mm(this%neq, 'RHS', & - this%memoryPath) + this%memory_path) this%rhs => this%vec_rhs%get_array() ! call this%vec_rhs%get_ownership_range(irow_start, irow_end) @@ -488,6 +476,11 @@ subroutine sln_df(this) ! -- Allocate and initialize solution arrays call this%allocate_arrays() ! + ! -- Create convergence summary report + allocate (this%cnvg_summary) + call this%cnvg_summary%init(this%modellist%Count(), this%convmodstart, & + this%memory_path) + ! ! -- Go through each model and point x, ibound, and rhs to solution do i = 1, this%modellist%Count() mp => GetNumericalModelFromList(this%modellist, i) @@ -528,17 +521,14 @@ subroutine sln_ar(this) ! -- local variables class(NumericalModelType), pointer :: mp => null() class(NumericalExchangeType), pointer :: cp => null() - character(len=linelength) :: errmsg character(len=linelength) :: warnmsg character(len=linelength) :: keyword character(len=linelength) :: fname character(len=linelength) :: msg integer(I4B) :: i - integer(I4B) :: im integer(I4B) :: ifdparam, mxvl, npp - integer(I4B) :: ims_lin_type integer(I4B) :: ierr - logical :: isfound, endOfBlock + logical(LGP) :: isfound, endOfBlock integer(I4B) :: ival real(DP) :: rval character(len=*), parameter :: fmtcsvout = & @@ -607,6 +597,9 @@ subroutine sln_ar(this) call this%parser%GetStringCaps(keyword) if (keyword == 'FILEOUT') then call this%parser%GetString(fname) + if (nr_procs > 1) then + call append_processor_id(fname, proc_id) + end if this%icsvouterout = getunit() call openfile(this%icsvouterout, iout, fname, 'CSV_OUTER_OUTPUT', & filstat_opt='REPLACE') @@ -620,6 +613,9 @@ subroutine sln_ar(this) call this%parser%GetStringCaps(keyword) if (keyword == 'FILEOUT') then call this%parser%GetString(fname) + if (nr_procs > 1) then + call append_processor_id(fname, proc_id) + end if this%icsvinnerout = getunit() call openfile(this%icsvinnerout, iout, fname, 'CSV_INNER_OUTPUT', & filstat_opt='REPLACE') @@ -792,16 +788,16 @@ subroutine sln_ar(this) this%nonmeth = ival case ('LINEAR_SOLVER') call this%parser%GetStringCaps(keyword) - ival = 1 + ival = IMS_SOLVER if (keyword .eq. 'DEFAULT' .or. & keyword .eq. 'LINEAR') then - ival = 1 + ival = IMS_SOLVER else write (errmsg, '(3a)') & 'Unknown LINEAR_SOLVER specified (', trim(keyword), ').' call store_error(errmsg) end if - this%linmeth = ival + this%linsolver = ival case ('UNDER_RELAXATION_THETA') this%theta = this%parser%GetDouble() case ('UNDER_RELAXATION_KAPPA') @@ -892,35 +888,40 @@ subroutine sln_ar(this) end if if (this%solver_mode == 'PETSC') then - this%linmeth = 2 + this%linsolver = PETSC_SOLVER end if + ! configure linear settings + call this%linear_settings%init(this%memory_path) + call this%linear_settings%preset_config(ifdparam) + call this%linear_settings%read_from_file(this%parser, iout) + ! + if (this%linear_settings%ilinmeth == CG_METHOD) then + this%isymmetric = 1 + end if ! ! -- call secondary subroutine to initialize and read linear ! solver parameters IMSLINEAR solver - if (this%linmeth == 1) then + if (this%solver_mode == "IMS") then allocate (this%imslinear) WRITE (IOUT, *) '***IMS LINEAR SOLVER WILL BE USED***' - call this%imslinear%imslinear_allocate(this%name, this%parser, IOUT, & - this%iprims, this%mxiter, & - ifdparam, ims_lin_type, & - this%neq, this%system_matrix, & - this%rhs, this%x, this%nitermax) - if (ims_lin_type .eq. 1) then - this%isymmetric = 1 - end if + call this%imslinear%imslinear_allocate(this%name, IOUT, this%iprims, & + this%mxiter, this%neq, & + this%system_matrix, this%rhs, & + this%x, this%linear_settings) + ! + ! -- petsc linear solver flag + else if (this%solver_mode == "PETSC") then + call this%linear_solver%initialize(this%system_matrix, & + this%linear_settings, & + this%cnvg_summary) ! ! -- incorrect linear solver flag - else if (this%linmeth == 2) then - call this%linear_solver%initialize(this%system_matrix) - this%nitermax = this%linear_solver%nitermax - this%isymmetric = 0 - ELSE - WRITE (errmsg, '(a)') & + else + write (errmsg, '(a)') & 'Incorrect value for linear solution method specified.' call store_error(errmsg) - END IF - + end if ! ! -- write message about matrix symmetry if (this%isymmetric == 1) then @@ -957,7 +958,7 @@ subroutine sln_ar(this) ! ! -- non-linear solver data WRITE (IOUT, 9002) this%dvclose, this%mxiter, & - this%iprims, this%nonmeth, this%linmeth + this%iprims, this%nonmeth, this%linsolver ! ! -- standard outer iteration formats 9002 FORMAT(1X, 'OUTER ITERATION CONVERGENCE CRITERION (DVCLOSE) = ', E15.6, & @@ -993,8 +994,10 @@ subroutine sln_ar(this) /1X, 'BACKTRACKING RESIDUAL LIMIT (RES_LIM) = ', E15.6) ! ! -- linear solver data - if (this%linmeth == 1) then + if (this%linsolver == IMS_SOLVER) then call this%imslinear%imslinear_summary(this%mxiter) + else + call this%linear_solver%print_summary() end if ! -- write summary of solver error messages @@ -1023,33 +1026,16 @@ subroutine sln_ar(this) ! allocate space for saving solver convergence history if (this%iprims == 2 .or. this%icsvinnerout > 0) then - this%nitermax = this%nitermax * this%mxiter + this%nitermax = this%linear_settings%iter1 * this%mxiter else this%nitermax = 1 end if allocate (this%caccel(this%nitermax)) - im = this%convnmod - call mem_reallocate(this%itinner, this%nitermax, 'ITINNER', & - trim(this%name)) - call mem_reallocate(this%convlocdv, im, this%nitermax, 'CONVLOCDV', & - trim(this%name)) - call mem_reallocate(this%convlocdr, im, this%nitermax, 'CONVLOCDR', & - trim(this%name)) - call mem_reallocate(this%convdvmax, im, this%nitermax, 'CONVDVMAX', & - trim(this%name)) - call mem_reallocate(this%convdrmax, im, this%nitermax, 'CONVDRMAX', & - trim(this%name)) - do i = 1, this%nitermax - this%itinner(i) = 0 - do im = 1, this%convnmod - this%convlocdv(im, i) = 0 - this%convlocdr(im, i) = 0 - this%convdvmax(im, i) = DZERO - this%convdrmax(im, i) = DZERO - end do - end do + ! + ! -- resize convergence report + call this%cnvg_summary%reinit(this%nitermax) ! ! -- check for numerical solution errors ierr = count_errors() @@ -1102,7 +1088,7 @@ subroutine sln_calculate_delt(this) end if ! ! -- submit stable dt for upcoming step - call ats_submit_delt(kstp, kper, delt_temp, this%memoryPath, idir=idir) + call ats_submit_delt(kstp, kper, delt_temp, this%memory_path, idir=idir) end if ! return @@ -1187,7 +1173,7 @@ subroutine sln_da(this) class(NumericalSolutionType) :: this !< NumericalSolutionType instance ! ! -- IMSLinearModule - if (this%linmeth == 1) then + if (this%linsolver == IMS_SOLVER) then call this%imslinear%imslinear_da() deallocate (this%imslinear) end if @@ -1233,15 +1219,18 @@ subroutine sln_da(this) call mem_deallocate(this%hchold) call mem_deallocate(this%deold) call mem_deallocate(this%convmodstart) - call mem_deallocate(this%locdv) - call mem_deallocate(this%locdr) - call mem_deallocate(this%itinner) - call mem_deallocate(this%convlocdv) - call mem_deallocate(this%convlocdr) - call mem_deallocate(this%dvmax) - call mem_deallocate(this%drmax) - call mem_deallocate(this%convdvmax) - call mem_deallocate(this%convdrmax) + ! + ! -- convergence report + call this%cnvg_summary%destroy() + deallocate (this%cnvg_summary) + ! + ! -- linear solver + call this%linear_solver%destroy() + deallocate (this%linear_solver) + ! + ! -- linear solver settings + call this%linear_settings%destroy() + deallocate (this%linear_settings) ! ! -- Scalars call mem_deallocate(this%id) @@ -1262,7 +1251,7 @@ subroutine sln_da(this) call mem_deallocate(this%iouttot_timestep) call mem_deallocate(this%itertot_sim) call mem_deallocate(this%mxiter) - call mem_deallocate(this%linmeth) + call mem_deallocate(this%linsolver) call mem_deallocate(this%nonmeth) call mem_deallocate(this%iprims) call mem_deallocate(this%theta) @@ -1371,13 +1360,18 @@ subroutine writeCSVHeader(this) 'solution_inner_dvmax_node' write (this%icsvinnerout, '(*(G0,:,","))', advance='NO') & '', 'solution_inner_drmax', 'solution_inner_drmax_model', & - 'solution_inner_drmax_node', 'solution_inner_alpha' - if (this%imslinear%ilinmeth == 2) then + 'solution_inner_drmax_node' + ! solver items specific to ims solver + if (this%linsolver == IMS_SOLVER) then write (this%icsvinnerout, '(*(G0,:,","))', advance='NO') & - '', 'solution_inner_omega' + '', 'solution_inner_alpha' + if (this%imslinear%ilinmeth == 2) then + write (this%icsvinnerout, '(*(G0,:,","))', advance='NO') & + '', 'solution_inner_omega' + end if end if - ! -- check for more than one model - if (this%convnmod > 1) then + ! -- check for more than one model - ims only + if (this%linsolver == IMS_SOLVER .and. this%convnmod > 1) then do im = 1, this%modellist%Count() mp => GetNumericalModelFromList(this%modellist, im) write (this%icsvinnerout, '(*(G0,:,","))', advance='NO') & @@ -1499,7 +1493,6 @@ subroutine solve(this, kiter) class(NumericalExchangeType), pointer :: cp => null() character(len=LINELENGTH) :: title character(len=LINELENGTH) :: tag - character(len=LINELENGTH) :: line character(len=LENPAKLOC) :: cmod character(len=LENPAKLOC) :: cpak character(len=LENPAKLOC) :: cpakout @@ -1525,7 +1518,7 @@ subroutine solve(this, kiter) integer(I4B) :: ipos0 integer(I4B) :: ipos1 real(DP) :: dxmax_nur - real(DP) :: dxmax + real(DP) :: dxold_max real(DP) :: ptcf real(DP) :: ttform real(DP) :: ttsoln @@ -1549,7 +1542,7 @@ subroutine solve(this, kiter) end if ! ! -- initialize table and define columns - title = trim(this%memoryPath)//' OUTER ITERATION SUMMARY' + title = trim(this%memory_path)//' OUTER ITERATION SUMMARY' call table_cr(this%outertab, this%name, title) call this%outertab%table_df(ntabrows, ntabcols, iout, & finalize=.FALSE.) @@ -1619,7 +1612,7 @@ subroutine solve(this, kiter) WRITE (99, *) 'MATRIX SOLUTION FOLLOWS' WRITE (99, '(10(I8,G15.4))') (n, this%x(N), N=1, this%NEQ) close (99) - call stop_with_error() + call pstop() end if !------------------------------------------------------- ! @@ -1689,47 +1682,41 @@ subroutine solve(this, kiter) end if end do ! - ! -- evaluate package convergence - if (abs(dpak) > this%dvclose) then - this%icnvg = 0 - ! -- write message to stdout - if (iend /= 0) then - write (line, '(3a)') & - 'PACKAGE (', trim(cpakout), ') CAUSED CONVERGENCE FAILURE' - call sim_message(line) - end if - end if - ! - ! -- write maximum change in package convergence check - if (this%iprims > 0) then - cval = 'Package' - if (this%icnvg /= 1) then - cmsg = ' ' - else - cmsg = '*' - end if - if (len_trim(cpakout) > 0) then - ! - ! -- add data to outertab - call this%outertab%add_term(cval) - call this%outertab%add_term(kiter) - call this%outertab%add_term(' ') - if (this%numtrack > 0) then - call this%outertab%add_term(' ') - call this%outertab%add_term(' ') - call this%outertab%add_term(' ') + ! -- evaluate package convergence - only done if convergence is achieved + if (this%icnvg == 1) then + this%icnvg = this%sln_package_convergence(dpak, cpakout, iend) + ! + ! -- write maximum change in package convergence check + if (this%iprims > 0) then + cval = 'Package' + if (this%icnvg /= 1) then + cmsg = ' ' + else + cmsg = '*' + end if + if (len_trim(cpakout) > 0) then + ! + ! -- add data to outertab + call this%outertab%add_term(cval) + call this%outertab%add_term(kiter) call this%outertab%add_term(' ') + if (this%numtrack > 0) then + call this%outertab%add_term(' ') + call this%outertab%add_term(' ') + call this%outertab%add_term(' ') + call this%outertab%add_term(' ') + end if + call this%outertab%add_term(dpak) + call this%outertab%add_term(cmsg) + call this%outertab%add_term(cpakout) end if - call this%outertab%add_term(dpak) - call this%outertab%add_term(cmsg) - call this%outertab%add_term(cpakout) end if end if ! ! -- under-relaxation - only done if convergence not achieved if (this%icnvg /= 1) then if (this%nonmeth > 0) then - call this%sln_underrelax(kiter, this%hncg(kiter), this%neq, & ! TODO_MJR: this is not equiv. serial/parallel + call this%sln_underrelax(kiter, this%hncg(kiter), this%neq, & this%active, this%x, this%xtemp) else call this%sln_calcdx(this%neq, this%active, & @@ -1748,17 +1735,20 @@ subroutine solve(this, kiter) this%dxold(i0:i1), inewtonur, dxmax_nur, locmax_nur) end do ! + ! -- synchronize Newton Under-relaxation flag + inewtonur = this%sln_sync_newtonur_flag(inewtonur) + ! ! -- check for convergence if newton under-relaxation applied if (inewtonur /= 0) then ! ! -- calculate maximum change in heads in cells that have ! not been adjusted by newton under-relxation - call this%sln_maxval(this%neq, this%dxold, dxmax) + call this%sln_maxval(this%neq, this%dxold, dxold_max) ! ! -- evaluate convergence - if (abs(dxmax) <= this%dvclose .and. & - abs(this%hncg(kiter)) <= this%dvclose .and. & - abs(dpak) <= this%dvclose) then + if (this%sln_nur_has_converged(dxold_max, this%hncg(kiter))) then + ! + ! -- converged this%icnvg = 1 ! ! -- reset outer dependent-variable change and location for output @@ -1920,7 +1910,6 @@ subroutine sln_buildsystem(this, kiter, inewton) class(NumericalSolutionType) :: this integer(I4B), intent(in) :: kiter integer(I4B), intent(in) :: inewton - ! local integer(I4B) :: im, ic class(NumericalModelType), pointer :: mp @@ -1929,6 +1918,12 @@ subroutine sln_buildsystem(this, kiter, inewton) ! -- Set amat and rhs to zero call this%sln_reset() + ! reset models + do im = 1, this%modellist%Count() + mp => GetNumericalModelFromList(this%modellist, im) + call mp%model_reset() + end do + ! synchronize for CF call this%synchronize(STG_BFR_EXG_CF, this%synchronize_ctx) @@ -1983,7 +1978,7 @@ subroutine convergence_summary(this, iu, im, itertot_timestep) character(len=LENPAKLOC) :: strr integer(I4B) :: ntabrows integer(I4B) :: ntabcols - integer(I4B) :: i + integer(I4B) :: iinner integer(I4B) :: i0 integer(I4B) :: iouter integer(I4B) :: j @@ -2009,7 +2004,7 @@ subroutine convergence_summary(this, iu, im, itertot_timestep) ntabcols = 7 ! ! -- initialize table and define columns - title = trim(this%memoryPath)//' INNER ITERATION SUMMARY' + title = trim(this%memory_path)//' INNER ITERATION SUMMARY' call table_cr(this%innertab, this%name, title) call this%innertab%table_df(ntabrows, ntabcols, iu) tag = 'TOTAL ITERATION' @@ -2036,28 +2031,28 @@ subroutine convergence_summary(this, iu, im, itertot_timestep) ! -- write the inner iteration summary to unit iu i0 = 0 do k = 1, itertot_timestep - i = this%itinner(k) - if (i <= i0) then + iinner = this%cnvg_summary%itinner(k) + if (iinner <= i0) then iouter = iouter + 1 end if if (im > this%convnmod) then dv = DZERO dr = DZERO do j = 1, this%convnmod - if (ABS(this%convdvmax(j, k)) > ABS(dv)) then - locdv = this%convlocdv(j, k) - dv = this%convdvmax(j, k) + if (ABS(this%cnvg_summary%convdvmax(j, k)) > ABS(dv)) then + locdv = this%cnvg_summary%convlocdv(j, k) + dv = this%cnvg_summary%convdvmax(j, k) end if - if (ABS(this%convdrmax(j, k)) > ABS(dr)) then - locdr = this%convlocdr(j, k) - dr = this%convdrmax(j, k) + if (ABS(this%cnvg_summary%convdrmax(j, k)) > ABS(dr)) then + locdr = this%cnvg_summary%convlocdr(j, k) + dr = this%cnvg_summary%convdrmax(j, k) end if end do else - locdv = this%convlocdv(im, k) - locdr = this%convlocdr(im, k) - dv = this%convdvmax(im, k) - dr = this%convdrmax(im, k) + locdv = this%cnvg_summary%convlocdv(im, k) + locdr = this%cnvg_summary%convlocdr(im, k) + dv = this%cnvg_summary%convdvmax(im, k) + dr = this%cnvg_summary%convdrmax(im, k) end if call this%sln_get_loc(locdv, strh) call this%sln_get_loc(locdr, strr) @@ -2065,14 +2060,14 @@ subroutine convergence_summary(this, iu, im, itertot_timestep) ! -- add data to innertab call this%innertab%add_term(k) call this%innertab%add_term(iouter) - call this%innertab%add_term(i) + call this%innertab%add_term(iinner) call this%innertab%add_term(dv) call this%innertab%add_term(adjustr(trim(strh))) call this%innertab%add_term(dr) call this%innertab%add_term(adjustr(trim(strr))) ! ! -- update i0 - i0 = i + i0 = iinner end do ! ! -- return @@ -2124,13 +2119,13 @@ subroutine csv_convergence_summary(this, iu, totim, kper, kstp, kouter, & dv = DZERO dr = DZERO do j = 1, this%convnmod - if (ABS(this%convdvmax(j, kpos)) > ABS(dv)) then - locdv = this%convlocdv(j, kpos) - dv = this%convdvmax(j, kpos) + if (ABS(this%cnvg_summary%convdvmax(j, kpos)) > ABS(dv)) then + locdv = this%cnvg_summary%convlocdv(j, kpos) + dv = this%cnvg_summary%convdvmax(j, kpos) end if - if (ABS(this%convdrmax(j, kpos)) > ABS(dr)) then - locdr = this%convlocdr(j, kpos) - dr = this%convdrmax(j, kpos) + if (ABS(this%cnvg_summary%convdrmax(j, kpos)) > ABS(dr)) then + locdr = this%cnvg_summary%convlocdr(j, kpos) + dr = this%cnvg_summary%convdrmax(j, kpos) end if end do ! @@ -2142,17 +2137,19 @@ subroutine csv_convergence_summary(this, iu, totim, kper, kstp, kouter, & call this%sln_get_nodeu(locdr, im, nodeu) write (iu, '(*(G0,:,","))', advance='NO') '', dr, im, nodeu ! - ! -- write acceleration parameters - write (iu, '(*(G0,:,","))', advance='NO') & - '', trim(adjustl(this%caccel(kpos))) + ! -- write ims acceleration parameters + if (this%linsolver == IMS_SOLVER) then + write (iu, '(*(G0,:,","))', advance='NO') & + '', trim(adjustl(this%caccel(kpos))) + end if ! - ! -- write information for each model - if (this%convnmod > 1) then - do j = 1, this%convnmod - locdv = this%convlocdv(j, kpos) - dv = this%convdvmax(j, kpos) - locdr = this%convlocdr(j, kpos) - dr = this%convdrmax(j, kpos) + ! -- write information for each model - ims only + if (this%linsolver == IMS_SOLVER .and. this%convnmod > 1) then + do j = 1, this%cnvg_summary%convnmod + locdv = this%cnvg_summary%convlocdv(j, kpos) + dv = this%cnvg_summary%convdvmax(j, kpos) + locdr = this%cnvg_summary%convlocdr(j, kpos) + dr = this%cnvg_summary%convdrmax(j, kpos) ! ! -- get model number and user node number for dv call this%sln_get_nodeu(locdv, im, nodeu) @@ -2185,6 +2182,7 @@ end subroutine csv_convergence_summary !! !< subroutine save(this, filename) + use SparseMatrixModule ! -- modules use InputOutputModule, only: getunit ! -- dummy variables @@ -2379,9 +2377,9 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) integer(I4B), intent(inout) :: iptc real(DP), intent(in) :: ptcf ! -- local variables - logical :: lsame + logical(LGP) :: lsame integer(I4B) :: ieq - integer(I4B) :: irow + integer(I4B) :: irow_glo integer(I4B) :: itestmat integer(I4B) :: ipos integer(I4B) :: icol_s @@ -2402,7 +2400,7 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) do ieq = 1, this%neq ! ! -- get (global) cell id - irow = ieq + this%matrix_offset + irow_glo = ieq + this%matrix_offset ! ! -- store x in temporary location this%xtemp(ieq) = this%x(ieq) @@ -2411,35 +2409,33 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) ! -- adjust small diagonal coefficient in an active cell if (this%active(ieq) > 0) then diagval = -DONE - adiag = abs(this%system_matrix%get_diag_value(irow)) + adiag = abs(this%system_matrix%get_diag_value(irow_glo)) if (adiag < DEM15) then - call this%system_matrix%set_diag_value(irow, diagval) + call this%system_matrix%set_diag_value(irow_glo, diagval) this%rhs(ieq) = this%rhs(ieq) + diagval * this%x(ieq) end if ! -- Dirichlet boundary or no-flow cell else - call this%system_matrix%set_diag_value(irow, DONE) - call this%system_matrix%zero_row_offdiag(irow) + call this%system_matrix%set_diag_value(irow_glo, DONE) + call this%system_matrix%zero_row_offdiag(irow_glo) this%rhs(ieq) = this%x(ieq) end if end do ! ! -- complete adjustments for Dirichlet boundaries for a symmetric matrix - if (this%isymmetric == 1) then + ! -- TODO_MJR: add this for PETSc/parallel + if (this%isymmetric == 1 .and. simulation_mode == "SEQUENTIAL") then do ieq = 1, this%neq - ! - ! -- get (global) row number - irow = ieq + this%matrix_offset if (this%active(ieq) > 0) then - icol_s = this%system_matrix%get_first_col_pos(irow) - icol_e = this%system_matrix%get_last_col_pos(irow) + icol_s = this%system_matrix%get_first_col_pos(ieq) + icol_e = this%system_matrix%get_last_col_pos(ieq) do ipos = icol_s, icol_e jcol = this%system_matrix%get_column(ipos) - if (jcol == irow) cycle - if (this%active(jcol - this%matrix_offset) < 0) then + if (jcol == ieq) cycle + if (this%active(jcol) < 0) then this%rhs(ieq) = this%rhs(ieq) - & (this%system_matrix%get_value_pos(ipos) * & - this%x(jcol - this%matrix_offset)) + this%x(jcol)) call this%system_matrix%set_value_pos(ipos, DZERO) end if @@ -2480,7 +2476,7 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) end if end if else - lsame = is_same(l2norm, this%l2norm0) + lsame = is_close(l2norm, this%l2norm0) if (lsame) then iptc = 0 end if @@ -2526,11 +2522,11 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) end if bnorm = DZERO do ieq = 1, this%neq - irow = ieq + this%matrix_offset + irow_glo = ieq + this%matrix_offset if (this%active(ieq) > 0) then - diagval = abs(this%system_matrix%get_diag_value(irow)) + diagval = abs(this%system_matrix%get_diag_value(irow_glo)) bnorm = bnorm + this%rhs(ieq) * this%rhs(ieq) - call this%system_matrix%add_diag_value(irow, -ptcval) + call this%system_matrix%add_diag_value(irow_glo, -ptcval) this%rhs(ieq) = this%rhs(ieq) - ptcval * this%x(ieq) end if end do @@ -2555,11 +2551,11 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) open (itestmat, file=trim(adjustl(fname))) write (itestmat, *) 'NODE, RHS, AMAT FOLLOW' do ieq = 1, this%neq - irow = ieq + this%matrix_offset - icol_s = this%system_matrix%get_first_col_pos(irow) - icol_e = this%system_matrix%get_last_col_pos(irow) + irow_glo = ieq + this%matrix_offset + icol_s = this%system_matrix%get_first_col_pos(irow_glo) + icol_e = this%system_matrix%get_last_col_pos(irow_glo) write (itestmat, '(*(G0,:,","))') & - irow, & + irow_glo, & this%rhs(ieq), & (this%system_matrix%get_column(ipos), ipos=icol_s, icol_e), & (this%system_matrix%get_value_pos(ipos), ipos=icol_s, icol_e) @@ -2572,17 +2568,14 @@ subroutine sln_ls(this, kiter, kstp, kper, in_iter, iptc, ptcf) ! -- call appropriate linear solver ! ! -- ims linear solver - linmeth option 1 - if (this%linmeth == 1) then + if (this%linsolver == IMS_SOLVER) then call this%imslinear%imslinear_apply(this%icnvg, kstp, kiter, in_iter, & - this%nitermax, & - this%convnmod, this%convmodstart, & - this%locdv, this%locdr, & - this%caccel, this%itinner, & - this%convlocdv, this%convlocdr, & - this%dvmax, this%drmax, & - this%convdvmax, this%convdrmax) - else if (this%linmeth == 2) then - call this%linear_solver%solve(kiter, this%vec_rhs, this%vec_x) + this%nitermax, this%convnmod, & + this%convmodstart, this%caccel, & + this%cnvg_summary) + else if (this%linsolver == PETSC_SOLVER) then + call this%linear_solver%solve(kiter, this%vec_rhs, & + this%vec_x, this%cnvg_summary) in_iter = this%linear_solver%iteration_number this%icnvg = this%linear_solver%is_converged end if @@ -3138,6 +3131,59 @@ function sln_has_converged(this, max_dvc) result(has_converged) end function sln_has_converged + !> @brief Check package convergence + !< + function sln_package_convergence(this, dpak, cpakout, iend) result(ivalue) + ! dummy + class(NumericalSolutionType) :: this !< NumericalSolutionType instance + real(DP), intent(in) :: dpak !< Newton Under-relaxation flag + character(len=LENPAKLOC), intent(in) :: cpakout !< string with package that caused failure + integer(I4B), intent(in) :: iend !< flag indicating if last inner iteration (iend=1) + ! local + integer(I4B) :: ivalue + ivalue = 1 + if (abs(dpak) > this%dvclose) then + ivalue = 0 + ! -- write message to stdout + if (iend /= 0) then + write (errmsg, '(3a)') & + 'PACKAGE (', trim(cpakout), ') CAUSED CONVERGENCE FAILURE' + call write_message(errmsg) + end if + end if + + end function sln_package_convergence + + !> @brief Syncronize Newton Under-relaxation flag + !< + function sln_sync_newtonur_flag(this, inewtonur) result(ivalue) + ! dummy + class(NumericalSolutionType) :: this !< NumericalSolutionType instance + integer(I4B), intent(in) :: inewtonur !< Newton Under-relaxation flag + ! local + integer(I4B) :: ivalue !< Default is set to current value (1 = under-relaxation applied) + + ivalue = inewtonur + + end function sln_sync_newtonur_flag + + !> @brief Custom convergence check for when Newton UR has been applied + !< + function sln_nur_has_converged(this, dxold_max, hncg) & + result(has_converged) + class(NumericalSolutionType) :: this !< NumericalSolutionType instance + real(DP), intent(in) :: dxold_max !< the maximum dependent variable change for unrelaxed cells + real(DP), intent(in) :: hncg !< largest dep. var. change at end of Picard iteration + logical(LGP) :: has_converged !< True, when converged + + has_converged = .false. + if (abs(dxold_max) <= this%dvclose .and. & + abs(hncg) <= this%dvclose) then + has_converged = .true. + end if + + end function sln_nur_has_converged + !> @ brief Get cell location string !! !! Get the cell location string for the provided solution node number. @@ -3154,6 +3200,7 @@ subroutine sln_get_loc(this, nodesln, str) integer(I4B) :: istart integer(I4B) :: iend integer(I4B) :: noder + integer(I4B) :: nglo ! ! -- initialize dummy variables str = '' @@ -3161,14 +3208,17 @@ subroutine sln_get_loc(this, nodesln, str) ! -- initialize local variables noder = 0 ! + ! -- when parallel, account for offset + nglo = nodesln + this%matrix_offset + ! ! -- calculate and set offsets do i = 1, this%modellist%Count() mp => GetNumericalModelFromList(this%modellist, i) istart = 0 iend = 0 call mp%get_mrange(istart, iend) - if (nodesln >= istart .and. nodesln <= iend) then - noder = nodesln - istart + 1 + if (nglo >= istart .and. nglo <= iend) then + noder = nglo - istart + 1 call mp%get_mcellid(noder, str) exit end if diff --git a/src/Solution/PETSc/PetscConvergence.F90 b/src/Solution/PETSc/PetscConvergence.F90 index 47dc0d569bb..7c4dcd2cf81 100644 --- a/src/Solution/PETSc/PetscConvergence.F90 +++ b/src/Solution/PETSc/PetscConvergence.F90 @@ -3,102 +3,175 @@ module PetscConvergenceModule use petscksp use KindModule, only: I4B, DP use ListModule + use ConvergenceSummaryModule implicit none private public :: petsc_check_convergence - public :: petsc_add_context - public :: petsc_remove_context + public :: KSPSetConvergenceTest type, public :: PetscContextType Vec :: x_old + Vec :: res_old Vec :: delta_x + Vec :: delta_res real(DP) :: dvclose integer(I4B) :: max_its + type(ConvergenceSummaryType), pointer :: cnvg_summary => null() + contains + procedure :: destroy end type PetscContextType - type(ListType) :: ctx_list + ! passing our context into PETSc requires an explicit interface + ! on KSPSetConvergenceTest, it is defined here: + interface + subroutine CnvgCheckFunc(ksp, n, rnorm, flag, context, ierr) + import tKSP, PetscContextType + type(tKSP) :: ksp + PetscInt :: n + PetscReal :: rnorm + KSPConvergedReason :: flag + class(PetscContextType), pointer :: context + PetscErrorCode :: ierr + end subroutine + + subroutine CnvgDestroyFunc(context, ierr) + import PetscContextType + class(PetscContextType), pointer :: context + PetscErrorCode :: ierr + end subroutine + + subroutine KSPSetConvergenceTest(ksp, check_convergence, context, & + destroy, ierr) + import tKSP, CnvgCheckFunc, PetscContextType, CnvgDestroyFunc + type(tKSP) :: ksp + procedure(CnvgCheckFunc) :: check_convergence + class(PetscContextType), pointer :: context + procedure(CnvgDestroyFunc) :: destroy + PetscErrorCode :: ierr + end subroutine + end interface contains - !> @brief Add a context to the static list. The - !! generated idx can then be used as a handle when - !! calling 'KSPSetConvergenceTest'. Make sure to remove - !< the context from this global list when done. - subroutine petsc_add_context(ctx, idx) - class(PetscContextType), pointer, intent(in) :: ctx - integer(I4B), intent(out) :: idx - ! local - class(*), pointer :: obj_ptr - - obj_ptr => ctx - call ctx_list%Add(obj_ptr) - idx = ctx_list%Count() - - end subroutine petsc_add_context - - !> @brief This will clear the list with context pointers - !< - subroutine petsc_remove_context(ctx) - class(PetscContextType), pointer, intent(in) :: ctx - ! local - integer(I4B) :: idx - class(*), pointer :: obj_ptr - - obj_ptr => ctx - idx = ctx_list%GetIndex(obj_ptr) - call ctx_list%RemoveNode(idx, .false.) - - end subroutine petsc_remove_context - !> @brief Routine to check the convergence. This is called !< from within PETSc. - subroutine petsc_check_convergence(ksp, n, rnorm, flag, ctx_id, ierr) + subroutine petsc_check_convergence(ksp, n, rnorm, flag, context, ierr) KSP :: ksp !< Iterative context PetscInt :: n !< Iteration number PetscReal :: rnorm !< 2-norm (preconditioned) residual value KSPConvergedReason :: flag !< Converged reason - PetscInt :: ctx_id !< index into the static context list + class(PetscContextType), pointer :: context !< context PetscErrorCode :: ierr !< error ! local PetscScalar, parameter :: min_one = -1.0 - real(DP) :: norm - Vec :: x - class(PetscContextType), pointer :: petsc_context - class(*), pointer :: obj_ptr - - ! get the context from the list - petsc_context => null() - obj_ptr => ctx_list%GetItem(ctx_id) - select type (obj_ptr) - class is (PetscContextType) - petsc_context => obj_ptr - end select - + PetscScalar, dimension(:), pointer :: local_dx, local_dr + PetscScalar :: norm, dvmax_model, drmax_model + PetscInt :: idx_dv, idx_dr + Vec :: x, res + type(ConvergenceSummaryType), pointer :: summary + PetscInt :: iter_cnt + PetscInt :: i, j, istart, iend + + summary => context%cnvg_summary + + ! NB: KSPBuildResidual needs to have its vector destroyed + ! to avoid a memory leak, KSPBuildSolution doesn't... call KSPBuildSolution(ksp, PETSC_NULL_VEC, x, ierr) CHKERRQ(ierr) + call KSPBuildResidual(ksp, PETSC_NULL_VEC, PETSC_NULL_VEC, res, ierr) + CHKERRQ(ierr) + ! n == 0 is before the iteration starts if (n == 0) then - call VecCopy(x, petsc_context%x_old, ierr) - CHKERRQ(ierr) - flag = KSP_CONVERGED_ITERATING + if (rnorm == 0.0) then + ! exact solution found + flag = KSP_CONVERGED_HAPPY_BREAKDOWN + else + call VecCopy(x, context%x_old, ierr) + CHKERRQ(ierr) + call VecCopy(res, context%res_old, ierr) + CHKERRQ(ierr) + call VecDestroy(res, ierr) + CHKERRQ(ierr) + flag = KSP_CONVERGED_ITERATING + end if return end if - call VecWAXPY(petsc_context%delta_x, min_one, x, petsc_context%x_old, ierr) + ! increment iteration counter + summary%iter_cnt = summary%iter_cnt + 1 + iter_cnt = summary%iter_cnt + + if (summary%nitermax > 1) then + summary%itinner(iter_cnt) = n + do i = 1, summary%convnmod + summary%convdvmax(i, iter_cnt) = -huge(dvmax_model) + summary%convlocdv(i, iter_cnt) = -1 + summary%convdrmax(i, iter_cnt) = -huge(drmax_model) + summary%convlocdr(i, iter_cnt) = -1 + end do + end if + + call VecWAXPY(context%delta_x, min_one, context%x_old, x, ierr) + CHKERRQ(ierr) + + call VecWAXPY(context%delta_res, min_one, context%res_old, res, ierr) + CHKERRQ(ierr) + + call VecNorm(context%delta_x, NORM_INFINITY, norm, ierr) CHKERRQ(ierr) - call VecNorm(petsc_context%delta_x, NORM_INFINITY, norm, ierr) + call VecCopy(x, context%x_old, ierr) CHKERRQ(ierr) - call VecCopy(x, petsc_context%x_old, ierr) + call VecCopy(res, context%res_old, ierr) CHKERRQ(ierr) - if (norm < petsc_context%dvclose) then + call VecDestroy(res, ierr) + CHKERRQ(ierr) + + ! get dv and dr per local model + call VecGetArrayF90(context%delta_x, local_dx, ierr) + CHKERRQ(ierr) + call VecGetArrayF90(context%delta_res, local_dr, ierr) + CHKERRQ(ierr) + do i = 1, summary%convnmod + ! reset + dvmax_model = 0.0 + idx_dv = -1 + drmax_model = 0.0 + idx_dr = -1 + ! get first and last model index + istart = summary%model_bounds(i) + iend = summary%model_bounds(i + 1) - 1 + do j = istart, iend + if (abs(local_dx(j)) > abs(dvmax_model)) then + dvmax_model = local_dx(j) + idx_dv = j + end if + if (abs(local_dr(j)) > abs(drmax_model)) then + drmax_model = local_dr(j) + idx_dr = j + end if + end do + if (summary%nitermax > 1) then + summary%convdvmax(i, iter_cnt) = dvmax_model + summary%convlocdv(i, iter_cnt) = idx_dv + summary%convdrmax(i, iter_cnt) = drmax_model + summary%convlocdr(i, iter_cnt) = idx_dr + end if + end do + call VecRestoreArrayF90(x, local_dx, ierr) + CHKERRQ(ierr) + call VecRestoreArrayF90(x, local_dr, ierr) + CHKERRQ(ierr) + + if (norm < context%dvclose) then flag = KSP_CONVERGED_HAPPY_BREAKDOWN ! Converged else flag = KSP_CONVERGED_ITERATING ! Not yet converged - if (n == petsc_context%max_its) then + if (n == context%max_its) then ! ran out of iterations before convergence ! has been reached flag = KSP_DIVERGED_ITS @@ -107,4 +180,20 @@ subroutine petsc_check_convergence(ksp, n, rnorm, flag, ctx_id, ierr) end subroutine petsc_check_convergence + subroutine destroy(this) + class(PetscContextType) :: this + ! local + integer(I4B) :: ierr + + call VecDestroy(this%x_old, ierr) + CHKERRQ(ierr) + call VecDestroy(this%res_old, ierr) + CHKERRQ(ierr) + call VecDestroy(this%delta_x, ierr) + CHKERRQ(ierr) + call VecDestroy(this%delta_res, ierr) + CHKERRQ(ierr) + + end subroutine destroy + end module PetscConvergenceModule diff --git a/src/Solution/PETSc/PetscImsPreconditioner.F90 b/src/Solution/PETSc/PetscImsPreconditioner.F90 new file mode 100644 index 00000000000..c5f834ad440 --- /dev/null +++ b/src/Solution/PETSc/PetscImsPreconditioner.F90 @@ -0,0 +1,80 @@ +module PetscImsPreconditionerModule +#include + use petscksp + + implicit none + private + + public :: PcShellCtxType + public :: pcshell_apply + public :: pcshell_setup + public :: pcshell_destroy + + type :: PcShellCtxType + Vec :: diag + end type + + interface + subroutine PCShellGetContext(pc, ctx, ierr) + import PcShellCtxType, tPC + type(tPC) :: pc + type(PcShellCtxType), pointer :: ctx + integer :: ierr + end subroutine + end interface + +contains + + !> @brief Apply shell preconditioner + !< + subroutine pcshell_apply(pc, x, y, ierr) + PC :: pc !< the shell preconditioner + Vec :: x !< the input vector + Vec :: y !< the output vector + PetscErrorCode :: ierr !< PETSc error code + ! local + type(PcShellCtxType), pointer :: pc_ctx => null() + + ! this applies an example jacobi pc, + ! to be replaced by others (MILUT) + call PCShellGetContext(pc, pc_ctx, ierr) + CHKERRQ(ierr) + call VecPointwiseMult(y, x, pc_ctx%diag, ierr) + CHKERRQ(ierr) + + end subroutine pcshell_apply + + !> @brief Set up the custom preconditioner + !< + subroutine pcshell_setup(pc, ierr) + PC :: pc !< the shell preconditioner + PetscErrorCode :: ierr !< PETSc error code + ! local + Mat :: pmat + type(PcShellCtxType), pointer :: pc_ctx => null() + + ! this currently sets up an example jacobi pc, + ! to be replaced by others (MILUT) + call PCShellGetContext(pc, pc_ctx, ierr) + CHKERRQ(ierr) + call PCGetOperators(pc, PETSC_NULL_MAT, pmat, ierr) + CHKERRQ(ierr) + call MatCreateVecs(pmat, pc_ctx%diag, PETSC_NULL_VEC, ierr) + CHKERRQ(ierr) + call MatGetDiagonal(pmat, pc_ctx%diag, ierr) + CHKERRQ(ierr) + call VecReciprocal(pc_ctx%diag, ierr) + CHKERRQ(ierr) + + end subroutine pcshell_setup + + !> @brief Clean up + !< + subroutine pcshell_destroy(pc, ierr) + PC :: pc !< the shell preconditioner + PetscErrorCode :: ierr !< PETSc error code + ! local + + end subroutine pcshell_destroy + +end module PetscImsPreconditionerModule diff --git a/src/Solution/PETSc/PetscSolver.F90 b/src/Solution/PETSc/PetscSolver.F90 index bec64d17b9c..fdfd83cbb25 100644 --- a/src/Solution/PETSc/PetscSolver.F90 +++ b/src/Solution/PETSc/PetscSolver.F90 @@ -2,12 +2,18 @@ module PetscSolverModule #include use petscksp use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: LINELENGTH use LinearSolverBaseModule use MatrixBaseModule use VectorBaseModule use PetscMatrixModule use PetscVectorModule use PetscConvergenceModule + use PetscImsPreconditionerModule + use ConvergenceSummaryModule + use ImsLinearSettingsModule + use SimVariablesModule, only: iout, simulation_mode + use SimModule, only: store_error implicit none private @@ -16,26 +22,37 @@ module PetscSolverModule type, public, extends(LinearSolverBaseType) :: PetscSolverType KSP :: ksp_petsc - class(PetscMatrixType), pointer :: matrix - Mat, pointer :: mat_petsc - Vec, pointer :: vec_residual + class(PetscMatrixType), pointer :: matrix => null() + Mat, pointer :: mat_petsc => null() + Vec, pointer :: vec_residual => null() - integer(I4B) :: lin_accel_type + logical(LGP) :: use_ims_pc !< when true, use custom IMS-style preconditioning real(DP) :: dvclose - class(PetscContextType), pointer :: petsc_ctx - integer(I4B) :: ctx_idx + integer(I4B) :: pc_levels + real(DP) :: drop_tolerance + KSPType :: ksp_type + PCType :: pc_type + PCType :: sub_pc_type + class(PetscContextType), pointer :: petsc_ctx => null() + type(PcShellCtxType), pointer :: pc_context => null() + type(ConvergenceSummaryType), pointer :: convergence_summary => null() + contains procedure :: initialize => petsc_initialize procedure :: solve => petsc_solve procedure :: get_result => petsc_get_result + procedure :: print_summary => petsc_print_summary procedure :: destroy => petsc_destroy procedure :: create_matrix => petsc_create_matrix ! private - procedure, private :: get_options + procedure, private :: get_options_mf6 procedure, private :: create_ksp procedure, private :: create_convergence_check + procedure, private :: set_petsc_pc + procedure, private :: set_ims_pc procedure, private :: print_vec + procedure, private :: print_petsc_version end type PetscSolverType contains @@ -56,11 +73,19 @@ end function create_petsc_solver !> @brief Initialize PETSc KSP solver with !< options from the petsc database file - subroutine petsc_initialize(this, matrix) + subroutine petsc_initialize(this, matrix, linear_settings, convergence_summary) class(PetscSolverType) :: this !< This solver instance class(MatrixBaseType), pointer :: matrix !< The solution matrix as KSP operator + type(ImsLinearSettingsType), pointer :: linear_settings !< the settings for the linear solver from the .ims file + type(ConvergenceSummaryType), pointer :: convergence_summary !< a convergence record for diagnostics ! local PetscErrorCode :: ierr + character(len=LINELENGTH) :: errmsg + + this%use_ims_pc = .false. + allocate (this%pc_context) + + call this%print_petsc_version() this%mat_petsc => null() select type (pm => matrix) @@ -73,36 +98,85 @@ subroutine petsc_initialize(this, matrix) call MatCreateVecs(this%mat_petsc, this%vec_residual, PETSC_NULL_VEC, ierr) CHKERRQ(ierr) - ! get options from PETSc database file - call this%get_options() + ! configure from IMS settings + this%dvclose = linear_settings%dvclose + this%nitermax = linear_settings%iter1 + + if (linear_settings%ilinmeth == 1) then + this%ksp_type = KSPCG + else if (linear_settings%ilinmeth == 2) then + this%ksp_type = KSPBCGS + else + write (errmsg, '(a)') 'PETSc: unknown linear solver method.' + call store_error(errmsg) + end if + + if (simulation_mode == "PARALLEL") then + this%pc_type = PCBJACOBI + this%sub_pc_type = PCILU + else + this%pc_type = PCILU + this%sub_pc_type = PCNONE + end if + this%pc_levels = linear_settings%level + this%drop_tolerance = linear_settings%droptol + + ! get MODFLOW options from PETSc database file + call this%get_options_mf6() ! create the solver object call this%create_ksp() ! Create custom convergence check - call this%create_convergence_check() + call this%create_convergence_check(convergence_summary) end subroutine petsc_initialize - !> @brief Get the PETSc options from the database + !> @brief Print PETSc version string from shared lib !< - subroutine get_options(this) + subroutine print_petsc_version(this) + class(PetscSolverType) :: this + ! local + PetscErrorCode :: ierr + PetscInt :: major, minor, subminor, release + character(len=128) :: petsc_version, release_str + + call PetscGetVersionNumber(major, minor, subminor, release, ierr) + CHKERRQ(ierr) + + if (release == 1) then + release_str = "(release)" + else + release_str = "(unofficial)" + end if + write (petsc_version, '(i0,a,i0,a,i0,a,a)') & + major, ".", minor, ".", subminor, " ", trim(release_str) + write (iout, '(/,1x,2a,/)') & + "PETSc Linear Solver will be used: version ", petsc_version + + end subroutine print_petsc_version + + !> @brief Get the MODFLOW specific options from the PETSc database + !< + subroutine get_options_mf6(this) class(PetscSolverType) :: this ! local PetscErrorCode :: ierr logical(LGP) :: found - this%dvclose = 0.01_DP call PetscOptionsGetReal(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, & '-dvclose', this%dvclose, found, ierr) CHKERRQ(ierr) - this%nitermax = 100 call PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, & '-nitermax', this%nitermax, found, ierr) CHKERRQ(ierr) - end subroutine get_options + call PetscOptionsGetBool(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, & + '-ims_pc', this%use_ims_pc, found, ierr) + CHKERRQ(ierr) + + end subroutine get_options_mf6 !> @brief Create the PETSc KSP object !< @@ -114,49 +188,159 @@ subroutine create_ksp(this) call KSPCreate(PETSC_COMM_WORLD, this%ksp_petsc, ierr) CHKERRQ(ierr) + call KSPSetOperators(this%ksp_petsc, this%mat_petsc, this%mat_petsc, ierr) + CHKERRQ(ierr) + call KSPSetInitialGuessNonzero(this%ksp_petsc, .true., ierr) CHKERRQ(ierr) - call KSPSetFromOptions(this%ksp_petsc, ierr) + call KSPSetType(this%ksp_petsc, this%ksp_type, ierr) CHKERRQ(ierr) - call KSPSetOperators(this%ksp_petsc, this%mat_petsc, this%mat_petsc, ierr) + if (this%use_ims_pc) then + call this%set_ims_pc() + else + call this%set_petsc_pc() + end if + + ! finally override these options from the + ! optional .petscrc file + call KSPSetFromOptions(this%ksp_petsc, ierr) CHKERRQ(ierr) end subroutine create_ksp + !> @brief Set up a standard PETSc preconditioner from + !< the configured settings + subroutine set_petsc_pc(this) + class(PetscSolverType) :: this !< This solver instance + ! local + PC :: pc, sub_pc + KSP, dimension(1) :: sub_ksp + PetscInt :: n_local, n_first + PetscErrorCode :: ierr + + call KSPGetPC(this%ksp_petsc, pc, ierr) + CHKERRQ(ierr) + + call PCSetType(pc, this%pc_type, ierr) + CHKERRQ(ierr) + + call PCSetFromOptions(pc, ierr) + CHKERRQ(ierr) + + call PCSetUp(pc, ierr) + CHKERRQ(ierr) + + if (simulation_mode == "PARALLEL") then + call PCBJacobiGetSubKSP(pc, n_local, n_first, sub_ksp, ierr) + CHKERRQ(ierr) + call KSPGetPC(sub_ksp(1), sub_pc, ierr) + CHKERRQ(ierr) + call PCSetType(sub_pc, this%sub_pc_type, ierr) + CHKERRQ(ierr) + call PCFactorSetLevels(sub_pc, this%pc_levels, ierr) + CHKERRQ(ierr) + else + call PCFactorSetLevels(pc, this%pc_levels, ierr) + CHKERRQ(ierr) + end if + + end subroutine set_petsc_pc + + !> @brief Set up a custom preconditioner following the ones + !< we have in IMS, i.e. Modified ILU(T) + subroutine set_ims_pc(this) + class(PetscSolverType) :: this !< This solver instance + ! local + PC :: pc, sub_pc + KSP, dimension(1) :: sub_ksp + PetscInt :: n_local, n_first + PetscErrorCode :: ierr + + if (simulation_mode == "PARALLEL") then + this%sub_pc_type = PCSHELL + + call KSPGetPC(this%ksp_petsc, pc, ierr) + CHKERRQ(ierr) + call PCSetType(pc, this%pc_type, ierr) + CHKERRQ(ierr) + call PCSetUp(pc, ierr) + CHKERRQ(ierr) + call PCBJacobiGetSubKSP(pc, n_local, n_first, sub_ksp, ierr) + CHKERRQ(ierr) + call KSPGetPC(sub_ksp(1), sub_pc, ierr) + CHKERRQ(ierr) + call PCSetType(sub_pc, this%sub_pc_type, ierr) + CHKERRQ(ierr) + call PCShellSetApply(sub_pc, pcshell_apply, ierr) + CHKERRQ(ierr) + call PCShellSetSetUp(sub_pc, pcshell_setup, ierr) + CHKERRQ(ierr) + call PCShellSetDestroy(sub_pc, pcshell_destroy, ierr) + CHKERRQ(ierr) + call PCShellSetContext(sub_pc, this%pc_context, ierr) + CHKERRQ(ierr) + else + this%pc_type = PCSHELL + + call KSPGetPC(this%ksp_petsc, pc, ierr) + CHKERRQ(ierr) + call PCSetType(pc, PCSHELL, ierr) + CHKERRQ(ierr) + call PCShellSetApply(pc, pcshell_apply, ierr) + CHKERRQ(ierr) + call PCShellSetSetUp(pc, pcshell_setup, ierr) + CHKERRQ(ierr) + call PCShellSetDestroy(pc, pcshell_destroy, ierr) + CHKERRQ(ierr) + call PCShellSetContext(pc, this%pc_context, ierr) + CHKERRQ(ierr) + end if + + end subroutine set_ims_pc + !> @brief Create and assign a custom convergence !< check for this solver - subroutine create_convergence_check(this) + subroutine create_convergence_check(this, convergence_summary) class(PetscSolverType) :: this !< This solver instance + type(ConvergenceSummaryType), pointer :: convergence_summary ! local PetscErrorCode :: ierr this%petsc_ctx%dvclose = this%dvclose this%petsc_ctx%max_its = this%nitermax + this%petsc_ctx%cnvg_summary => convergence_summary call MatCreateVecs( & this%mat_petsc, this%petsc_ctx%x_old, PETSC_NULL_VEC, ierr) CHKERRQ(ierr) call MatCreateVecs( & this%mat_petsc, this%petsc_ctx%delta_x, PETSC_NULL_VEC, ierr) CHKERRQ(ierr) - call petsc_add_context(this%petsc_ctx, this%ctx_idx) + call MatCreateVecs( & + this%mat_petsc, this%petsc_ctx%res_old, PETSC_NULL_VEC, ierr) + CHKERRQ(ierr) + call MatCreateVecs( & + this%mat_petsc, this%petsc_ctx%delta_res, PETSC_NULL_VEC, ierr) + CHKERRQ(ierr) call KSPSetConvergenceTest(this%ksp_petsc, petsc_check_convergence, & - this%ctx_idx, PETSC_NULL_FUNCTION, ierr) + this%petsc_ctx, PETSC_NULL_FUNCTION, ierr) CHKERRQ(ierr) end subroutine create_convergence_check - subroutine petsc_solve(this, kiter, rhs, x) + subroutine petsc_solve(this, kiter, rhs, x, cnvg_summary) class(PetscSolverType) :: this integer(I4B) :: kiter class(VectorBaseType), pointer :: rhs class(VectorBaseType), pointer :: x + type(ConvergenceSummaryType) :: cnvg_summary ! local PetscErrorCode :: ierr class(PetscVectorType), pointer :: rhs_petsc, x_petsc KSPConvergedReason :: icnvg + integer :: it_number rhs_petsc => null() select type (rhs) @@ -172,13 +356,17 @@ subroutine petsc_solve(this, kiter, rhs, x) this%iteration_number = 0 this%is_converged = 0 + if (kiter == 1) then + this%petsc_ctx%cnvg_summary%iter_cnt = 0 + end if ! update matrix coefficients call this%matrix%update() call KSPSolve(this%ksp_petsc, rhs_petsc%vec_impl, x_petsc%vec_impl, ierr) CHKERRQ(ierr) - call KSPGetIterationNumber(this%ksp_petsc, this%iteration_number, ierr) + call KSPGetIterationNumber(this%ksp_petsc, it_number, ierr) + this%iteration_number = it_number call KSPGetConvergedReason(this%ksp_petsc, icnvg, ierr) if (icnvg > 0) this%is_converged = 1 @@ -188,6 +376,35 @@ subroutine petsc_get_result(this) class(PetscSolverType) :: this end subroutine petsc_get_result + subroutine petsc_print_summary(this) + class(PetscSolverType) :: this + ! local + character(len=128) :: ksp_type, pc_type, dvclose_str + integer :: ierr + PC :: pc + + call KSPGetType(this%ksp_petsc, ksp_type, ierr) + CHKERRQ(ierr) + call KSPGetPC(this%ksp_petsc, pc, ierr) + CHKERRQ(ierr) + call PCGetType(pc, pc_type, ierr) + CHKERRQ(ierr) + write (dvclose_str, '(e15.5)') this%dvclose + + write (iout, '(/,7x,a)') "PETSc linear solver settings: " + write (iout, '(1x,a)') repeat('-', 66) + write (iout, '(1x,a,a)') "Linear acceleration method: ", trim(this%ksp_type) + write (iout, '(1x,a,a)') "Preconditioner type: ", trim(this%pc_type) + if (simulation_mode == "PARALLEL") then + write (iout, '(1x,a,a)') "Sub-preconditioner type: ", & + trim(this%sub_pc_type) + end if + write (iout, '(1x,a,i0)') "Maximum nr. of iterations: ", this%nitermax + write (iout, '(1x,a,a,/)') & + "Dep. var. closure criterion: ", trim(adjustl(dvclose_str)) + + end subroutine petsc_print_summary + subroutine petsc_destroy(this) class(PetscSolverType) :: this ! local @@ -202,12 +419,11 @@ subroutine petsc_destroy(this) deallocate (this%vec_residual) ! delete context - call VecDestroy(this%petsc_ctx%delta_x, ierr) - CHKERRQ(ierr) - call VecDestroy(this%petsc_ctx%x_old, ierr) - CHKERRQ(ierr) + call this%petsc_ctx%destroy() deallocate (this%petsc_ctx) + deallocate (this%pc_context) + end subroutine petsc_destroy function petsc_create_matrix(this) result(matrix) diff --git a/src/Solution/ParallelSolution.f90 b/src/Solution/ParallelSolution.f90 index b97bbf45132..687755e71ae 100644 --- a/src/Solution/ParallelSolution.f90 +++ b/src/Solution/ParallelSolution.f90 @@ -1,6 +1,6 @@ module ParallelSolutionModule use KindModule, only: DP, LGP, I4B - use ConstantsModule, only: DONE, DZERO + use ConstantsModule, only: LENPAKLOC, DONE, DZERO use NumericalSolutionModule, only: NumericalSolutionType use mpi use MpiWorldModule @@ -13,8 +13,13 @@ module ParallelSolutionModule contains ! override procedure :: sln_has_converged => par_has_converged + procedure :: sln_package_convergence => par_package_convergence + procedure :: sln_sync_newtonur_flag => par_sync_newtonur_flag + procedure :: sln_nur_has_converged => par_nur_has_converged procedure :: sln_calc_ptc => par_calc_ptc procedure :: sln_underrelax => par_underrelax + procedure :: sln_backtracking_xupdate => par_backtracking_xupdate + end type ParallelSolutionType contains @@ -44,6 +49,69 @@ function par_has_converged(this, max_dvc) result(has_converged) end function par_has_converged + function par_package_convergence(this, dpak, cpakout, iend) & + result(icnvg_global) + class(ParallelSolutionType) :: this !< parallel solution instance + real(DP), intent(in) :: dpak !< Newton Under-relaxation flag + character(len=LENPAKLOC), intent(in) :: cpakout + integer(I4B), intent(in) :: iend + ! local + integer(I4B) :: icnvg_global + integer(I4B) :: icnvg_local + integer :: ierr + type(MpiWorldType), pointer :: mpi_world + + mpi_world => get_mpi_world() + + icnvg_local = & + this%NumericalSolutionType%sln_package_convergence(dpak, cpakout, iend) + + call MPI_Allreduce(icnvg_local, icnvg_global, 1, MPI_INTEGER, & + MPI_MIN, mpi_world%comm, ierr) + + end function par_package_convergence + + function par_sync_newtonur_flag(this, inewtonur) result(ivalue) + class(ParallelSolutionType) :: this !< parallel solution instance + integer(I4B), intent(in) :: inewtonur !< local Newton Under-relaxation flag + ! local + integer(I4B) :: ivalue !< Maximum of all local values (1 = under-relaxation applied) + integer :: ierr + type(MpiWorldType), pointer :: mpi_world + + mpi_world => get_mpi_world() + call MPI_Allreduce(inewtonur, ivalue, 1, MPI_INTEGER, & + MPI_MAX, mpi_world%comm, ierr) + + end function par_sync_newtonur_flag + + function par_nur_has_converged(this, dxold_max, hncg) & + result(has_converged) + class(ParallelSolutionType) :: this !< parallel solution instance + real(DP), intent(in) :: dxold_max !< the maximum dependent variable change for cells not adjusted by NUR + real(DP), intent(in) :: hncg !< largest dep. var. change at end of Picard iter. + logical(LGP) :: has_converged !< True, when converged + ! local + integer(I4B) :: icnvg_local + integer(I4B) :: icnvg_global + integer :: ierr + type(MpiWorldType), pointer :: mpi_world + + mpi_world => get_mpi_world() + + has_converged = .false. + icnvg_local = 0 + if (this%NumericalSolutionType%sln_nur_has_converged( & + dxold_max, hncg)) then + icnvg_local = 1 + end if + + call MPI_Allreduce(icnvg_local, icnvg_global, 1, MPI_INTEGER, & + MPI_MIN, mpi_world%comm, ierr) + if (icnvg_global == 1) has_converged = .true. + + end function par_nur_has_converged + !> @brief Calculate pseudo-transient continuation factor !< for the parallel case subroutine par_calc_ptc(this, iptc, ptcf) @@ -106,4 +174,25 @@ subroutine par_underrelax(this, kiter, bigch, neq, active, x, xtemp) end subroutine par_underrelax + !> @brief synchronize backtracking flag over processes + !< + subroutine par_backtracking_xupdate(this, btflag) + ! -- dummy variables + class(ParallelSolutionType), intent(inout) :: this !< ParallelSolutionType instance + integer(I4B), intent(inout) :: btflag !< global backtracking flag (1) backtracking performed (0) backtracking not performed + ! -- local variables + integer(I4B) :: btflag_local + type(MpiWorldType), pointer :: mpi_world + integer :: ierr + + mpi_world => get_mpi_world() + + btflag_local = 0 + call this%NumericalSolutionType%sln_backtracking_xupdate(btflag_local) + + call MPI_Allreduce(btflag_local, btflag, 1, MPI_INTEGER, & + MPI_MAX, mpi_world%comm, ierr) + + end subroutine par_backtracking_xupdate + end module ParallelSolutionModule diff --git a/src/Timing/tdis.f90 b/src/Timing/tdis.f90 index b1dee473e7a..0aa32fc93bb 100644 --- a/src/Timing/tdis.f90 +++ b/src/Timing/tdis.f90 @@ -5,7 +5,7 @@ module TdisModule use KindModule, only: DP, I4B, LGP - use SimVariablesModule, only: iout + use SimVariablesModule, only: iout, isim_level use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, LENDATETIME, VALL ! @@ -45,13 +45,9 @@ module TdisModule contains + !> @brief Create temporal discretization + !< subroutine tdis_cr(fname) -! ****************************************************************************** -! tdis_cr -- create temporal discretization. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use InputOutputModule, only: getunit, openfile use ConstantsModule, only: LINELENGTH, DZERO @@ -64,7 +60,6 @@ subroutine tdis_cr(fname) character(len=*), parameter :: fmtheader = & "(1X,/1X,'TDIS -- TEMPORAL DISCRETIZATION PACKAGE,', / & &' VERSION 1 : 11/13/2014 - INPUT READ FROM UNIT ',I4)" -! ------------------------------------------------------------------------------ ! ! -- Allocate the scalar variables call tdis_allocate_scalars() @@ -99,21 +94,17 @@ subroutine tdis_cr(fname) call ats_cr(inats, nper) end if ! - ! -- return + ! -- Return return end subroutine tdis_cr + !> @brief Set kstp and kper + !< subroutine tdis_set_counters() -! ****************************************************************************** -! tdis_set_counters -- Set kstp and kper -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE, DZERO, MNORMAL, MVALIDATE, DNODATA use SimVariablesModule, only: isim_mode - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use AdaptiveTimeStepModule, only: isAdaptivePeriod, dtstable, & ats_period_message ! -- local @@ -126,12 +117,11 @@ subroutine tdis_set_counters() character(len=*), parameter :: fmtvspts = & &"(' Validating: Stress period: ',i5,4x,'Time step: ',i5,4x)" character(len=*), parameter :: fmtspi = & - "('1',/28X,'STRESS PERIOD NO. ',I0,', LENGTH =',G15.7,/ & - &28X,47('-'))" + "('1',/1X,'STRESS PERIOD NO. ',I0,', LENGTH =',G15.7,/ & + &1X,42('-'))" character(len=*), parameter :: fmtspits = & - "(28X,'NUMBER OF TIME STEPS = ',I0,/ & - &28X,'MULTIPLIER FOR DELT =',F10.3)" -! ------------------------------------------------------------------------------ + "(1X,'NUMBER OF TIME STEPS = ',I0,/ & + &1X,'MULTIPLIER FOR DELT =',F10.3)" ! ! -- Initialize variables for this step if (inats > 0) dtstable = DNODATA @@ -155,8 +145,9 @@ subroutine tdis_set_counters() case (MNORMAL) write (line, fmtspts) cpref, kper, kstp, trim(cend) end select - call sim_message(line, level=VALL) - call sim_message(line, iunit=iout, skipbefore=1, skipafter=1) + if (isim_level >= VALL) & + call write_message(line) + call write_message(line, iunit=iout, skipbefore=1, skipafter=1) ! ! -- Write message if first time step if (kstp == 1) then @@ -168,17 +159,13 @@ subroutine tdis_set_counters() end if end if ! - ! -- return + ! -- Return return end subroutine tdis_set_counters + !> @brief Set time step length + !< subroutine tdis_set_timestep() -! ****************************************************************************** -! tdis_set_timestep -- Set time step length -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE, DZERO use AdaptiveTimeStepModule, only: isAdaptivePeriod, & @@ -188,8 +175,7 @@ subroutine tdis_set_timestep() logical(LGP) :: adaptivePeriod ! -- format character(len=*), parameter :: fmttsi = & - "(28X,'INITIAL TIME STEP SIZE =',G15.7)" -! ------------------------------------------------------------------------------ + "(1X,'INITIAL TIME STEP SIZE =',G15.7)" ! ! -- Initialize adaptivePeriod = isAdaptivePeriod(kper) @@ -233,19 +219,16 @@ subroutine tdis_set_timestep() endofsimulation = .true. end if ! - ! -- return + ! -- Return return end subroutine tdis_set_timestep + !> @brief Reset delt and update timing variables and indicators + !! + !! This routine is called when a timestep fails to converge, and so it is + !! retried using a smaller time step (deltnew). + !< subroutine tdis_delt_reset(deltnew) -! ****************************************************************************** -! tdis_delt_reset -- reset delt and update timing variables and indicators. -! This routine is called when a timestep fails to converge, and so it is -! retried using a smaller time step (deltnew). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE, DZERO use AdaptiveTimeStepModule, only: isAdaptivePeriod, & @@ -255,7 +238,6 @@ subroutine tdis_delt_reset(deltnew) real(DP), intent(in) :: deltnew ! -- local logical(LGP) :: adaptivePeriod -! ------------------------------------------------------------------------------ ! ! -- Set values adaptivePeriod = isAdaptivePeriod(kper) @@ -279,21 +261,15 @@ subroutine tdis_delt_reset(deltnew) totim = totalsimtime end if ! - ! -- return + ! -- Return return end subroutine tdis_delt_reset + !> @brief Set time step length + !< subroutine tdis_set_delt() -! ****************************************************************************** -! tdis_set_delt -- Set time step length -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: DONE - ! -- local -! ------------------------------------------------------------------------------ ! if (kstp == 1) then ! -- Calculate the first value of delt for this stress period @@ -313,7 +289,7 @@ subroutine tdis_set_delt() delt = tsmult(kper) * delt end if ! - ! -- return + ! -- Return return end subroutine tdis_set_delt @@ -373,96 +349,91 @@ end subroutine tdis_set_delt ! totim = totalsimtime ! end if ! ! -! ! -- return +! ! -- Return ! return ! end subroutine tdis_set_delt_std + !> @brief Print simulation time + !< subroutine tdis_ot(iout) -! ****************************************************************************** -! PRINT SIMULATION TIME -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: DZERO, DONE, DSIXTY, DSECPERHR, DHRPERDAY, & + DDYPERYR, DSECPERDY, DSECPERYR ! -- dummy integer(I4B), intent(in) :: iout ! -- local - real(DP) :: zero, cnv, delsec, totsec, persec, sixty, hrday, dayyr, & - delmn, delhr, totmn, tothr, totdy, totyr, permn, perhr, & - perdy, peryr, deldy, delyr -! ------------------------------------------------------------------------------ - WRITE (IOUT, 199) KSTP, KPER -199 FORMAT(1X, ///9X, 'TIME SUMMARY AT END OF TIME STEP', I5, & - & ' IN STRESS PERIOD ', I4) -!C -!C1------USE TIME UNIT INDICATOR TO GET FACTOR TO CONVERT TO SECONDS. - ZERO = 0.d0 - CNV = ZERO - IF (ITMUNI .EQ. 1) CNV = 1. - IF (ITMUNI .EQ. 2) CNV = 60. - IF (ITMUNI .EQ. 3) CNV = 3600. - IF (ITMUNI .EQ. 4) CNV = 86400. - IF (ITMUNI .EQ. 5) CNV = 31557600. -!C -!C2------IF FACTOR=0 THEN TIME UNITS ARE NON-STANDARD. - IF (CNV .NE. ZERO) GO TO 100 -!C -!C2A-----PRINT TIMES IN NON-STANDARD TIME UNITS. - WRITE (IOUT, 301) DELT, PERTIM, TOTIM -301 FORMAT(21X, ' TIME STEP LENGTH =', G15.6 / & - & 21X, ' STRESS PERIOD TIME =', G15.6 / & - & 21X, 'TOTAL SIMULATION TIME =', G15.6) -!C -!C2B-----RETURN - RETURN -!C -!C3------CALCULATE LENGTH OF TIME STEP & ELAPSED TIMES IN SECONDS. -100 DELSEC = CNV * DELT - TOTSEC = CNV * TOTIM - PERSEC = CNV * PERTIM -!C -!C4------CALCULATE TIMES IN MINUTES,HOURS,DAYS AND YEARS. - SIXTY = 60. - HRDAY = 24. - DAYYR = 365.25 - DELMN = DELSEC / SIXTY - DELHR = DELMN / SIXTY - DELDY = DELHR / HRDAY - DELYR = DELDY / DAYYR - TOTMN = TOTSEC / SIXTY - TOTHR = TOTMN / SIXTY - TOTDY = TOTHR / HRDAY - TOTYR = TOTDY / DAYYR - PERMN = PERSEC / SIXTY - PERHR = PERMN / SIXTY - PERDY = PERHR / HRDAY - PERYR = PERDY / DAYYR -!C -!C5------PRINT TIME STEP LENGTH AND ELAPSED TIMES IN ALL TIME UNITS. - WRITE (IOUT, 200) -200 FORMAT(19X, ' SECONDS MINUTES HOURS', 7X, & - & 'DAYS YEARS'/20X, 59('-')) - write (IOUT, 201) DELSEC, DELMN, DELHR, DELDY, DELYR -201 FORMAT(1X, ' TIME STEP LENGTH', 1P, 5G12.5) - WRITE (IOUT, 202) PERSEC, PERMN, PERHR, PERDY, PERYR -202 FORMAT(1X, 'STRESS PERIOD TIME', 1P, 5G12.5) - WRITE (IOUT, 203) TOTSEC, TOTMN, TOTHR, TOTDY, TOTYR -203 FORMAT(1X, ' TOTAL TIME', 1P, 5G12.5,/) -!C -!C6------RETURN - RETURN - END subroutine tdis_ot + real(DP) :: cnv, delsec, totsec, persec, delmn, delhr, totmn, tothr, & + totdy, totyr, permn, perhr, perdy, peryr, deldy, delyr + ! -- format + character(len=*), parameter :: fmttmsmry = "(1X, ///9X, & + &'TIME SUMMARY AT END OF TIME STEP', I5,' IN STRESS PERIOD ', I4)" + character(len=*), parameter :: fmttmstpmsg = & + &"(21X, ' TIME STEP LENGTH =', G15.6 / & + & 21X, ' STRESS PERIOD TIME =', G15.6 / & + & 21X, 'TOTAL SIMULATION TIME =', G15.6)" + character(len=*), parameter :: fmttottmmsg = & + &"(19X, ' SECONDS MINUTES HOURS', 7X, & + &'DAYS YEARS'/20X, 59('-'))" + character(len=*), parameter :: fmtdelttm = & + &"(1X, ' TIME STEP LENGTH', 1P, 5G12.5)" + character(len=*), parameter :: fmtpertm = & + &"(1X, 'STRESS PERIOD TIME', 1P, 5G12.5)" + character(len=*), parameter :: fmttottm = & + &"(1X, ' TOTAL TIME', 1P, 5G12.5,/)" + ! + ! -- Write header message for the information that follows + write (iout, fmttmsmry) kstp, kper + ! + ! -- Use time unit indicator to get factor to convert to seconds + cnv = DZERO + if (itmuni == 1) cnv = DONE + if (itmuni == 2) cnv = DSIXTY + if (itmuni == 3) cnv = DSECPERHR + if (itmuni == 4) cnv = DSECPERDY + if (itmuni == 5) cnv = DSECPERYR + ! + ! -- If FACTOR=0 then time units are non-standard + if (cnv == DZERO) then + ! -- Print times in non-standard time units + write (iout, fmttmstpmsg) delt, pertim, totim + else + ! -- Calculate length of time step & elapsed time in seconds + delsec = cnv * delt + totsec = cnv * totim + persec = cnv * pertim + ! + ! -- Calculate times in minutes, hours, days, and years + delmn = delsec / DSIXTY + delhr = delmn / DSIXTY + deldy = delhr / DHRPERDAY + delyr = deldy / DDYPERYR + totmn = totsec / DSIXTY + tothr = totmn / DSIXTY + totdy = tothr / DHRPERDAY + totyr = totdy / DDYPERYR + permn = persec / DSIXTY + perhr = permn / DSIXTY + perdy = perhr / DHRPERDAY + peryr = perdy / DDYPERYR + ! + ! -- Print time step length and elapsed times in all time units + write (iout, fmttottmmsg) + write (iout, fmtdelttm) delsec, delmn, delhr, deldy, delyr + write (iout, fmtpertm) persec, permn, perhr, perdy, peryr + write (iout, fmttottm) totsec, totmn, tothr, totdy, totyr + end if + ! + ! -- Return + return + end subroutine tdis_ot + !> @brief Deallocate memory + !< subroutine tdis_da() -! ****************************************************************************** -! tdis_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use MemoryManagerModule, only: mem_deallocate use AdaptiveTimeStepModule, only: ats_da -! ------------------------------------------------------------------------------ + ! ! -- ats if (inats > 0) call ats_da() ! @@ -497,17 +468,13 @@ subroutine tdis_da() return end subroutine tdis_da + !> @brief Read the timing discretization options + !< subroutine tdis_read_options() -! ****************************************************************************** -! tdis_read_options -- Read the options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error use InputOutputModule, only: GetUnit, openfile - ! -- dummy ! -- local character(len=LINELENGTH) :: errmsg, keyword, fname integer(I4B) :: ierr @@ -519,7 +486,6 @@ subroutine tdis_read_options() character(len=*), parameter :: fmtdatetime0 = & &"(4x,'SIMULATION STARTING DATE AND TIME IS ',A)" !data -! ------------------------------------------------------------------------------ ! ! -- set variables itmuni = 0 @@ -599,17 +565,12 @@ subroutine tdis_read_options() return end subroutine tdis_read_options + !> @brief Read dimension NPER + !< subroutine tdis_allocate_scalars() -! ****************************************************************************** -! tdis_read_dimensions -- Read dimension NPER -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate use ConstantsModule, only: DZERO -! ------------------------------------------------------------------------------ ! ! -- memory manager variables call mem_allocate(nper, 'NPER', 'TDIS') @@ -653,39 +614,30 @@ subroutine tdis_allocate_scalars() totalsimtime = DZERO datetime0 = '' ! - ! -- return + ! -- Return return end subroutine tdis_allocate_scalars + !> @brief Allocate tdis arrays + !< subroutine tdis_allocate_arrays() -! ****************************************************************************** -! tdis_allocate_arrays -- Allocate tdis arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate -! ------------------------------------------------------------------------------ ! call mem_allocate(perlen, nper, 'PERLEN', 'TDIS') call mem_allocate(nstp, nper, 'NSTP', 'TDIS') call mem_allocate(tsmult, nper, 'TSMULT', 'TDIS') ! - ! -- return + ! -- Return return end subroutine tdis_allocate_arrays + !> @brief Read dimension NPER + !< subroutine tdis_read_dimensions() -! ****************************************************************************** -! tdis_read_dimensions -- Read dimension NPER -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: LINELENGTH use SimModule, only: store_error - ! -- dummy ! -- local character(len=LINELENGTH) :: errmsg, keyword integer(I4B) :: ierr @@ -693,8 +645,6 @@ subroutine tdis_read_dimensions() ! -- formats character(len=*), parameter :: fmtnper = & "(1X,I4,' STRESS PERIOD(S) IN SIMULATION')" - !data -! ------------------------------------------------------------------------------ ! ! -- get DIMENSIONS block call parser%GetBlock('DIMENSIONS', isfound, ierr, & @@ -729,16 +679,12 @@ subroutine tdis_read_dimensions() return end subroutine tdis_read_dimensions + !> @brief Read timing information + !< subroutine tdis_read_timing() -! ****************************************************************************** -! tdis_read_timing -- Read timing information -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: LINELENGTH, DZERO use SimModule, only: store_error, count_errors - ! -- dummy ! -- local character(len=LINELENGTH) :: errmsg integer(I4B) :: ierr @@ -750,7 +696,6 @@ subroutine tdis_read_timing() &' MULTIPLIER FOR DELT',/1X,76('-'))" character(len=*), parameter :: fmtrow = & "(1X,I8,1PG21.7,I7,0PF25.3)" -! ------------------------------------------------------------------------------ ! ! -- get PERIODDATA block call parser%GetBlock('PERIODDATA', isfound, ierr, & @@ -788,16 +733,13 @@ subroutine tdis_read_timing() return end subroutine tdis_read_timing + !> @brief Check the tdis timing information + !! + !! Return back to tdis_read_timing if an error condition is found and let the + !! ustop routine be called there instead so the StoreErrorUnit routine can be + !! called to assign the correct file name. + !< subroutine check_tdis_timing(nper, perlen, nstp, tsmult) -! ****************************************************************************** -! check_tdis_timing -- Check the tdis timing information. Return back to -! tdis_read_timing if an error condition is found and let the ustop -! routine be called there instead so the StoreErrorUnit routine can be -! called to assign the correct file name. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, DZERO, DONE use SimModule, only: store_error, count_errors @@ -819,7 +761,6 @@ subroutine check_tdis_timing(nper, perlen, nstp, tsmult) character(len=*), parameter :: fmtdterror = & "('Time step length of ', G0, ' is too small in period ', I0, & &' and time step ', I0)" -! ------------------------------------------------------------------------------ ! ! -- Initialize tstart = DZERO diff --git a/src/Utilities/ArrayHandlers.f90 b/src/Utilities/ArrayHandlers.f90 index 329917244d1..2b9c43bbf90 100644 --- a/src/Utilities/ArrayHandlers.f90 +++ b/src/Utilities/ArrayHandlers.f90 @@ -1,11 +1,11 @@ module ArrayHandlersModule use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, DTEN - use SimVariablesModule, only: iout - use GenericUtilitiesModule, only: sim_message, stop_with_error + implicit none private - public :: ExpandArray, ExpandArrayWrapper, ExtendPtrArray + public :: ExpandArray, ExpandArray2D, ExpandArrayWrapper, ExtendPtrArray public :: ConcatArray public :: ifind public :: remove_character @@ -19,10 +19,18 @@ module ArrayHandlersModule ! IMPORTANT: Do not use pointers to elements of arrays when using ! ExpandArray to increase the array size! The locations of array ! elements in memory are changed when ExpandArray is invoked. - module procedure expand_integer, expand_double, & - expand_character !, expand_real + module procedure expand_integer, expand_double, expand_logical, & + expand_character end interface ExpandArray + interface ExpandArray2D + ! This interface is for use with ALLOCATABLE arrays. + ! IMPORTANT: Do not use pointers to elements of arrays when using + ! ExpandArray2D to increase the array size! The locations of array + ! elements in memory are changed when ExpandArray2D is invoked. + module procedure expand_integer_2d, expand_double_2d + end interface ExpandArray2D + interface ExtendPtrArray ! This interface is for use with POINTERS to arrays. module procedure extend_double, extend_integer, & @@ -40,7 +48,6 @@ module ArrayHandlersModule contains subroutine expand_integer_wrapper(nsize, array, minvalue, loginc) - implicit none ! -- dummy integer(I4B), intent(in) :: nsize integer(I4B), allocatable, intent(inout) :: array(:) @@ -92,307 +99,378 @@ subroutine expand_integer_wrapper(nsize, array, minvalue, loginc) array(n) = 0 end do end if - ! - ! -- return - return + end subroutine expand_integer_wrapper ! -- Specific procedures that implement ExpandArray for allocatable arrays subroutine expand_integer(array, increment) - implicit none ! -- dummy integer(I4B), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment ! -- local - integer(I4B) :: inclocal, isize, newsize - integer(I4B), allocatable, dimension(:) :: array_temp - ! - ! -- initialize + integer(I4B) :: inc, lb, n + integer(I4B), allocatable, dimension(:) :: temp + + ! -- default to expanding by 1 if (present(increment)) then - inclocal = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inclocal = 1 + inc = 1 end if - ! - ! -- increase size of array by inclocal, retaining - ! contained data + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated if (allocated(array)) then - isize = size(array) - newsize = isize + inclocal - allocate (array_temp(newsize)) - array_temp(1:isize) = array + lb = lbound(array, 1) + n = size(array) + allocate (temp(lb:(lb + n + inc - 1))) + temp(lb:(lb + n - 1)) = array deallocate (array) - call move_alloc(array_temp, array) + call move_alloc(temp, array) else - allocate (array(inclocal)) + allocate (array(inc)) end if - ! - return end subroutine expand_integer subroutine expand_double(array, increment) - implicit none ! -- dummy real(DP), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment ! -- local - integer(I4B) :: inclocal, isize, newsize - real(DP), allocatable, dimension(:) :: array_temp - ! - ! -- initialize + integer(I4B) :: inc, lb, n + real(DP), allocatable, dimension(:) :: temp + + ! -- default to expanding by 1 if (present(increment)) then - inclocal = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inclocal = 1 + inc = 1 end if - ! - ! -- increase size of array by inclocal, retaining - ! contained data + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated if (allocated(array)) then - isize = size(array) - newsize = isize + inclocal - allocate (array_temp(newsize)) - array_temp(1:isize) = array + lb = lbound(array, 1) + n = size(array) + allocate (temp(lb:(lb + n + inc - 1))) + temp(lb:(lb + n - 1)) = array deallocate (array) - call move_alloc(array_temp, array) + call move_alloc(temp, array) else - allocate (array(inclocal)) + allocate (array(inc)) end if - ! - return + end subroutine expand_double + subroutine expand_logical(array, increment) + ! -- dummy + logical(LGP), allocatable, intent(inout) :: array(:) + integer(I4B), optional, intent(in) :: increment + ! -- local + integer(I4B) :: inc, lb, n + logical(LGP), allocatable, dimension(:) :: temp + + ! -- default to expanding by 1 + if (present(increment)) then + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") + else + inc = 1 + end if + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated + if (allocated(array)) then + lb = lbound(array, 1) + n = size(array) + allocate (temp(lb:(lb + n + inc - 1))) + temp(lb:(lb + n - 1)) = array + deallocate (array) + call move_alloc(temp, array) + else + allocate (array(inc)) + end if + + end subroutine expand_logical + subroutine expand_character(array, increment) - implicit none ! -- dummy character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line - character(len=MAXCHARLEN), allocatable, dimension(:) :: array_temp - integer(I4B) :: i, inclocal, isize, lenc, newsize - ! -- format - character(len=*), parameter :: stdfmt = "(/,'ERROR REPORT:',/,1x,a)" - ! + character(len=MAXCHARLEN), allocatable, dimension(:) :: temp + integer(I4B) :: i, inc, nold, nnew, lenc + ! -- check character length lenc = len(array) - if (lenc > MAXCHARLEN) then - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Need to increase MAXCHARLEN' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) - end if - ! - ! -- initialize + if (lenc > MAXCHARLEN) & + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Need to increase MAXCHARLEN. Stopping...') + + ! -- default to expanding by 1 if (present(increment)) then - inclocal = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inclocal = 1 + inc = 1 end if - ! - ! -- increase size of array by inclocal, retaining - ! contained data + + ! -- expand array to the requested size, keeping + ! existing items, or allocate if still needed ! [Ned TODO: may be able to use mold here, e.g.: ! allocate(values(num), mold=proto)] if (allocated(array)) then - isize = size(array) - newsize = isize + inclocal - allocate (array_temp(isize)) - do i = 1, isize - array_temp(i) = array(i) + nold = size(array) + nnew = nold + inc + allocate (temp(nold)) + do i = 1, nold + temp(i) = array(i) end do deallocate (array) - allocate (array(newsize)) - do i = 1, isize - array(i) = array_temp(i) + allocate (array(nnew)) + do i = 1, nold + array(i) = temp(i) end do - do i = isize + 1, newsize + do i = nold + 1, nnew array(i) = '' end do - deallocate (array_temp) + deallocate (temp) else - allocate (array(inclocal)) + allocate (array(inc)) end if - ! - return + end subroutine expand_character + ! -- Specific procedures that implement ExtendArray2D + + subroutine expand_integer_2d(array, increment1, increment2) + ! -- dummy + integer(I4B), allocatable, intent(inout) :: array(:, :) + integer(I4B), optional, intent(in) :: increment1 + integer(I4B), optional, intent(in) :: increment2 + ! -- local + integer(I4B) :: inc1, inc2, lb1, lb2, n1, n2 + integer(I4B), allocatable, dimension(:, :) :: temp + + ! -- default to expanding both dimensions by 1 + if (present(increment1)) then + inc1 = increment1 + else + inc1 = 1 + end if + if (present(increment2)) then + inc2 = increment2 + else + inc2 = 1 + end if + if (inc1 == 0 .and. inc2 == 0) return + if (inc1 < 0 .or. inc2 < 0) & + call pstop(1, "increments must be nonnegative") + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated + if (allocated(array)) then + lb1 = lbound(array, 1) + lb2 = lbound(array, 2) + n1 = size(array, 1) + n2 = size(array, 2) + allocate (temp( & + lb1:(lb1 + n1 + inc1 - 1), & + lb2:(lb2 + n2 + inc2 - 1))) + temp( & + lb1:(lb1 + n1 - 1), & + lb2:(lb2 + n2 - 1)) = array + deallocate (array) + call move_alloc(temp, array) + else + allocate (array(inc1, inc2)) + end if + + end subroutine expand_integer_2d + + subroutine expand_double_2d(array, increment1, increment2) + ! -- dummy + real(DP), allocatable, intent(inout) :: array(:, :) + integer(I4B), optional, intent(in) :: increment1 + integer(I4B), optional, intent(in) :: increment2 + ! -- local + integer(I4B) :: inc1, inc2, lb1, lb2, n1, n2 + real(DP), allocatable, dimension(:, :) :: temp + + ! -- default to expanding both dimensions by 1 + if (present(increment1)) then + inc1 = increment1 + else + inc1 = 1 + end if + if (present(increment2)) then + inc2 = increment2 + else + inc2 = 1 + end if + if (inc1 == 0 .and. inc2 == 0) return + if (inc1 < 0 .or. inc2 < 0) & + call pstop(1, "increments must be nonnegative") + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated + if (allocated(array)) then + lb1 = lbound(array, 1) + lb2 = lbound(array, 2) + n1 = size(array, 1) + n2 = size(array, 2) + allocate (temp( & + lb1:(lb1 + n1 + inc1 - 1), & + lb2:(lb2 + n2 + inc2 - 1))) + temp( & + lb1:(lb1 + n1 - 1), & + lb2:(lb2 + n2 - 1)) = array + deallocate (array) + call move_alloc(temp, array) + else + allocate (array(inc1, inc2)) + end if + + end subroutine expand_double_2d + ! -- Specific procedures that implement ExtendPtrArray for pointer arrays subroutine extend_double(array, increment) - implicit none ! -- dummy real(DP), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line character(len=100) :: ermsg - integer(I4B) :: i, inclocal, isize, istat, newsize - real(DP), dimension(:), pointer, contiguous :: array_temp => null() - ! -- format - character(len=*), parameter :: stdfmt = "(/,'ERROR REPORT:',/,1x,a)" - ! - ! -- initialize + integer(I4B) :: i, inc, lb, n, istat + real(DP), dimension(:), pointer, contiguous :: temp => null() + + ! -- default to expanding by 1 if (present(increment)) then - inclocal = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inclocal = 1 + inc = 1 end if - ! - ! -- increase size of array by inclocal, retaining - ! contained data + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated if (associated(array)) then - isize = size(array) - newsize = isize + inclocal - allocate (array_temp(newsize), stat=istat, errmsg=ermsg) - if (istat /= 0) goto 99 - do i = 1, isize - array_temp(i) = array(i) + lb = lbound(array, 1) + n = size(array) + allocate (temp(lb:(lb + n + inc - 1)), stat=istat, errmsg=ermsg) + if (istat /= 0) & + call pstop(138, 'Error in ArrayHandlersModule, '// & + 'could not increase array size:'//ermsg) + do i = lb, lb + n - 1 + temp(i) = array(i) end do deallocate (array) - array => array_temp + array => temp else - allocate (array(inclocal)) + allocate (array(inc)) end if - ! - ! -- normal return - return - ! - ! -- Error reporting -99 continue - - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Could not increase array size' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- error message - call sim_message(ermsg, iunit=iout) - call sim_message(ermsg) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) end subroutine extend_double subroutine extend_integer(array, increment) - implicit none ! -- dummy integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: array integer(I4B), optional, intent(in) :: increment ! -- local - character(len=LINELENGTH) :: line character(len=100) :: ermsg - integer(I4B) :: i, inclocal, isize, istat, newsize - integer(I4B), dimension(:), pointer, contiguous :: array_temp => null() - ! -- format - character(len=*), parameter :: stdfmt = "(/,'ERROR REPORT:',/,1x,a)" - ! - ! -- initialize + integer(I4B) :: i, inc, lb, n, istat + integer(I4B), dimension(:), pointer, contiguous :: temp => null() + + ! -- default to expanding by 1 if (present(increment)) then - inclocal = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inclocal = 1 + inc = 1 end if - ! - ! -- increase size of array by inclocal, retaining - ! contained data + + ! -- expand array to the requested size, keeping + ! existing items and the existing lower bound, + ! or allocate the array if still unallocated if (associated(array)) then - isize = size(array) - newsize = isize + inclocal - allocate (array_temp(newsize), stat=istat, errmsg=ermsg) - if (istat /= 0) goto 99 - do i = 1, isize - array_temp(i) = array(i) + lb = lbound(array, 1) + n = size(array) + allocate (temp(lb:(lb + n + inc - 1)), stat=istat, errmsg=ermsg) + if (istat /= 0) & + call pstop(138, 'Error in ArrayHandlersModule, '// & + 'could not increase array size:'//ermsg) + do i = lb, lb + n - 1 + temp(i) = array(i) end do deallocate (array) - array => array_temp + array => temp else - allocate (array(inclocal)) + allocate (array(inc)) end if - ! - ! -- normal return - return - ! - ! -- Error reporting -99 continue - - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Could not increase array size' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- error message - call sim_message(ermsg, iunit=iout) - call sim_message(ermsg) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) end subroutine extend_integer - !> @brief Grows or allocated the array with the passed increment, - !< the old value of the array pointer is rendered invalid subroutine extend_string(array, increment) + ! -- dummy character(len=*), dimension(:), pointer, contiguous :: array integer(I4B), optional :: increment - ! local - integer(I4B) :: inc_local - integer(I4B) :: i, old_size, new_size - character(len=len(array)), dimension(:), pointer, contiguous :: temp_array + ! -- local + integer(I4B) :: inc, i, n + character(len=len(array)), dimension(:), pointer, contiguous :: temp if (present(increment)) then - inc_local = increment + inc = increment + if (inc == 0) return + if (inc < 0) call pstop(1, "increment must be nonnegative") else - inc_local = 1 + inc = 1 end if if (associated(array)) then - old_size = size(array) - new_size = old_size + inc_local - temp_array => array - allocate (array(new_size)) - do i = 1, old_size - array(i) = temp_array(i) + n = size(array) + temp => array + allocate (array(n + inc)) + do i = 1, n + array(i) = temp(i) end do - deallocate (temp_array) + deallocate (temp) else - allocate (array(inc_local)) + allocate (array(inc)) end if end subroutine extend_string + !> @brief Concatenate integer arrays. subroutine concat_integer(array, array_to_add) integer(I4B), dimension(:), pointer, contiguous :: array integer(I4B), dimension(:), pointer, contiguous :: array_to_add ! local - integer(I4B) :: i, old_size + integer(I4B) :: i, n - old_size = size(array) + n = size(array) call ExtendPtrArray(array, increment=size(array_to_add)) do i = 1, size(array_to_add) - array(old_size + i) = array_to_add(i) + array(n + i) = array_to_add(i) end do - end subroutine concat_integer + !> @brief Find the 1st array element containing str, or -1 if not found. function ifind_character(array, str) - ! -- Find the first array element containing str - ! -- Return -1 if not found. - implicit none ! -- return integer(I4B) :: ifind_character ! -- dummy @@ -400,6 +478,7 @@ function ifind_character(array, str) character(len=*) :: str ! -- local integer(I4B) :: i + ifind_character = -1 findloop: do i = 1, size(array) if (array(i) == str) then @@ -407,13 +486,10 @@ function ifind_character(array, str) exit findloop end if end do findloop - return end function ifind_character + !> @brief Find the first element containing str, or -1 if not found. function ifind_integer(iarray, ival) - ! -- Find the first array element containing str - ! -- Return -1 if not found. - implicit none ! -- return integer(I4B) :: ifind_integer ! -- dummy @@ -421,6 +497,7 @@ function ifind_integer(iarray, ival) integer(I4B) :: ival ! -- local integer(I4B) :: i + ifind_integer = -1 findloop: do i = 1, size(iarray) if (iarray(i) == ival) then @@ -428,60 +505,44 @@ function ifind_integer(iarray, ival) exit findloop end if end do findloop - return end function ifind_integer + !> @brief Remove the element at ipos from the array. subroutine remove_character(array, ipos) - !remove the ipos position from array - implicit none ! -- dummy character(len=*), allocatable, intent(inout) :: array(:) integer(I4B), intent(in) :: ipos ! -- local - character(len=LINELENGTH) :: line - character(len=MAXCHARLEN), allocatable, dimension(:) :: array_temp - integer(I4B) :: i, isize, lenc, newsize, inew - ! -- format - character(len=*), parameter :: stdfmt = "(/,'ERROR REPORT:',/,1x,a)" - ! + character(len=MAXCHARLEN), allocatable, dimension(:) :: temp + integer(I4B) :: i, inew, n + ! -- check character length - lenc = len(array) - if (lenc > MAXCHARLEN) then + if (len(array) > MAXCHARLEN) & + call pstop(138, 'Error in ArrayHandlersModule: '// & + 'Need to increase MAXCHARLEN. Stopping...') - write (line, '(a)') 'Error in ArrayHandlersModule: '// & - 'Need to increase MAXCHARLEN' - call sim_message(line, iunit=iout, fmt=stdfmt) - call sim_message(line, fmt=stdfmt) - ! - ! -- stop message - write (line, '(a)') 'Stopping...' - call sim_message(line, iunit=iout) - call sim_message(line) - call stop_with_error(138) - end if - ! - ! -- calculate sizes - isize = size(array) - newsize = isize - 1 - ! - ! -- copy array to array_temp - allocate (array_temp(isize)) - do i = 1, isize - array_temp(i) = array(i) + ! -- calculate size + n = size(array) + + ! -- copy array to temp + allocate (temp(n)) + do i = 1, n + temp(i) = array(i) end do - ! + + ! -- de/reallocate and copy back to array, + ! omitting the specified element deallocate (array) - allocate (array(newsize)) + allocate (array(n - 1)) inew = 1 - do i = 1, isize + do i = 1, n if (i /= ipos) then - array(inew) = array_temp(i) + array(inew) = temp(i) inew = inew + 1 end if end do - deallocate (array_temp) - ! - return + deallocate (temp) + end subroutine remove_character end module ArrayHandlersModule diff --git a/src/Utilities/ArrayReaders.f90 b/src/Utilities/ArrayReaders.f90 index 537e0d47f50..32e49130faa 100644 --- a/src/Utilities/ArrayReaders.f90 +++ b/src/Utilities/ArrayReaders.f90 @@ -6,9 +6,10 @@ module ArrayReadersModule use InputOutputModule, only: openfile, u9rdcom, urword, ucolno, ulaprw, & BuildFixedFormat, BuildFloatFormat, & BuildIntFormat - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use OpenSpecModule, only: ACCESS, FORM use SimModule, only: store_error, store_error_unit + use SimVariablesModule, only: errmsg implicit none @@ -57,13 +58,14 @@ subroutine read_array_int1d(iu, iarr, aname, ndim, jj, iout, k) integer(I4B), intent(in) :: ndim ! dis%ndim integer(I4B), intent(in) :: k ! layer number; 0 to not print ! -- local + logical(LGP) :: isok integer(I4B) :: iclose, iconst, iprn, j, locat, ncpl, ndig integer(I4B) :: nval, nvalt logical :: prowcolnum character(len=100) :: prfmt integer(I4B) :: istat character(len=30) :: arrname - character(len=MAXCHARLEN) :: ermsg, ermsgr + character(len=MAXCHARLEN) :: ermsgr ! -- formats 2 format(/, 1x, a, ' = ', i0, ' FOR LAYER ', i0) 3 format(/, 1x, a, ' = ', i0) @@ -89,9 +91,9 @@ subroutine read_array_int1d(iu, iarr, aname, ndim, jj, iout, k) read (locat, *, iostat=istat, iomsg=ermsgr) (iarr(j), j=1, jj) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"//trim(arrname)// & + "'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if do j = 1, jj @@ -106,13 +108,15 @@ subroutine read_array_int1d(iu, iarr, aname, ndim, jj, iout, k) nvalt = 0 do call read_binary_header(locat, iout, aname, nval) + isok = check_binary_size(nval, nvalt, size(iarr), aname, locat) + if (isok .EQV. .FALSE.) exit read (locat, iostat=istat, iomsg=ermsgr) & (iarr(j), j=nvalt + 1, nvalt + nval) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"//trim(arrname)// & + "'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if nvalt = nvalt + nval @@ -150,13 +154,14 @@ subroutine read_array_int2d(iu, iarr, aname, ndim, jj, ii, iout, k) integer(I4B), intent(in) :: ndim ! dis%ndim integer(I4B), intent(in) :: k ! layer number; 0 to not print ! -- local + logical(LGP) :: isok integer(I4B) :: i, iclose, iconst, iprn, j, locat, ncpl, ndig integer(I4B) :: nval logical :: prowcolnum character(len=100) :: prfmt integer(I4B) :: istat character(len=30) :: arrname - character(len=MAXCHARLEN) :: ermsg, ermsgr + character(len=MAXCHARLEN) :: ermsgr ! -- formats 2 format(/, 1x, a, ' = ', i0, ' FOR LAYER ', i0) 3 format(/, 1x, a, ' = ', i0) @@ -185,9 +190,9 @@ subroutine read_array_int2d(iu, iarr, aname, ndim, jj, ii, iout, k) read (locat, *, iostat=istat, iomsg=ermsgr) (iarr(j, i), j=1, jj) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"//trim(arrname)// & + "'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if do j = 1, jj @@ -201,19 +206,22 @@ subroutine read_array_int2d(iu, iarr, aname, ndim, jj, ii, iout, k) ! -- Read data as binary locat = -locat call read_binary_header(locat, iout, aname, nval) - do i = 1, ii - read (locat, iostat=istat, iomsg=ermsgr) (iarr(j, i), j=1, jj) - if (istat /= 0) then - arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) - call store_error_unit(locat) - end if - do j = 1, jj - iarr(j, i) = iarr(j, i) * iconst + isok = check_binary_size(nval, 0, size(iarr), aname, locat) + if (isok) then + do i = 1, ii + read (locat, iostat=istat, iomsg=ermsgr) (iarr(j, i), j=1, jj) + if (istat /= 0) then + arrname = adjustl(aname) + errmsg = "Error reading data for array '"//trim(arrname)// & + "'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) + call store_error_unit(locat) + end if + do j = 1, jj + iarr(j, i) = iarr(j, i) * iconst + end do end do - end do + end if if (iclose == 1) then close (locat) end if @@ -310,6 +318,7 @@ subroutine read_array_dbl1d(iu, darr, aname, ndim, jj, iout, k) integer(I4B), intent(in) :: ndim ! dis%ndim integer(I4B), intent(in) :: k ! layer number; 0 to not print ! -- local + logical(LGP) :: isok integer(I4B) :: j, iclose, iprn, locat, ncpl, ndig real(DP) :: cnstnt logical :: prowcolnum @@ -317,7 +326,7 @@ subroutine read_array_dbl1d(iu, darr, aname, ndim, jj, iout, k) integer(I4B) :: istat integer(I4B) :: nvalt, nval character(len=30) :: arrname - character(len=MAXCHARLEN) :: ermsg, ermsgr + character(len=MAXCHARLEN) :: ermsgr ! -- formats 2 format(/, 1x, a, ' = ', g14.7, ' FOR LAYER ', i0) 3 format(/, 1x, a, ' = ', g14.7) @@ -343,9 +352,9 @@ subroutine read_array_dbl1d(iu, darr, aname, ndim, jj, iout, k) read (locat, *, iostat=istat, iomsg=ermsgr) (darr(j), j=1, jj) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"// & + trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if do j = 1, jj @@ -360,13 +369,15 @@ subroutine read_array_dbl1d(iu, darr, aname, ndim, jj, iout, k) nvalt = 0 do call read_binary_header(locat, iout, aname, nval) + isok = check_binary_size(nval, nvalt, size(darr), aname, locat) + if (isok .EQV. .FALSE.) exit read (locat, iostat=istat, iomsg=ermsgr) & (darr(j), j=nvalt + 1, nvalt + nval) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"// & + trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if nvalt = nvalt + nval @@ -404,6 +415,7 @@ subroutine read_array_dbl2d(iu, darr, aname, ndim, jj, ii, iout, k) integer(I4B), intent(in) :: ndim ! dis%ndim integer(I4B), intent(in) :: k ! layer number; 0 to not print ! -- local + logical(LGP) :: isok integer(I4B) :: i, iclose, iprn, j, locat, ncpl, ndig integer(I4B) :: nval real(DP) :: cnstnt @@ -411,7 +423,7 @@ subroutine read_array_dbl2d(iu, darr, aname, ndim, jj, ii, iout, k) character(len=100) :: prfmt integer(I4B) :: istat character(len=30) :: arrname - character(len=MAXCHARLEN) :: ermsg, ermsgr + character(len=MAXCHARLEN) :: ermsgr ! -- formats 2 format(/, 1x, a, ' = ', g14.7, ' FOR LAYER ', i0) 3 format(/, 1x, a, ' = ', g14.7) @@ -440,9 +452,9 @@ subroutine read_array_dbl2d(iu, darr, aname, ndim, jj, ii, iout, k) read (locat, *, iostat=istat, iomsg=ermsgr) (darr(j, i), j=1, jj) if (istat /= 0) then arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"// & + trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if do j = 1, jj @@ -456,19 +468,22 @@ subroutine read_array_dbl2d(iu, darr, aname, ndim, jj, ii, iout, k) ! -- Read data as binary locat = -locat call read_binary_header(locat, iout, aname, nval) - do i = 1, ii - read (locat, iostat=istat, iomsg=ermsgr) (darr(j, i), j=1, jj) - if (istat /= 0) then - arrname = adjustl(aname) - ermsg = 'Error reading data for array: '//trim(arrname) - call store_error(ermsg) - call store_error(ermsgr) - call store_error_unit(locat) - end if - do j = 1, jj - darr(j, i) = darr(j, i) * cnstnt + isok = check_binary_size(nval, 0, size(darr), aname, locat) + if (isok) then + do i = 1, ii + read (locat, iostat=istat, iomsg=ermsgr) (darr(j, i), j=1, jj) + if (istat /= 0) then + arrname = adjustl(aname) + errmsg = "Error reading data for array '"// & + trim(adjustl(arrname))//"'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) + call store_error_unit(locat) + end if + do j = 1, jj + darr(j, i) = darr(j, i) * cnstnt + end do end do - end do + end if if (iclose == 1) then close (locat) end if @@ -659,6 +674,7 @@ subroutine read_control_dbl(iu, iout, aname, locat, cnstnt, & end subroutine read_control_dbl subroutine read_control_1(iu, iout, aname, locat, iclose, line, icol, fname) + use SimModule, only: ustop ! -- Read CONSTANT, INTERNAL, or OPEN/CLOSE from array control record. ! -- dummy integer(I4B), intent(in) :: iu @@ -674,9 +690,9 @@ subroutine read_control_1(iu, iout, aname, locat, iclose, line, icol, fname) integer(I4B) :: istart, istop, n integer(I4B) :: ierr real(DP) :: r - character(len=MAXCHARLEN) :: ermsg ! - ! -- Read array control record. + ! -- Read array control record. Any future refactoring + ! should use the LongLineReader here instead of u9rdcom call u9rdcom(iu, iout, line, ierr) ! iclose = 0 @@ -693,12 +709,10 @@ subroutine read_control_1(iu, iout, aname, locat, iclose, line, icol, fname) locat = -1 iclose = 1 else - write (ermsg, *) 'ERROR READING CONTROL RECORD FOR '// & - trim(adjustl(aname)) - call store_error(ermsg) - call store_error(trim(adjustl(line))) - write (ermsg, *) 'Use CONSTANT, INTERNAL, or OPEN/CLOSE.' - call store_error(ermsg) + errmsg = 'READING CONTROL RECORD FOR '// & + trim(adjustl(aname))//"'. "// & + 'Use CONSTANT, INTERNAL, or OPEN/CLOSE.' + call store_error(errmsg) call store_error_unit(iu) end if ! @@ -718,7 +732,6 @@ subroutine read_control_2(iu, iout, fname, line, icol, & integer(I4B) :: i, n, istart, istop, lenkey real(DP) :: r character(len=MAXCHARLEN) :: keyword - character(len=LENBIGLINE) :: ermsg logical :: binary ! iprn = -1 ! Printing is turned off by default @@ -734,9 +747,9 @@ subroutine read_control_2(iu, iout, fname, line, icol, & select case (keyword) case ('(BINARY)') if (iclose == 0) then - ermsg = '"(BINARY)" option for array input is valid only if'// & - ' OPEN/CLOSE is also specified.' - call store_error(ermsg) + errmsg = '"(BINARY)" option for array input is valid only if'// & + ' OPEN/CLOSE is also specified.' + call store_error(errmsg) call store_error_unit(iu) end if binary = .true. @@ -747,9 +760,9 @@ subroutine read_control_2(iu, iout, fname, line, icol, & case ('') exit case default - ermsg = 'Invalid option found in array-control record: "' & - //trim(keyword)//'"' - call store_error(ermsg) + errmsg = 'Invalid option found in array-control record: "' & + //trim(keyword)//'"' + call store_error(errmsg) call store_error_unit(iu) end select end do @@ -982,7 +995,6 @@ subroutine print_array_int(iarr, aname, iout, jj, ii, k, prfmt, & logical, intent(in) :: prowcolnum ! Print row & column numbers ! -- local integer(I4B) :: i, j - character(len=MAXCHARLEN) :: ermsg ! -- formats 2 format(/, 1x, a, 1x, 'FOR LAYER ', i0) 3 format(/, 1x, a) @@ -1007,9 +1019,9 @@ subroutine print_array_int(iarr, aname, iout, jj, ii, k, prfmt, & end do else if (ii > 1) then - ermsg = 'Program error printing array '//trim(aname)// & - ': ii > 1 when prowcolnum is false.' - call store_error(ermsg, terminate=.TRUE.) + errmsg = 'Program error printing array '//trim(aname)// & + ': ii > 1 when prowcolnum is false.' + call store_error(errmsg, terminate=.TRUE.) end if ! ! -- Write array values, without row numbers @@ -1031,7 +1043,6 @@ subroutine print_array_dbl(darr, aname, iout, jj, ii, k, prfmt, & logical, intent(in) :: prowcolnum ! Print row & column numbers ! -- local integer(I4B) :: i, j - character(len=MAXCHARLEN) :: ermsg ! -- formats 2 format(/, 1x, a, 1x, 'FOR LAYER ', i0) 3 format(/, 1x, a) @@ -1056,9 +1067,9 @@ subroutine print_array_dbl(darr, aname, iout, jj, ii, k, prfmt, & end do else if (ii > 1) then - ermsg = 'Program error printing array '//trim(aname)// & - ': ii > 1 when prowcolnum is false.' - call store_error(ermsg, terminate=.TRUE.) + errmsg = 'Program error printing array '//trim(aname)// & + ': ii > 1 when prowcolnum is false.' + call store_error(errmsg, terminate=.TRUE.) end if ! ! -- Write array values, without row numbers @@ -1079,7 +1090,7 @@ subroutine read_binary_header(locat, iout, arrname, nval) integer(I4B) :: kstp, kper, m1, m2, m3 real(DP) :: pertim, totim character(len=16) :: text - character(len=MAXCHARLEN) :: ermsg, ermsgr + character(len=MAXCHARLEN) :: ermsgr character(len=*), parameter :: fmthdr = & "(/,1X,'HEADER FROM BINARY FILE HAS FOLLOWING ENTRIES',& &/,4X,'KSTP: ',I0,' KPER: ',I0,& @@ -1093,9 +1104,9 @@ subroutine read_binary_header(locat, iout, arrname, nval) ! ! -- Check for errors if (istat /= 0) then - ermsg = 'Error reading data for array: '//adjustl(trim(arrname)) - call store_error(ermsg) - call store_error(ermsgr) + errmsg = "Error reading data for array '"//adjustl(trim(arrname))// & + "'. "//trim(adjustl(ermsgr)) + call store_error(errmsg) call store_error_unit(locat) end if ! @@ -1111,4 +1122,41 @@ subroutine read_binary_header(locat, iout, arrname, nval) return end subroutine read_binary_header + !> @ brief Check the binary data size + !! + !! Check the size of the binary data that will be read + !! relative to the unfilled elements in the array . + !! + !< + function check_binary_size(nval, nvalt, arrsize, aname, locat) result(isok) + ! -- dummy + integer(I4B), intent(in) :: nval !< number of array + integer(I4B), intent(in) :: nvalt !< current data index + integer(I4B), intent(in) :: arrsize !< size of the array + character(len=*), intent(in) :: aname !< name of array + integer(I4B), intent(in) :: locat !< binary file unit + ! + ! -- local variables + logical(LGP) :: isok + ! + ! -- initialize isok + isok = .TRUE. + ! + if (nvalt + nval > arrsize) then + write (errmsg, '(a,i0,a,1x,a,1x,a,i0,a,1x,i0,3(1x,a))') & + 'The size of the data array calculated from the binary header (', & + nval, ') will exceed the remainder of the', trim(adjustl(aname)), & + 'data array (', arrsize, ') array by', nvalt + nval - arrsize, & + 'elements. This is usually caused by incorrect assignment of', & + '(m1,m2,m3) in the binary header. See the mf6io.pdf document', & + 'for information on assigning (m1,m2,m3).' + call store_error(errmsg) + call store_error_unit(locat) + isok = .FALSE. + end if + ! + ! -- return + return + end function check_binary_size + end module ArrayReadersModule diff --git a/src/Utilities/BlockParser.f90 b/src/Utilities/BlockParser.f90 index 2cc5159db58..887955ff972 100644 --- a/src/Utilities/BlockParser.f90 +++ b/src/Utilities/BlockParser.f90 @@ -7,17 +7,18 @@ module BlockParserModule use KindModule, only: DP, I4B - use ConstantsModule, only: LENHUGELINE, LINELENGTH, MAXCHARLEN - use VersionModule, only: IDEVELOPMODE - use InputOutputModule, only: uget_block, uget_any_block, uterminate_block, & - u9rdcom, urword, upcase + use DevFeatureModule, only: dev_feature + use ConstantsModule, only: LENBIGLINE, LENHUGELINE, LINELENGTH, MAXCHARLEN + use InputOutputModule, only: urword, upcase, openfile, & + io_getunit => GetUnit use SimModule, only: store_error, store_error_unit use SimVariablesModule, only: errmsg + use LongLineReaderModule, only: LongLineReaderType implicit none private - public :: BlockParserType + public :: BlockParserType, uget_block, uget_any_block, uterminate_block type :: BlockParserType integer(I4B), public :: iuactive !< flag indicating if a file unit is active, variable is not used internally @@ -30,6 +31,7 @@ module BlockParserModule character(len=LINELENGTH), private :: blockNameFound !< block name found character(len=LENHUGELINE), private :: laststring !< last string read character(len=:), allocatable, private :: line !< current line + type(LongLineReaderType) :: line_reader contains procedure, public :: Initialize procedure, public :: Clear @@ -155,8 +157,9 @@ subroutine GetBlock(this, blockName, isFound, ierr, supportOpenClose, & this%blockNameFound = '' ! if (blockName == '*') then - call uget_any_block(this%inunit, this%iout, isFound, this%lloc, & - this%line, blockNameFound, this%iuext) + call uget_any_block(this%line_reader, this%inunit, this%iout, & + isFound, this%lloc, this%line, blockNameFound, & + this%iuext) if (isFound) then this%blockNameFound = blockNameFound ierr = 0 @@ -164,7 +167,8 @@ subroutine GetBlock(this, blockName, isFound, ierr, supportOpenClose, & ierr = 1 end if else - call uget_block(this%inunit, this%iout, this%blockName, ierr, isFound, & + call uget_block(this%line_reader, this%inunit, this%iout, & + this%blockName, ierr, isFound, & this%lloc, this%line, this%iuext, continueRead, & supportOpenCloseLocal) if (isFound) this%blockNameFound = this%blockName @@ -202,7 +206,7 @@ subroutine GetNextLine(this, endOfBlock) ! -- read next line loop1: do if (lineread) exit loop1 - call u9rdcom(this%iuext, this%iout, this%line, ierr) + call this%line_reader%rdcom(this%iuext, this%iout, this%line, ierr) this%lloc = 1 call urword(this%line, this%lloc, istart, istop, 0, ival, rval, & this%iout, this%iuext) @@ -562,29 +566,258 @@ function GetUnit(this) result(i) return end function GetUnit - !> @ brief Development option + !> @ brief Disable development option in release mode !! - !! Method that will cause the program to terminate with an error if the - !! IDEVELOPMODE flag is set to 1. This is used to allow develop options - !! to be specified for development testing but not for the public release. - !! For the public release, IDEVELOPMODE is set to zero. + !! Terminate with an error if in release mode (IDEVELOPMODE = 0). Enables + !! options for development and testing while disabling for public release. !! !< subroutine DevOpt(this) ! -- dummy variables - class(BlockParserType), intent(inout) :: this !< BlockParserType object + class(BlockParserType), intent(inout) :: this ! - ! -- If release mode (not develop mode), then option not available. - ! Terminate with an error. - if (IDEVELOPMODE == 0) then - errmsg = "Invalid keyword '"//trim(this%laststring)// & - "' detected in block '"//trim(this%blockname)//"'." - call store_error(errmsg) - call this%StoreErrorUnit() - end if + errmsg = "Invalid keyword '"//trim(this%laststring)// & + "' detected in block '"//trim(this%blockname)//"'." + call dev_feature(errmsg, this%iuext) ! - ! -- Return return end subroutine DevOpt + ! -- static methods previously in InputOutput + !> @brief Find a block in a file + !! + !! Subroutine to read from a file until the tag (ctag) for a block is + !! is found. Return isfound with true, if found. + !! + !< + subroutine uget_block(line_reader, iin, iout, ctag, ierr, isfound, & + lloc, line, iuext, blockRequired, supportopenclose) + implicit none + ! -- dummy variables + type(LongLineReaderType), intent(inout) :: line_reader + integer(I4B), intent(in) :: iin !< file unit + integer(I4B), intent(in) :: iout !< output listing file unit + character(len=*), intent(in) :: ctag !< block tag + integer(I4B), intent(out) :: ierr !< error + logical, intent(inout) :: isfound !< boolean indicating if the block was found + integer(I4B), intent(inout) :: lloc !< position in line + character(len=:), allocatable, intent(inout) :: line !< line + integer(I4B), intent(inout) :: iuext !< external file unit number + logical, optional, intent(in) :: blockRequired !< boolean indicating if the block is required + logical, optional, intent(in) :: supportopenclose !< boolean indicating if the block supports open/close + ! -- local variables + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: ival + integer(I4B) :: lloc2 + real(DP) :: rval + character(len=:), allocatable :: line2 + character(len=LINELENGTH) :: fname + character(len=MAXCHARLEN) :: ermsg + logical :: supportoc, blockRequiredLocal + ! + ! -- code + if (present(blockRequired)) then + blockRequiredLocal = blockRequired + else + blockRequiredLocal = .true. + end if + supportoc = .false. + if (present(supportopenclose)) then + supportoc = supportopenclose + end if + iuext = iin + isfound = .false. + mainloop: do + lloc = 1 + call line_reader%rdcom(iin, iout, line, ierr) + if (ierr < 0) then + if (blockRequiredLocal) then + ermsg = 'Required block "'//trim(ctag)// & + '" not found. Found end of file instead.' + call store_error(ermsg) + call store_error_unit(iuext) + end if + ! block not found so exit + exit + end if + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == 'BEGIN') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == ctag) then + isfound = .true. + if (supportoc) then + ! Look for OPEN/CLOSE on 1st line after line starting with BEGIN + call line_reader%rdcom(iin, iout, line2, ierr) + if (ierr < 0) exit + lloc2 = 1 + call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) + if (line2(istart:istop) == 'OPEN/CLOSE') then + ! -- Get filename and preserve case + call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout) + fname = line2(istart:istop) + ! If line contains '(BINARY)' or 'SFAC', handle this block elsewhere + chk: do + call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) + if (line2(istart:istop) == '') exit chk + if (line2(istart:istop) == '(BINARY)' .or. & + line2(istart:istop) == 'SFAC') then + call line_reader%bkspc(iin) + exit mainloop + end if + end do chk + iuext = io_getunit() + call openfile(iuext, iout, fname, 'OPEN/CLOSE') + else + call line_reader%bkspc(iin) + end if + end if + else + if (blockRequiredLocal) then + ermsg = 'Error: Required block "'//trim(ctag)// & + '" not found. Found block "'//line(istart:istop)// & + '" instead.' + call store_error(ermsg) + call store_error_unit(iuext) + else + call line_reader%bkspc(iin) + end if + end if + exit mainloop + else if (line(istart:istop) == 'END') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == ctag) then + ermsg = 'Error: Looking for BEGIN '//trim(ctag)// & + ' but found END '//line(istart:istop)// & + ' instead.' + call store_error(ermsg) + call store_error_unit(iuext) + end if + end if + end do mainloop + ! + ! -- return + return + end subroutine uget_block + + !> @brief Find the next block in a file + !! + !! Subroutine to read from a file until next block is found. + !! Return isfound with true, if found, and return the block name. + !! + !< + subroutine uget_any_block(line_reader, iin, iout, isfound, & + lloc, line, ctagfound, iuext) + implicit none + ! -- dummy variables + type(LongLineReaderType), intent(inout) :: line_reader + integer(I4B), intent(in) :: iin !< file unit number + integer(I4B), intent(in) :: iout !< output listing file unit + logical, intent(inout) :: isfound !< boolean indicating if a block was found + integer(I4B), intent(inout) :: lloc !< position in line + character(len=:), allocatable, intent(inout) :: line !< line + character(len=*), intent(out) :: ctagfound !< block name + integer(I4B), intent(inout) :: iuext !< external file unit number + ! -- local variables + integer(I4B) :: ierr, istart, istop + integer(I4B) :: ival, lloc2 + real(DP) :: rval + character(len=100) :: ermsg + character(len=:), allocatable :: line2 + character(len=LINELENGTH) :: fname + ! + ! -- code + isfound = .false. + ctagfound = '' + iuext = iin + do + lloc = 1 + call line_reader%rdcom(iin, iout, line, ierr) + if (ierr < 0) exit + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) == 'BEGIN') then + call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) + if (line(istart:istop) /= '') then + isfound = .true. + ctagfound = line(istart:istop) + call line_reader%rdcom(iin, iout, line2, ierr) + if (ierr < 0) exit + lloc2 = 1 + call urword(line2, lloc2, istart, istop, 1, ival, rval, iout, iin) + if (line2(istart:istop) == 'OPEN/CLOSE') then + iuext = io_getunit() + call urword(line2, lloc2, istart, istop, 0, ival, rval, iout, iin) + fname = line2(istart:istop) + call openfile(iuext, iout, fname, 'OPEN/CLOSE') + else + call line_reader%bkspc(iin) + end if + else + ermsg = 'Block name missing in file.' + call store_error(ermsg) + call store_error_unit(iin) + end if + exit + end if + end do + return + end subroutine uget_any_block + + !> @brief Evaluate if the end of a block has been found + !! + !! Subroutine to evaluate if the end of a block has been found. Abnormal + !! termination if 'begin' is found or if 'end' encountered with + !! incorrect tag. + !! + !< + subroutine uterminate_block(iin, iout, key, ctag, lloc, line, ierr, iuext) + implicit none + ! -- dummy variables + integer(I4B), intent(in) :: iin !< file unit number + integer(I4B), intent(in) :: iout !< output listing file unit number + character(len=*), intent(in) :: key !< keyword in block + character(len=*), intent(in) :: ctag !< block name + integer(I4B), intent(inout) :: lloc !< position in line + character(len=*), intent(inout) :: line !< line + integer(I4B), intent(inout) :: ierr !< error + integer(I4B), intent(inout) :: iuext !< external file unit number + ! -- local variables + character(len=LENBIGLINE) :: ermsg + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: ival + real(DP) :: rval + ! -- format +1 format('ERROR. "', A, '" DETECTED WITHOUT "', A, '". ', '"END', 1X, A, & + '" MUST BE USED TO END ', A, '.') +2 format('ERROR. "', A, '" DETECTED BEFORE "END', 1X, A, '". ', '"END', 1X, A, & + '" MUST BE USED TO END ', A, '.') + ! + ! -- code + ierr = 1 + select case (key) + case ('END') + call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin) + if (line(istart:istop) /= ctag) then + write (ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag) + call store_error(ermsg) + call store_error_unit(iin) + else + ierr = 0 + if (iuext /= iin) then + ! -- close external file + close (iuext) + iuext = iin + end if + end if + case ('BEGIN') + write (ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag) + call store_error(ermsg) + call store_error_unit(iin) + end select + ! + ! -- return + return + end subroutine uterminate_block + end module BlockParserModule diff --git a/src/Utilities/BudgetObject.f90 b/src/Utilities/BudgetObject.f90 index 35836bf50b6..87819b7dd10 100644 --- a/src/Utilities/BudgetObject.f90 +++ b/src/Utilities/BudgetObject.f90 @@ -77,23 +77,17 @@ module BudgetObjectModule contains + !> @brief Create a new budget object + !< subroutine budgetobject_cr(this, name) -! ****************************************************************************** -! budgetobject_cr -- Create a new budget object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy type(BudgetObjectType), pointer :: this character(len=*), intent(in) :: name -! ------------------------------------------------------------------------------ ! ! -- Create the object allocate (this) ! - ! -- initialize variables + ! -- Initialize variables this%name = name this%ncv = 0 this%nbudterm = 0 @@ -101,23 +95,18 @@ subroutine budgetobject_cr(this, name) this%nsto = 0 this%iterm = 0 ! - ! -- initialize budget table + ! -- Initialize budget table call budget_cr(this%budtable, name) ! ! -- Return return end subroutine budgetobject_cr + !> @brief Define the new budget object + !< subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, & bddim_opt, labeltitle_opt, bdzone_opt, & ibudcsv) -! ****************************************************************************** -! budgetobject_df -- Define the new budget object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this integer(I4B), intent(in) :: ncv @@ -133,7 +122,6 @@ subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, & character(len=5) :: bddim character(len=16) :: labeltitle character(len=20) :: bdzone -! ------------------------------------------------------------------------------ ! ! -- set values this%ncv = ncv @@ -141,7 +129,7 @@ subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, & this%iflowja = iflowja this%nsto = nsto ! - ! -- allocate space for budterm + ! -- Allocate space for budterm allocate (this%budterm(nbudterm)) ! ! -- Set the budget type to name @@ -168,7 +156,7 @@ subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, & labeltitle = 'PACKAGE NAME' end if ! - ! -- setup the budget table object + ! -- Setup the budget table object call this%budtable%budget_df(nbudterm, bdtype, bddim, labeltitle, bdzone) ! ! -- Trigger csv output @@ -180,14 +168,9 @@ subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, & return end subroutine budgetobject_df + !> @brief Define the new flow table object + !< subroutine flowtable_df(this, iout, cellids) -! ****************************************************************************** -! flowtable_df -- Define the new flow table object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this integer(I4B), intent(in) :: iout @@ -204,9 +187,8 @@ subroutine flowtable_df(this, iout, cellids) integer(I4B) :: idx integer(I4B) :: ipos integer(I4B) :: i -! ------------------------------------------------------------------------------ ! - ! -- process optional variables + ! -- Process optional variables if (present(cellids)) then add_cellids = .TRUE. coupletype = cellids @@ -214,17 +196,17 @@ subroutine flowtable_df(this, iout, cellids) add_cellids = .FALSE. end if ! - ! -- allocate scalars + ! -- Allocate scalars allocate (this%add_cellids) allocate (this%icellid) allocate (this%nflowterms) ! - ! -- initialize scalars + ! -- Initialize scalars this%add_cellids = add_cellids this%nflowterms = 0 this%icellid = 0 ! - ! -- determine the number of columns in the table + ! -- Determine the number of columns in the table maxcol = 3 if (add_cellids) then maxcol = maxcol + 1 @@ -249,11 +231,11 @@ subroutine flowtable_df(this, iout, cellids) end if end do ! - ! -- allocate arrays + ! -- Allocate arrays allocate (this%istart(this%nflowterms)) allocate (this%iflowterms(this%nflowterms)) ! - ! -- set up flow tableobj + ! -- Set up flow tableobj title = trim(this%name)//' PACKAGE - SUMMARY OF FLOWS FOR '// & 'EACH CONTROL VOLUME' call table_cr(this%flowtab, this%name, title) @@ -299,13 +281,9 @@ subroutine flowtable_df(this, iout, cellids) return end subroutine flowtable_df + !> @brief Add up accumulators and submit to budget table + !< subroutine accumulate_terms(this) -! ****************************************************************************** -! accumulate_terms -- add up accumulators and submit to budget table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -314,49 +292,42 @@ subroutine accumulate_terms(this) character(len=LENBUDTXT) :: flowtype integer(I4B) :: i real(DP) :: ratin, ratout -! ------------------------------------------------------------------------------ ! - ! -- reset the budget table + ! -- Reset the budget table call this%budtable%reset() ! - ! -- calculate the budget table terms + ! -- Calculate the budget table terms do i = 1, this%nbudterm ! - ! -- accumulate positive and negative flows for each budget term + ! -- Accumulate positive and negative flows for each budget term flowtype = this%budterm(i)%flowtype select case (trim(adjustl(flowtype))) case ('FLOW-JA-FACE') - ! skip + ! -- Skip case default ! - ! -- calculate sum of positive and negative flows + ! -- Calculate sum of positive and negative flows call this%budterm(i)%accumulate_flow(ratin, ratout) ! - ! -- pass accumulators into the budget table + ! -- Pass accumulators into the budget table call this%budtable%addentry(ratin, ratout, delt, flowtype) end select end do ! - ! -- return + ! -- Return return end subroutine accumulate_terms + !> @brief Write the flow table for each advanced package control volume + !< subroutine write_flowtable(this, dis, kstp, kper, cellidstr) -! ****************************************************************************** -! write_flowtable -- Write the flow table for each advanced package control -! volume -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this class(DisBaseType), intent(in) :: dis integer(I4B), intent(in) :: kstp integer(I4B), intent(in) :: kper character(len=20), dimension(:), optional :: cellidstr - ! -- dummy + ! -- local character(len=LENBUDTXT) :: flowtype character(len=20) :: cellid integer(I4B) :: nlist @@ -375,25 +346,24 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) real(DP) :: qerr real(DP) :: qavg real(DP) :: qpd -! ------------------------------------------------------------------------------ ! - ! -- reset starting position + ! -- Reset starting position do j = 1, this%nflowterms this%istart(j) = 1 end do ! - ! -- set table kstp and kper + ! -- Set table kstp and kper call this%flowtab%set_kstpkper(kstp, kper) ! - ! -- write the table + ! -- Write the table do icv = 1, this%ncv call this%flowtab%add_term(icv) ! - ! -- initialize flow terms for the control volume + ! -- Initialize flow terms for the control volume qin = DZERO qout = DZERO ! - ! -- add cellid if required + ! -- Add cellid if required if (this%add_cellids) then if (present(cellidstr)) then ! @@ -419,21 +389,21 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) call this%flowtab%add_term(cellid) end if ! - ! -- iterate over the flow terms + ! -- Iterate over the flow terms do j = 1, this%nflowterms ! - ! -- initialize flow terms for the row + ! -- Initialize flow terms for the row q = DZERO qinflow = DZERO qoutflow = DZERO ! - ! -- determine the index, flowtype and length of + ! -- Determine the index, flowtype and length of ! the flowterm idx = this%iflowterms(j) flowtype = this%budterm(idx)%get_flowtype() nlist = this%budterm(idx)%get_nlist() ! - ! -- iterate over the entries in the flowtype. If id1 is not ordered + ! -- Iterate over the entries in the flowtype. If id1 is not ordered ! then need to look through the entire list each time colterm: do i = this%istart(j), nlist id1 = this%budterm(idx)%get_id1(i) @@ -454,7 +424,7 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) end if end if ! - ! -- accumulators + ! -- Accumulators q = q + v if (v < DZERO) then qout = qout + v @@ -463,7 +433,7 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) end if end do colterm ! - ! -- add entry to table + ! -- Add entry to table if (trim(adjustl(flowtype)) == 'FLOW-JA-FACE') then call this%flowtab%add_term(qinflow) call this%flowtab%add_term(qoutflow) @@ -472,7 +442,7 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) end if end do ! - ! -- calculate in-out and percent difference + ! -- Calculate in-out and percent difference qerr = qin + qout qavg = DHALF * (qin - qout) qpd = DZERO @@ -483,18 +453,13 @@ subroutine write_flowtable(this, dis, kstp, kper, cellidstr) call this%flowtab%add_term(qpd) end do ! - ! -- return + ! -- Return return end subroutine write_flowtable + !> @brief Write the budget table + !< subroutine write_budtable(this, kstp, kper, iout, ibudfl, totim) -! ****************************************************************************** -! write_budtable -- Write the budget table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this integer(I4B), intent(in) :: kstp @@ -502,28 +467,21 @@ subroutine write_budtable(this, kstp, kper, iout, ibudfl, totim) integer(I4B), intent(in) :: iout integer(I4B), intent(in) :: ibudfl real(DP), intent(in) :: totim - ! -- dummy -! ------------------------------------------------------------------------------ ! - ! -- write the table + ! -- Write the table if (ibudfl /= 0) then call this%budtable%budget_ot(kstp, kper, iout) end if call this%budtable%writecsv(totim) ! - ! -- return + ! -- Return return end subroutine write_budtable + !> @brief Write the budget table + !< subroutine save_flows(this, dis, ibinun, kstp, kper, delt, & pertim, totim, iout) -! ****************************************************************************** -! write_budtable -- Write the budget table -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this class(DisBaseType), intent(in) :: dis @@ -536,26 +494,20 @@ subroutine save_flows(this, dis, ibinun, kstp, kper, delt, & integer(I4B), intent(in) :: iout ! -- dummy integer(I4B) :: i -! ------------------------------------------------------------------------------ ! - ! -- save flows for each budget term + ! -- Save flows for each budget term do i = 1, this%nbudterm call this%budterm(i)%save_flows(dis, ibinun, kstp, kper, delt, & pertim, totim, iout) end do ! - ! -- return + ! -- Return return end subroutine save_flows + !> @brief Read froms from a binary file into this BudgetObjectType + !< subroutine read_flows(this, dis, ibinun) -! ****************************************************************************** -! read_flows -- Read froms from a binary file into this BudgetObjectType -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this class(DisBaseType), intent(in) :: dis @@ -568,38 +520,31 @@ subroutine read_flows(this, dis, ibinun) real(DP) :: totim ! -- dummy integer(I4B) :: i -! ------------------------------------------------------------------------------ ! - ! -- read flows for each budget term + ! -- Read flows for each budget term do i = 1, this%nbudterm call this%budterm(i)%read_flows(dis, ibinun, kstp, kper, delt, & pertim, totim) end do ! - ! -- return + ! -- Return return end subroutine read_flows + !> @brief Deallocate + !< subroutine budgetobject_da(this) -! ****************************************************************************** -! budgetobject_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this ! -- dummy integer(I4B) :: i -! ------------------------------------------------------------------------------ ! - ! -- save flows for each budget term + ! -- Save flows for each budget term do i = 1, this%nbudterm call this%budterm(i)%deallocate_arrays() end do ! - ! -- destroy the flow table + ! -- Destroy the flow table if (associated(this%flowtab)) then deallocate (this%add_cellids) deallocate (this%icellid) @@ -611,7 +556,7 @@ subroutine budgetobject_da(this) nullify (this%flowtab) end if ! - ! -- destroy the budget object table + ! -- Destroy the budget object table if (associated(this%budtable)) then call this%budtable%budget_da() deallocate (this%budtable) @@ -622,14 +567,9 @@ subroutine budgetobject_da(this) return end subroutine budgetobject_da + !> @brief Create a new budget object from a binary flow file + !< subroutine budgetobject_cr_bfr(this, name, ibinun, iout, colconv1, colconv2) -! ****************************************************************************** -! budgetobject_cr_bfr -- Create a new budget object from a binary flow file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy type(BudgetObjectType), pointer :: this character(len=*), intent(in) :: name @@ -641,7 +581,6 @@ subroutine budgetobject_cr_bfr(this, name, ibinun, iout, colconv1, colconv2) integer(I4B) :: ncv, nbudterm integer(I4B) :: iflowja, nsto integer(I4B) :: i, j -! ------------------------------------------------------------------------------ ! ! -- Create the object call budgetobject_cr(this, name) @@ -682,24 +621,17 @@ subroutine budgetobject_cr_bfr(this, name, ibinun, iout, colconv1, colconv2) return end subroutine budgetobject_cr_bfr + !> @brief Initialize the budget file reader + !< subroutine bfr_init(this, ibinun, ncv, nbudterm, iout) -! ****************************************************************************** -! bfr_init -- initialize the budget file reader -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this integer(I4B), intent(in) :: ibinun integer(I4B), intent(inout) :: ncv integer(I4B), intent(inout) :: nbudterm integer(I4B), intent(in) :: iout - ! -- local -! ------------------------------------------------------------------------------ ! - ! -- initialize budget file reader + ! -- Initialize budget file reader allocate (this%bfr) call this%bfr%initialize(ibinun, iout, ncv) nbudterm = this%bfr%nbudterms @@ -708,13 +640,10 @@ subroutine bfr_init(this, ibinun, ncv, nbudterm, iout) return end subroutine bfr_init + !> @brief Advance the binary file readers for setting the budget terms of + !! the next time step + !< subroutine bfr_advance(this, dis, iout) -! ****************************************************************************** -! bfr_advance -- copy the information from the binary file into budterms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kstp, kper ! -- dummy @@ -728,7 +657,6 @@ subroutine bfr_advance(this, dis, iout) character(len=*), parameter :: fmtbudkstpkper = & "(1x,/1x, a, ' SETTING BUDGET TERMS FOR KSTP ', i0, ' AND KPER ', & &i0, ' TO BUDGET FILE TERMS FROM KSTP ', i0, ' AND KPER ', i0)" -! ------------------------------------------------------------------------------ ! ! -- Do not read the budget if the budget is at end of file or if the next ! record in the budget file is the first timestep of the next stress @@ -753,7 +681,7 @@ subroutine bfr_advance(this, dis, iout) if (iout > 0) & write (iout, fmtkstpkper) this%name, kstp, kper ! - ! -- read flows from the binary file and copy them into this%budterm(:) + ! -- Read flows from the binary file and copy them into this%budterm(:) call this%fill_from_bfr(dis, iout) else if (iout > 0) & @@ -765,14 +693,9 @@ subroutine bfr_advance(this, dis, iout) return end subroutine bfr_advance + !> @brief Copy the information from the binary file into budterms + !< subroutine fill_from_bfr(this, dis, iout) -! ****************************************************************************** -! fill_from_bfr -- copy the information from the binary file into budterms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetObjectType) :: this class(DisBaseType), intent(in) :: dis @@ -780,9 +703,8 @@ subroutine fill_from_bfr(this, dis, iout) ! -- dummy integer(I4B) :: i logical :: success -! ------------------------------------------------------------------------------ ! - ! -- read flows from the binary file and copy them into this%budterm(:) + ! -- Read flows from the binary file and copy them into this%budterm(:) do i = 1, this%nbudterm call this%bfr%read_record(success, iout) call this%budterm(i)%fill_from_bfr(this%bfr, dis) diff --git a/src/Utilities/BudgetTerm.f90 b/src/Utilities/BudgetTerm.f90 index e3aeb13a67a..24de025e39d 100644 --- a/src/Utilities/BudgetTerm.f90 +++ b/src/Utilities/BudgetTerm.f90 @@ -54,16 +54,11 @@ module BudgetTermModule contains + !> @brief Initialize the budget term + !< subroutine initialize(this, flowtype, text1id1, text2id1, & text1id2, text2id2, maxlist, olconv1, olconv2, & naux, auxtxt, ordered_id1) -! ****************************************************************************** -! initialize -- initialize the budget term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this character(len=LENBUDTXT), intent(in) :: flowtype @@ -77,8 +72,7 @@ subroutine initialize(this, flowtype, text1id1, text2id1, & integer(I4B), intent(in) :: naux character(len=LENBUDTXT), dimension(:), intent(in), optional :: auxtxt logical, intent(in), optional :: ordered_id1 - ! -- local -! ------------------------------------------------------------------------------ + ! this%flowtype = flowtype this%text1id1 = text1id1 this%text2id1 = text2id1 @@ -93,37 +87,29 @@ subroutine initialize(this, flowtype, text1id1, text2id1, & if (present(auxtxt)) this%auxtxt(:) = auxtxt(1:naux) this%ordered_id1 = .true. if (present(ordered_id1)) this%ordered_id1 = ordered_id1 + ! end subroutine initialize + !> @brief Allocate budget term arrays + !< subroutine allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- allocate budget term arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this -! ------------------------------------------------------------------------------ + ! allocate (this%id1(this%maxlist)) allocate (this%id2(this%maxlist)) allocate (this%flow(this%maxlist)) allocate (this%auxvar(this%naux, this%maxlist)) allocate (this%auxtxt(this%naux)) + ! end subroutine allocate_arrays + !> @brief Deallocate budget term arrays + !< subroutine deallocate_arrays(this) -! ****************************************************************************** -! deallocate_arrays -- deallocate budget term arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this -! ------------------------------------------------------------------------------ + ! deallocate (this%id1) deallocate (this%id2) deallocate (this%flow) @@ -131,53 +117,40 @@ subroutine deallocate_arrays(this) deallocate (this%auxtxt) end subroutine deallocate_arrays + !> @brief reset the budget term and counter so terms can be updated + !< subroutine reset(this, nlist) -! ****************************************************************************** -! reset -- reset the budget term and counter so terms can be updated -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this integer(I4B), intent(in) :: nlist -! ------------------------------------------------------------------------------ + ! this%nlist = nlist this%icounter = 1 + ! end subroutine reset + !> @brief replace the terms in position this%icounter for id1, id2, flow, + !! and aux + !< subroutine update_term(this, id1, id2, flow, auxvar) -! ****************************************************************************** -! update_term -- replace the terms in position this%icounter -! for id1, id2, flow, and aux -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this integer(I4B), intent(in) :: id1 integer(I4B), intent(in) :: id2 real(DP), intent(in) :: flow real(DP), dimension(:), intent(in), optional :: auxvar -! ------------------------------------------------------------------------------ + ! this%id1(this%icounter) = id1 this%id2(this%icounter) = id2 this%flow(this%icounter) = flow if (present(auxvar)) this%auxvar(:, this%icounter) = auxvar(1:this%naux) this%icounter = this%icounter + 1 + ! end subroutine update_term + !> @brief Calculate ratin and ratout for all the flow terms + !< subroutine accumulate_flow(this, ratin, ratout) -! ****************************************************************************** -! accumulate_flow -- calculate ratin and ratout for all the flow terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this real(DP), intent(inout) :: ratin @@ -185,7 +158,7 @@ subroutine accumulate_flow(this, ratin, ratout) ! -- local integer(I4B) :: i real(DP) :: q -! ------------------------------------------------------------------------------ + ! ratin = DZERO ratout = DZERO do i = 1, this%nlist @@ -196,17 +169,13 @@ subroutine accumulate_flow(this, ratin, ratout) ratin = ratin + q end if end do + ! end subroutine accumulate_flow + !> @brief Write flows to a binary file + !< subroutine save_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim, & iout) -! ****************************************************************************** -! save_flows -- write flows to a binary file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this class(DisBaseType), intent(in) :: dis @@ -223,7 +192,6 @@ subroutine save_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim, & integer(I4B) :: n1 integer(I4B) :: n2 real(DP) :: q -! ------------------------------------------------------------------------------ ! ! -- Count the size of the list and exclude ids less than or equal to zero nlist = 0 @@ -253,114 +221,75 @@ subroutine save_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim, & olconv=this%olconv1, & olconv2=this%olconv2) end do + ! end subroutine save_flows + !> @brief Get the number of entries for the stress period + !< function get_nlist(this) result(nlist) -! ****************************************************************************** -! get_nlist -- get the number of entries for the stress period -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return - integer(I4B) :: nlist ! -- dummy class(BudgetTermType) :: this -! ------------------------------------------------------------------------------ + ! -- return + integer(I4B) :: nlist + ! nlist = this%nlist ! - ! -- return - return end function get_nlist + !> @brief Get the flowtype for the budget term + !< function get_flowtype(this) result(flowtype) -! ****************************************************************************** -! get_flowtype -- get the flowtype for the budget term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return - character(len=LENBUDTXT) :: flowtype ! -- dummy class(BudgetTermType) :: this -! ------------------------------------------------------------------------------ + ! -- return + character(len=LENBUDTXT) :: flowtype + ! flowtype = this%flowtype ! - ! -- return - return end function get_flowtype + !> @brief Get id1(icount) for the budget term + !< function get_id1(this, icount) result(id1) -! ****************************************************************************** -! get_id1 -- get id1(icount) for the budget term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return - integer(I4B) :: id1 ! -- dummy class(BudgetTermType) :: this integer(I4B), intent(in) :: icount -! ------------------------------------------------------------------------------ + ! -- return + integer(I4B) :: id1 + ! id1 = this%id1(icount) ! - ! -- return - return end function get_id1 + !> @brief Get id2(icount) for the budget term + !< function get_id2(this, icount) result(id2) -! ****************************************************************************** -! get_id2 -- get id2(icount) for the budget term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return integer(I4B) :: id2 ! -- dummy class(BudgetTermType) :: this integer(I4B), intent(in) :: icount -! ------------------------------------------------------------------------------ + ! id2 = this%id2(icount) ! - ! -- return - return end function get_id2 + !> @brief Get flow(icount) for the budget term + !< function get_flow(this, icount) result(flow) -! ****************************************************************************** -! get_flow -- get flow(icount) for the budget term -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- return real(DP) :: flow ! -- dummy class(BudgetTermType) :: this integer(I4B), intent(in) :: icount -! ------------------------------------------------------------------------------ + ! flow = this%flow(icount) ! - ! -- return - return end function get_flow + !> @brief Read flows from a binary file + !< subroutine read_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim) -! ****************************************************************************** -! read_flows -- read flows from a binary file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(BudgetTermType) :: this class(DisBaseType), intent(in) :: dis @@ -376,7 +305,7 @@ subroutine read_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim) integer(I4B) :: n1 integer(I4B) :: n2 real(DP) :: q -! ------------------------------------------------------------------------------ + ! read (ibinun) kstp, kper, this%flowtype, this%nlist, idum1, idum2 read (ibinun) imeth, delt, pertim, totim read (ibinun) this%text1id1 @@ -393,6 +322,7 @@ subroutine read_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim) allocate (this%auxtxt(this%naux)) end if end if + ! if (this%naux > 0) read (ibinun) (this%auxtxt(j), j=1, this%naux) read (ibinun) this%nlist if (.not. associated(this%id1)) then @@ -414,6 +344,7 @@ subroutine read_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim) allocate (this%auxvar(this%naux, this%maxlist)) end if end if + ! do i = 1, this%nlist read (ibinun) n1 read (ibinun) n2 @@ -425,15 +356,12 @@ subroutine read_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim) this%id2(i) = n2 this%flow(i) = q end do + ! end subroutine read_flows + !> @brief Copy the flow from the binary file reader into this budterm + !< subroutine fill_from_bfr(this, bfr, dis) -! ****************************************************************************** -! fill_from_bfr -- copy the flow from the binary file reader into this budterm -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use BudgetFileReaderModule, only: BudgetFileReaderType ! -- dummy @@ -445,13 +373,14 @@ subroutine fill_from_bfr(this, bfr, dis) integer(I4B) :: n1 integer(I4B) :: n2 real(DP) :: q -! ------------------------------------------------------------------------------ + ! this%flowtype = bfr%budtxt this%text1id1 = bfr%srcmodelname this%text2id1 = bfr%srcpackagename this%text1id2 = bfr%dstmodelname this%text2id2 = bfr%dstpackagename this%naux = bfr%naux + ! if (.not. associated(this%auxtxt)) then allocate (this%auxtxt(this%naux)) else @@ -460,6 +389,7 @@ subroutine fill_from_bfr(this, bfr, dis) allocate (this%auxtxt(this%naux)) end if end if + ! if (this%naux > 0) this%auxtxt(:) = bfr%auxtxt(:) this%nlist = bfr%nlist if (.not. associated(this%id1)) then @@ -481,6 +411,7 @@ subroutine fill_from_bfr(this, bfr, dis) allocate (this%auxvar(this%naux, this%maxlist)) end if end if + ! do i = 1, this%nlist n1 = bfr%nodesrc(i) n2 = bfr%nodedst(i) @@ -492,6 +423,7 @@ subroutine fill_from_bfr(this, bfr, dis) this%id2(i) = n2 this%flow(i) = q end do + ! end subroutine fill_from_bfr end module BudgetTermModule diff --git a/src/Utilities/Constants.f90 b/src/Utilities/Constants.f90 index 784476c424f..718a9ae392c 100644 --- a/src/Utilities/Constants.f90 +++ b/src/Utilities/Constants.f90 @@ -81,6 +81,7 @@ module ConstantsModule real(DP), parameter :: DSIX = 6.0_DP !< real constant 6 real(DP), parameter :: DEIGHT = 8.0_DP !< real constant 8 real(DP), parameter :: DTEN = 1.0e1_DP !< real constant 10 + real(DP), parameter :: DSIXTY = 6.0e1_DP !< real constant 60 real(DP), parameter :: DHUNDRED = 1.0e2_DP !< real constant 100 real(DP), parameter :: DEP3 = 1.0e3_DP !< real constant 1000 @@ -92,6 +93,12 @@ module ConstantsModule real(DP), parameter :: DHDRY = -1.e30_DP !< real dry cell constant real(DP), parameter :: DNODATA = 3.0e30_DP !< real no data constant + real(DP), parameter :: DSECPERHR = 3.6e3_DP !< real constant representing number of seconds per hour (used in tdis) + real(DP), parameter :: DHRPERDAY = 2.4e1_DP !< real constant representing number of hours per day (used in tdis) + real(DP), parameter :: DDYPERYR = 3.6525e2_DP !< real constant representing the average number of days per year (used in tdis) + real(DP), parameter :: DSECPERDY = 8.64e4_DP !< real constant representing the number of seconds per day (used in tdis) + real(DP), parameter :: DSECPERYR = 3.1557600e7_DP !< real constant representing the average number of seconds per year (used in tdis) + real(DP), parameter :: DEM1 = 1.0e-1_DP !< real constant 1e-1 real(DP), parameter :: D5EM2 = 5.0e-2_DP !< real constant 5e-2 real(DP), parameter :: DEM2 = 1.0e-2_DP !< real constant 1e-2 diff --git a/src/Utilities/DevFeature.f90 b/src/Utilities/DevFeature.f90 new file mode 100644 index 00000000000..a36e1fb22e2 --- /dev/null +++ b/src/Utilities/DevFeature.f90 @@ -0,0 +1,37 @@ +!> @brief Disable development features in release mode +module DevFeatureModule + use KindModule, only: I4B + use VersionModule, only: IDEVELOPMODE + use SimModule, only: store_error, store_error_unit + implicit none + private + public :: dev_feature + +contains + + !> @brief Terminate if in release mode (guard development features) + !! + !! Terminate the program with an error if the IDEVELOPMODE flag + !! is set to 0. This allows developing features on the mainline + !! while disabling them in release builds. An optional file unit + !! may be specified to associate the feature with an input file. + !! + !< + subroutine dev_feature(errmsg, iunit) + ! -- dummy + character(len=*), intent(in) :: errmsg + integer(I4B), intent(in), optional :: iunit + + ! -- store error and terminate if in release mode + if (IDEVELOPMODE == 0) then + if (present(iunit)) then + call store_error(errmsg, terminate=.false.) + call store_error_unit(iunit, terminate=.true.) + else + call store_error(errmsg, terminate=.true.) + end if + end if + + end subroutine dev_feature + +end module DevFeatureModule diff --git a/src/Utilities/ErrorUtil.f90 b/src/Utilities/ErrorUtil.f90 new file mode 100644 index 00000000000..f967168d906 --- /dev/null +++ b/src/Utilities/ErrorUtil.f90 @@ -0,0 +1,26 @@ +module ErrorUtilModule + use KindModule, only: I4B + implicit none +contains + + !> @brief Stop the program, optionally specifying an error status code. + !! + !! If a non-zero status is specified, the program is terminated with the + !! error status code. If no status is specified or status=0, the program + !! stops with code 0. A message may be provided to print before exiting, + !! useful e.g. for "contact developer" messages upon programming errors. + !< + subroutine pstop(status, message) + integer(I4B), intent(in), optional :: status !< optional error code to return (default=0) + character(len=*), intent(in), optional :: message !< optional message to print before stopping + + if (present(message)) print *, message + if (present(status)) then + if (status == 0) stop + call exit(status) + else + stop + end if + end subroutine pstop + +end module ErrorUtilModule diff --git a/src/Utilities/GeomUtil.f90 b/src/Utilities/GeomUtil.f90 new file mode 100644 index 00000000000..9d1bad53c2b --- /dev/null +++ b/src/Utilities/GeomUtil.f90 @@ -0,0 +1,360 @@ +module GeomUtilModule + use KindModule, only: I4B, DP, LGP + use ErrorUtilModule, only: pstop + use ConstantsModule, only: DZERO, DONE + implicit none + private + public :: between, point_in_polygon, & + get_node, get_ijk, get_jk, & + skew, transform, & + compose +contains + + !> @brief Check if a value is between two other values (inclusive). + logical function between(x, a, b) + real(DP), intent(in) :: x, a, b + between = ((x >= a .and. x <= b) .or. (x <= a .and. x >= b)) + end function between + + !> @brief Check if a point is within a polygon. + !! Vertices and edge points are considered in. + !! Reference: https://stackoverflow.com/a/63436180/6514033 + logical function point_in_polygon(x, y, poly) + ! dummy + real(DP), intent(in) :: x !< x point coordinate + real(DP), intent(in) :: y !< y point coordinate + real(DP), allocatable, intent(in) :: poly(:, :) !< polygon vertices (column-major indexing) + ! local + integer(I4B) :: i, ii, num_verts + real(DP) :: xa, xb, ya, yb, c = 0.0_DP + + point_in_polygon = .false. + num_verts = size(poly, 2) + xa = poly(1, num_verts) + ya = poly(2, num_verts) + + do i = 0, num_verts - 1 + ii = mod(i, num_verts) + 1 + xb = poly(1, ii) + yb = poly(2, ii) + + if ((x == xa .and. y == ya) .or. (x == xb .and. y == yb)) then + ! on vertex + point_in_polygon = .true. + exit + else if (ya == yb .and. y == ya .and. between(x, xa, xb)) then + ! on horizontal edge + point_in_polygon = .true. + exit + else if (between(y, ya, yb)) then + if ((y == ya .and. yb >= ya) .or. (y == yb .and. ya >= yb)) then + xa = xb + ya = yb + cycle + end if + ! cross product + c = (xa - x) * (yb - y) - (xb - x) * (ya - y) + if (c == 0) then + ! on edge + point_in_polygon = .true. + exit + else if ((ya < yb) .eqv. (c > 0)) then + ! ray intersection + point_in_polygon = .not. point_in_polygon + end if + end if + + xa = xb + ya = yb + end do + end function point_in_polygon + + !> @brief Get node number, given layer, row, and column indices + !! for a structured grid. If any argument is invalid return -1. + function get_node(ilay, irow, icol, nlay, nrow, ncol) + integer(I4B), intent(in) :: ilay, irow, icol, nlay, nrow, ncol + integer(I4B) :: get_node + + if (nlay > 0 .and. nrow > 0 .and. ncol > 0 .and. & + ilay > 0 .and. ilay <= nlay .and. & + irow > 0 .and. irow <= nrow .and. & + icol > 0 .and. icol <= ncol) then + get_node = & + icol + ncol * (irow - 1) + (ilay - 1) * nrow * ncol + else + get_node = -1 + end if + end function get_node + + !> @brief Get row, column and layer indices from node number and grid + !! dimensions. If nodenumber is invalid, irow, icol, and ilay are -1. + subroutine get_ijk(nodenumber, nrow, ncol, nlay, irow, icol, ilay) + ! -- dummy variables + integer(I4B), intent(in) :: nodenumber + integer(I4B), intent(in) :: nrow + integer(I4B), intent(in) :: ncol + integer(I4B), intent(in) :: nlay + integer(I4B), intent(out) :: irow + integer(I4B), intent(out) :: icol + integer(I4B), intent(out) :: ilay + ! -- local variables + integer(I4B) :: nodes + integer(I4B) :: ij + + nodes = nlay * nrow * ncol + if (nodenumber < 1 .or. nodenumber > nodes) then + irow = -1 + icol = -1 + ilay = -1 + else + ilay = (nodenumber - 1) / (ncol * nrow) + 1 + ij = nodenumber - (ilay - 1) * ncol * nrow + irow = (ij - 1) / ncol + 1 + icol = ij - (irow - 1) * ncol + end if + end subroutine get_ijk + + !> @brief Get layer index and within-layer node index from node number + !! and grid dimensions. If nodenumber is invalid, icpl and ilay are -1. + subroutine get_jk(nodenumber, ncpl, nlay, icpl, ilay) + ! -- dummy variables + integer(I4B), intent(in) :: nodenumber + integer(I4B), intent(in) :: ncpl + integer(I4B), intent(in) :: nlay + integer(I4B), intent(out) :: icpl + integer(I4B), intent(out) :: ilay + ! -- local variables + integer(I4B) :: nodes + + nodes = ncpl * nlay + if (nodenumber < 1 .or. nodenumber > nodes) then + icpl = -1 + ilay = -1 + else + ilay = (nodenumber - 1) / ncpl + 1 + icpl = nodenumber - (ilay - 1) * ncpl + end if + end subroutine get_jk + + !> @brief Skew a 2D vector along the x-axis. + pure function skew(v, s, invert) result(res) + ! -- dummy + real(DP), intent(in) :: v(2) !< vector + real(DP), intent(in) :: s(3) !< skew matrix entries (top left, top right, bottom right) + logical(LGP), intent(in), optional :: invert + real(DP) :: res(2) + ! -- local + logical(LGP) :: linvert + real(DP) :: sxx, sxy, syy + + ! -- process optional arguments + if (present(invert)) then + linvert = invert + else + linvert = .false. + end if + + sxx = s(1) + sxy = s(2) + syy = s(3) + if (.not. linvert) then + res(1) = sxx * v(1) + sxy * v(2) + res(2) = syy * v(2) + else + res(2) = v(2) / syy + res(1) = (v(1) - sxy * res(2)) / sxx + end if + end function skew + + !> @brief Apply a 3D translation and optional 2D rotation to coordinates. + subroutine transform(xin, yin, zin, & + xout, yout, zout, & + xorigin, yorigin, zorigin, & + sinrot, cosrot, & + invert) + ! -- dummy + real(DP) :: xin, yin, zin !< input coordinates + real(DP) :: xout, yout, zout !< output coordinates + real(DP), optional :: xorigin, yorigin, zorigin !< origin coordinates + real(DP), optional :: sinrot, cosrot !< sine and cosine of rotation + logical(LGP), optional :: invert !< whether to invert + ! -- local + logical(LGP) :: ltranslate, lrotate, linvert + real(DP) :: x, y + real(DP) :: lxorigin, lyorigin, lzorigin + real(DP) :: lsinrot, lcosrot + + ! -- Process option arguments and set defaults and flags + call defaults(lxorigin, lyorigin, lzorigin, & + lsinrot, lcosrot, linvert, & + ltranslate, lrotate, & + xorigin, yorigin, zorigin, & + sinrot, cosrot, invert) + + ! -- Apply transformation or its inverse + if (.not. linvert) then + ! -- Apply transformation to coordinates + if (ltranslate) then + xout = xin - lxorigin + yout = yin - lyorigin + zout = zin - lzorigin + else + xout = lxorigin + yout = lyorigin + zout = lzorigin + end if + if (lrotate) then + x = xout + y = yout + xout = x * lcosrot + y * lsinrot + yout = -x * lsinrot + y * lcosrot + end if + else + ! -- Apply inverse of transformation to coordinates + if (lrotate) then + x = xin * lcosrot - yin * lsinrot + y = xin * lsinrot + yin * lcosrot + else + x = xin + y = yin + end if + if (ltranslate) then + xout = x + lxorigin + yout = y + lyorigin + zout = zin + lzorigin + end if + end if + end subroutine transform + + !> @brief Apply a 3D translation and 2D rotation to an existing transformation. + subroutine compose(xorigin, yorigin, zorigin, & + sinrot, cosrot, & + xorigin_new, yorigin_new, zorigin_new, & + sinrot_new, cosrot_new, & + invert) + ! -- dummy + real(DP) :: xorigin, yorigin, zorigin !< origin coordinates (original) + real(DP) :: sinrot, cosrot !< sine and cosine of rotation (original) + real(DP), optional :: xorigin_new, yorigin_new, zorigin_new !< origin coordinates (new) + real(DP), optional :: sinrot_new, cosrot_new !< sine and cosine of rotation (new) + logical(LGP), optional :: invert !< whether to invert + ! -- local + logical(LGP) :: ltranslate, lrotate, linvert + real(DP) :: xorigin_add, yorigin_add, zorigin_add + real(DP) :: sinrot_add, cosrot_add + real(DP) :: x0, y0, z0, s0, c0 + + ! -- Process option arguments and set defaults and flags + call defaults(xorigin_add, yorigin_add, zorigin_add, & + sinrot_add, cosrot_add, linvert, & + ltranslate, lrotate, & + xorigin_new, yorigin_new, zorigin_new, & + sinrot_new, cosrot_new, invert) + + ! -- Copy existing transformation into working copy + x0 = xorigin + y0 = yorigin + z0 = zorigin + s0 = sinrot + c0 = cosrot + + ! -- Modify transformation + if (.not. linvert) then + ! -- Apply additional transformation to existing transformation + if (ltranslate) then + ! -- Calculate modified origin, XOrigin + R^T XOrigin_add, where + ! -- XOrigin and XOrigin_add are the existing and additional origin + ! -- vectors, respectively, and R^T is the transpose of the existing + ! -- rotation matrix + call transform(xorigin_add, yorigin_add, zorigin_add, & + xorigin, yorigin, zorigin, & + x0, y0, z0, s0, c0, .true.) + end if + if (lrotate) then + ! -- Calculate modified rotation matrix (represented by sinrot + ! -- and cosrot) as R_add R, where R and R_add are the existing + ! -- and additional rotation matrices, respectively + sinrot = cosrot_add * s0 + sinrot_add * c0 + cosrot = cosrot_add * c0 - sinrot_add * s0 + end if + else + ! -- Apply inverse of additional transformation to existing transformation + ! + ! -- Calculate modified origin, R^T (XOrigin + R_add XOrigin_add), where + ! -- XOrigin and XOrigin_add are the existing and additional origin + ! -- vectors, respectively, R^T is the transpose of the existing rotation + ! -- matrix, and R_add is the additional rotation matrix + if (ltranslate) then + call transform(-xorigin_add, -yorigin_add, zorigin_add, & + x0, y0, z0, xorigin, yorigin, zorigin, & + -sinrot_add, cosrot_add, .true.) + end if + xorigin = c0 * x0 - s0 * y0 + yorigin = s0 * x0 + c0 * y0 + zorigin = z0 + if (lrotate) then + ! -- Calculate modified rotation matrix (represented by sinrot + ! -- and cosrot) as R_add^T R, where R and R_add^T are the existing + ! -- rotation matirx and the transpose of the additional rotation + ! -- matrix, respectively + sinrot = cosrot_add * s0 - sinrot_add * c0 + cosrot = cosrot_add * c0 + sinrot_add * s0 + end if + end if + end subroutine compose + + !> @brief Process arguments and set defaults. Internal use only. + subroutine defaults(xorigin, yorigin, zorigin, & + sinrot, cosrot, & + invert, translate, rotate, & + xorigin_opt, yorigin_opt, zorigin_opt, & + sinrot_opt, cosrot_opt, invert_opt) + ! -- dummy + real(DP) :: xorigin, yorigin, zorigin + real(DP) :: sinrot, cosrot + logical(LGP) :: invert, translate, rotate + real(DP), optional :: xorigin_opt, yorigin_opt, zorigin_opt + real(DP), optional :: sinrot_opt, cosrot_opt + logical(LGP), optional :: invert_opt + + translate = .false. + xorigin = DZERO + if (present(xorigin_opt)) then + xorigin = xorigin_opt + translate = .true. + end if + yorigin = DZERO + if (present(yorigin_opt)) then + yorigin = yorigin_opt + translate = .true. + end if + zorigin = DZERO + if (present(zorigin_opt)) then + zorigin = zorigin_opt + translate = .true. + end if + rotate = .false. + sinrot = DZERO + cosrot = DONE + if (present(sinrot_opt)) then + sinrot = sinrot_opt + if (present(cosrot_opt)) then + cosrot = cosrot_opt + else + ! -- If sinrot_opt is specified but cosrot_opt is not, + ! -- default to corresponding non-negative cosrot_add + cosrot = dsqrt(DONE - sinrot * sinrot) + end if + rotate = .true. + else if (present(cosrot_opt)) then + cosrot = cosrot_opt + ! -- cosrot_opt is specified but sinrot_opt is not, so + ! -- default to corresponding non-negative sinrot_add + sinrot = dsqrt(DONE - cosrot * cosrot) + rotate = .true. + end if + invert = .false. + if (present(invert_opt)) invert = invert_opt + end subroutine defaults + +end module GeomUtilModule diff --git a/src/Utilities/HashTable.f90 b/src/Utilities/HashTable.f90 index 51f90b04efd..536d50ebe47 100644 --- a/src/Utilities/HashTable.f90 +++ b/src/Utilities/HashTable.f90 @@ -1,13 +1,9 @@ -! HashTableType implements a hash table for storing integers, -! for use as an index for an array that could contain -! any data type. This HashTableModule was designed using the -! dictionary implementation by Arjen Markus of the Flibs -! collection of Fortran utilities. This hash table works -! like a dictionary. There can be n number of character -! strings and each string will be assigned a unique number -! between 1 and n, allowing an efficient way to store a -! unique integer index with a character string. - +!> @brief A chaining hash map for integers. +!! +!! Convenient for use as an index into arrays of arbitrary +!! data type. The implementation is based on Arjen Markus' +!! dictionary in the Flibs collection of Fortran utilities. +!< module HashTableModule use KindModule, only: DP, I4B @@ -22,268 +18,199 @@ module HashTableModule integer, parameter, private :: HASH_SIZE = 4993 integer, parameter, private :: MULTIPLIER = 31 - type :: ListDataType + type :: NodeType character(len=:), allocatable :: key - integer(I4B) :: index - end type ListDataType - - type :: ListType - type(ListDataType) :: listdata - type(ListType), pointer :: next => null() + integer(I4B) :: value + type(NodeType), pointer :: next => null() contains - procedure :: add => listtype_add - end type ListType + procedure :: add => list_add + end type NodeType - type :: HashListType - type(ListType), pointer :: list => null() - end type HashListType + type :: BucketType + type(NodeType), pointer :: list => null() + end type BucketType type :: HashTableType private - type(HashListType), dimension(:), pointer :: table => null() + type(BucketType), pointer :: buckets(:) => null() contains - procedure :: add_entry - procedure :: get_elem - procedure :: get_index + procedure :: add => ht_add + procedure :: get => ht_get + procedure, private :: find_node end type HashTableType contains - subroutine hash_table_cr(ht) -! ****************************************************************************** -! hash_table_cr -- public subroutine to create the hash table object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create a hash table + subroutine hash_table_cr(map) ! -- dummy - type(HashTableType), pointer :: ht + type(HashTableType), pointer :: map ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ - ! + ! -- allocate - allocate (ht) - allocate (ht%table(HASH_SIZE)) - ! - ! -- nullify each list + allocate (map) + allocate (map%buckets(HASH_SIZE)) + + ! -- initialize nul buckets do i = 1, HASH_SIZE - ht%table(i)%list => null() + map%buckets(i)%list => null() end do - ! - ! -- return - return + end subroutine hash_table_cr - subroutine hash_table_da(ht) -! ****************************************************************************** -! hash_table_da -- public subroutine to deallocate the hash table object -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Deallocate the hash table + subroutine hash_table_da(map) ! -- dummy - type(HashTableType), pointer :: ht + type(HashTableType), pointer :: map ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ - ! - ! -- deallocate the list for each hash - do i = 1, size(ht%table) - if (associated(ht%table(i)%list)) then - call listtype_da(ht%table(i)%list) + + ! -- deallocate each bucket + do i = 1, size(map%buckets) + if (associated(map%buckets(i)%list)) then + call list_da(map%buckets(i)%list) end if end do - ! - ! -- deallocate the table and the hash table - deallocate (ht%table) - deallocate (ht) - ! - ! -- return - return + + ! -- deallocate bucket array and hash table + deallocate (map%buckets) + deallocate (map) + end subroutine hash_table_da - subroutine add_entry(this, key, index) -! ****************************************************************************** -! add_entry -- hash table method to add a key/index entry -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Associate the given key and value + subroutine ht_add(this, k, v) ! -- dummy class(HashTableType) :: this - character(len=*), intent(in) :: key - integer(I4B), intent(in) :: index + character(len=*), intent(in) :: k + integer(I4B), intent(in) :: v ! -- local - type(ListType), pointer :: elem - integer(I4B) :: ihash -! ------------------------------------------------------------------------------ - ! + type(NodeType), pointer :: node + integer(I4B) :: h + ! -- find the element corresponding to this key and replace index or ! get an unassociated elem that corresponds to this key - elem => this%get_elem(key) - ! + node => this%find_node(k) + ! -- replace index or create new entry - if (associated(elem)) then - elem%listdata%index = index + if (associated(node)) then + node%value = v else - ihash = hashfunc(trim(key)) - if (associated(this%table(ihash)%list)) then - call this%table(ihash)%list%add(key, index) + h = hash(trim(k)) + if (associated(this%buckets(h)%list)) then + call this%buckets(h)%list%add(k, v) else - call listtype_cr(this%table(ihash)%list, key, index) + call list_cr(this%buckets(h)%list, k, v) end if end if - ! - ! -- return - return - end subroutine add_entry - - function get_elem(this, key) result(elem) -! ****************************************************************************** -! get_elem -- get the entry corresponding to this key -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + + end subroutine ht_add + + !> @brief Find the node containing the given key + function find_node(this, k) result(node) ! -- dummy - class(HashTableType) :: this - character(len=*), intent(in) :: key + class(HashTableType) :: this !< the hash map + character(len=*), intent(in) :: k !< the key ! -- local - type(ListType), pointer :: elem - integer(I4B) :: ihash -! ------------------------------------------------------------------------------ - ihash = hashfunc(trim(key)) - elem => this%table(ihash)%list - do while (associated(elem)) - if (elem%listdata%key == key) then + type(NodeType), pointer :: node + integer(I4B) :: h + + h = hash(trim(k)) + node => this%buckets(h)%list + + ! -- search bucket for node with matching key + do while (associated(node)) + if (node%key == k) then exit else - elem => elem%next + node => node%next end if end do - ! - ! -- return - return - end function get_elem - - function get_index(this, key) result(index) -! ****************************************************************************** -! get_index -- get the integer index that corresponds to this hash. -! Return a zero if key does not exist in hash table. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + + end function find_node + + !> @brief Get the value for the given key if it exists, otherwise return zero. + function ht_get(this, k) result(v) ! -- dummy - class(HashTableType) :: this - character(len=*), intent(in) :: key + class(HashTableType) :: this !< the hash map + character(len=*), intent(in) :: k !< the key ! -- return - integer(I4B) :: index + integer(I4B) :: v ! -- local - type(ListType), pointer :: elem -! ------------------------------------------------------------------------------ - elem => this%get_elem(key) - if (associated(elem)) then - index = elem%listdata%index + type(NodeType), pointer :: node + + node => this%find_node(k) + if (associated(node)) then + v = node%value else - index = 0 + v = 0 end if - ! - ! -- return - return - end function get_index - - subroutine listtype_cr(list, key, index) -! ****************************************************************************** -! listtype_cr -- subroutine to create a list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + + end function ht_get + + !> @brief Create a list with the given key/value pair + subroutine list_cr(list, k, v) ! -- dummy - type(ListType), pointer :: list - character(len=*), intent(in) :: key - integer(I4B), intent(in) :: index -! ------------------------------------------------------------------------------ + type(NodeType), pointer :: list !< pointer to the list + character(len=*), intent(in) :: k !< the first key + integer(I4B), intent(in) :: v !< the first value + allocate (list) list%next => null() - list%listdata%key = key - list%listdata%index = index - ! - ! -- return - return - end subroutine listtype_cr - - subroutine listtype_add(this, key, index) -! ****************************************************************************** -! listtype_add -- method to add a key/index pair to a list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + list%key = k + list%value = v + + end subroutine list_cr + + !> @brief Add a key/value pair to the list + subroutine list_add(this, k, v) ! -- dummy - class(ListType) :: this - character(len=*), intent(in) :: key - integer(I4B), intent(in) :: index + class(NodeType) :: this !< the list + character(len=*), intent(in) :: k !< the key + integer(I4B), intent(in) :: v !< the value ! -- local - type(ListType), pointer :: next -! ------------------------------------------------------------------------------ + type(NodeType), pointer :: next + allocate (next) - next%listdata%key = key - next%listdata%index = index + next%key = k + next%value = v next%next => this%next this%next => next - ! - ! -- return - return - end subroutine listtype_add - - subroutine listtype_da(list) -! ****************************************************************************** -! listtype_da -- subroutine to deallocate a list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + + end subroutine list_add + + !> @brief Deallocate the list + subroutine list_da(list) ! -- dummy - type(ListType), pointer, intent(in) :: list + type(NodeType), pointer, intent(in) :: list !< the list ! -- local - type(ListType), pointer :: current - type(ListType), pointer :: elem -! ------------------------------------------------------------------------------ - elem => list - do while (associated(elem)) - current => elem - elem => current%next - deallocate (current) + type(NodeType), pointer :: curr + type(NodeType), pointer :: node + + node => list + do while (associated(node)) + curr => node + node => curr%next + deallocate (curr) end do - ! - ! -- return - return - end subroutine listtype_da - - function hashfunc(key) result(ihash) -! ****************************************************************************** -! hashfunc -- function to convert key into an integer hash number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + + end subroutine list_da + + !> @brief Map a character string to an integer + function hash(k) result(h) ! -- dummy - character(len=*), intent(in) :: key + character(len=*), intent(in) :: k !< the key ! -- local - integer(I4B) :: ihash + integer(I4B) :: h integer(I4B) :: i -! ------------------------------------------------------------------------------ - ihash = 0 - do i = 1, len(key) - ihash = modulo(MULTIPLIER * ihash + ichar(key(i:i)), HASH_SIZE) + + h = 0 + do i = 1, len(k) + h = modulo(MULTIPLIER * h + ichar(k(i:i)), HASH_SIZE) end do - ihash = 1 + modulo(ihash - 1, HASH_SIZE) - ! - ! -- return - return - end function hashfunc + h = 1 + modulo(h - 1, HASH_SIZE) + + end function hash end module HashTableModule diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 new file mode 100644 index 00000000000..2afa3bdf041 --- /dev/null +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -0,0 +1,561 @@ +!> @brief This module contains the BoundInputContextModule +!! +!! This module contains a type that stores and creates context +!! relevant to stress package inputs. +!! +!< +module BoundInputContextModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, IZERO, LENAUXNAME, LENVARNAME, LENBOUNDNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + use ModflowInputModule, only: ModflowInputType + use CharacterStringModule, only: CharacterStringType + + implicit none + private + public :: BoundInputContextType + + !> @brief derived type for boundary package input context + !! + !! This derived type defines input context used by dynamic package loaders. + !! Some variables (e.g. iprpak) in the type may have already been created + !! by a static loader whereas others (e.g. nboound) are created by this + !! type, updated by to dynamic loader, and accessed from the model package. + !! + !< + type :: BoundInputContextType + integer(I4B), pointer :: naux => null() !< number of auxiliary variables + integer(I4B), pointer :: maxbound => null() !< max list input records per period + integer(I4B), pointer :: inamedbound => null() !< are bound names optioned + integer(I4B), pointer :: iprpak => null() ! print input option + integer(I4B), pointer :: nbound => null() !< number of bounds in period + integer(I4B), pointer :: ncpl => null() !< number of cells per layer + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxname_cst => null() !< array of auxiliary names + type(CharacterStringType), dimension(:), pointer, & + contiguous :: boundname_cst => null() !< array of bound names + real(DP), dimension(:, :), pointer, & + contiguous :: auxvar => null() !< auxiliary variable array + integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape + character(len=LENVARNAME), dimension(:), allocatable :: filtcols !< list input in scope columns + integer(I4B) :: nfiltcol !< list input number of in scope columns + logical(LGP) :: readasarrays !< grid or list based input + type(ModflowInputType) :: mf6_input !< description of input + contains + procedure :: init => bndctx_init + procedure :: create_context + procedure :: enable + procedure :: bound_params_allocate + procedure :: param_init + procedure :: allocate_read_state_var + procedure :: destroy => bndctx_destroy + procedure :: set_filtered_cols + procedure :: filtered_cols + end type BoundInputContextType + +contains + + !> @brief initialize boundary input context + !! + !< + subroutine bndctx_init(this, mf6_input, readasarrays) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + type(ModflowInputType), intent(in) :: mf6_input + logical(LGP), intent(in) :: readasarrays + ! + this%mf6_input = mf6_input + this%readasarrays = readasarrays + ! + ! -- create the dynamic package input context + call this%create_context() + ! + ! -- determine in scope list input columns + if (.not. readasarrays) then + call this%set_filtered_cols() + end if + ! + ! --return + return + end subroutine bndctx_init + + !> @brief create boundary input context + !! + !< + subroutine create_context(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy + class(BoundInputContextType) :: this + integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() + logical(LGP) :: found + ! + ! -- set pointers to defined scalars + call mem_setptr(this%naux, 'NAUX', this%mf6_input%mempath) + ! + ! -- allocate memory managed scalars + call mem_allocate(this%nbound, 'NBOUND', this%mf6_input%mempath) + call mem_allocate(this%ncpl, 'NCPL', this%mf6_input%mempath) + ! + ! -- internally allocate package optional scalars + allocate (this%maxbound) + allocate (this%inamedbound) + allocate (this%iprpak) + ! + ! -- initialize allocated and internal scalars + this%nbound = 0 + this%ncpl = 0 + this%maxbound = 0 + this%inamedbound = 0 + this%iprpak = 0 + this%nfiltcol = 0 + ! + ! -- update optional scalars + call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%mf6_input%mempath, & + found) + call mem_set_value(this%maxbound, 'MAXBOUND', this%mf6_input%mempath, found) + call mem_set_value(this%iprpak, 'IPRPAK', this%mf6_input%mempath, found) + ! + ! -- set pointers to defined arrays + call mem_setptr(this%mshape, 'MODEL_SHAPE', & + this%mf6_input%component_mempath) + ! + ! -- update ncpl as shape is known + if (size(this%mshape) == 2) then + this%ncpl = this%mshape(2) + else if (size(this%mshape) == 3) then + this%ncpl = this%mshape(2) * this%mshape(3) + end if + ! + ! -- set auxname_cst and iauxmultcol + if (this%naux > 0) then + call mem_setptr(this%auxname_cst, 'AUXILIARY', this%mf6_input%mempath) + else + call mem_allocate(this%auxname_cst, LENAUXNAME, 0, & + 'AUXILIARY', this%mf6_input%mempath) + end if + ! + ! -- allocate cellid if this is not list input + if (this%readasarrays) then + call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath) + end if + ! + ! -- return + return + end subroutine create_context + + !> @brief enable bound input context + !! + !! This routine should be invoked after the loader allocates dynamic + !! input params. This routine will assign pointers to arrays if they + !! have been allocated and allocate the arrays if not. + !! + !< + subroutine enable(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy + class(BoundInputContextType) :: this + ! -- local + ! + ! -- allocate or set pointer to BOUNDNAME + if (this%inamedbound == 0) then + call mem_allocate(this%boundname_cst, LENBOUNDNAME, 0, & + 'BOUNDNAME', this%mf6_input%mempath) + ! + else + call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath) + end if + ! + ! -- allocate or set pointer to AUXVAR + if (this%naux == 0) then + call mem_allocate(this%auxvar, 0, 0, 'AUXVAR', this%mf6_input%mempath) + ! + else + call mem_setptr(this%auxvar, 'AUXVAR', this%mf6_input%mempath) + end if + ! + ! -- return + return + end subroutine enable + + !> @brief allocate a read state variable + !! + !! Create and set a read state variable, e.g. 'INRECHARGE', + !! which are updated per iper load as follows: + !! -1: unset, not in use + !! 0: not read in most recent period block + !! 1: numeric input read in most recent period block + !! 2: time series input read in most recent period block + !! + !< + function allocate_read_state_var(this, mf6varname) result(varname) + ! -- modules + use MemoryManagerModule, only: mem_setptr, mem_allocate + ! -- dummy + class(BoundInputContextType) :: this + character(len=*), intent(in) :: mf6varname + ! -- locals + character(len=LENVARNAME) :: varname + integer(I4B) :: ilen + integer(I4B), pointer :: intvar + character(len=2) :: prefix = 'IN' + ! + ! -- assign first column as the block number + ilen = len_trim(mf6varname) + ! + if (ilen > (LENVARNAME - len(prefix))) then + varname = prefix//mf6varname(1:(LENVARNAME - len(prefix))) + else + varname = prefix//trim(mf6varname) + end if + ! + call mem_allocate(intvar, varname, this%mf6_input%mempath) + intvar = -1 + ! + ! -- return + return + end function allocate_read_state_var + + !> @brief allocate dfn period block parameters + !! + !! Currently supports numeric (i.e. array based) params + !! + !< + subroutine bound_params_allocate(this, sourcename) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use InputDefinitionModule, only: InputParamDefinitionType + ! -- dummy + class(BoundInputContextType) :: this + character(len=*) :: sourcename + type(InputParamDefinitionType), pointer :: idt + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B) :: iparam, n, m + ! + ! -- list input allocates via structarray + if (.not. this%readasarrays) then + call store_error('Programming error. (IDM) Bound context unsupported & + &list based param allocation.') + call store_error_filename(sourcename) + end if + ! + ! -- allocate dfn input params + do iparam = 1, size(this%mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'PERIOD') then + ! + ! allocate based on dfn datatype + select case (idt%datatype) + case ('INTEGER1D') + ! + call mem_allocate(int1d, this%ncpl, idt%mf6varname, & + this%mf6_input%mempath) + ! + do n = 1, this%ncpl + int1d(n) = IZERO + end do + ! + case ('DOUBLE1D') + ! + call mem_allocate(dbl1d, this%ncpl, idt%mf6varname, & + this%mf6_input%mempath) + ! + do n = 1, this%ncpl + dbl1d(n) = DZERO + end do + ! + case ('DOUBLE2D') + ! + call mem_allocate(dbl2d, this%naux, this%ncpl, & + idt%mf6varname, this%mf6_input%mempath) + ! + do m = 1, this%ncpl + do n = 1, this%naux + dbl2d(n, m) = DZERO + end do + end do + ! + case default + call store_error('Programming error. (IDM) Bound context unsupported & + &data type allocation for param='//trim(idt%tagname)) + call store_error_filename(sourcename) + end select + ! + end if + end do + ! + ! -- enable + call this%enable() + ! + ! -- return + return + end subroutine bound_params_allocate + + subroutine param_init(this, datatype, varname, mempath, sourcename) + ! -- modules + use MemoryManagerModule, only: mem_setptr + ! -- dummy + class(BoundInputContextType) :: this + character(len=*), intent(in) :: datatype + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: sourcename + ! -- locals + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + type(CharacterStringType), dimension(:), pointer, & + contiguous :: charstr1d => null() + integer(I4B) :: n, m + ! + select case (datatype) + case ('INTEGER1D') + ! + call mem_setptr(int1d, varname, mempath) + do n = 1, this%ncpl + int1d(n) = IZERO + end do + ! + case ('DOUBLE1D') + ! + call mem_setptr(dbl1d, varname, mempath) + do n = 1, this%ncpl + dbl1d(n) = DZERO + end do + ! + case ('DOUBLE2D') + ! + call mem_setptr(dbl2d, varname, mempath) + do m = 1, this%ncpl + do n = 1, this%naux + dbl2d(n, m) = DZERO + end do + end do + ! + case ('CHARSTR1D') + ! + call mem_setptr(charstr1d, varname, mempath) + do n = 1, size(charstr1d) + charstr1d(n) = '' + end do + ! + case default + ! + call store_error('Programming error. (IDM) Bound context unsupported & + &data type initialization for param='//trim(varname)) + call store_error_filename(sourcename) + ! + end select + ! + ! -- return + return + end subroutine param_init + + !> @brief destroy boundary input context + !! + !< + subroutine bndctx_destroy(this) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + ! + ! -- deallocate + deallocate (this%maxbound) + deallocate (this%inamedbound) + deallocate (this%iprpak) + ! + ! -- nullify + nullify (this%naux) + nullify (this%nbound) + nullify (this%ncpl) + nullify (this%maxbound) + nullify (this%inamedbound) + nullify (this%iprpak) + nullify (this%auxname_cst) + nullify (this%boundname_cst) + nullify (this%auxvar) + nullify (this%mshape) + ! + deallocate (this%filtcols) + ! + ! --return + return + end subroutine bndctx_destroy + + !> @brief create array of in scope list input columns + !! + !! Filter the recarray description of list input parameters + !! to determine which columns are to be read in this run. + !< + subroutine set_filtered_cols(this) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_aggregate_definition_type + use ArrayHandlersModule, only: expandarray + use InputOutputModule, only: parseline + ! -- dummy + class(BoundInputContextType) :: this + ! -- local + type(InputParamDefinitionType), pointer :: ra_idt + character(len=:), allocatable :: parse_str + character(len=LENVARNAME), dimension(:), allocatable :: dfncols + integer(I4B), dimension(:), allocatable :: idxs + integer(I4B) :: dfnncol, icol, keepcnt + logical(LGP) :: keep + ! + ! -- initialize + keepcnt = 0 + ! + ! -- get aggregate param definition for period block + ra_idt => & + get_aggregate_definition_type(this%mf6_input%aggregate_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD') + ! + ! -- split recarray definition + parse_str = trim(ra_idt%datatype)//' ' + call parseline(parse_str, dfnncol, dfncols) + ! + ! -- determine which columns are in scope + do icol = 1, dfnncol + ! + keep = .false. + ! + if (dfncols(icol) == 'RECARRAY') then + ! no-op + else if (dfncols(icol) == 'AUX') then + if (this%naux > 0) then + keep = .true. + end if + else if (dfncols(icol) == 'BOUNDNAME') then + if (this%inamedbound /= 0) then + keep = .true. + end if + else + keep = pkg_param_in_scope(this%mf6_input, dfncols(icol)) + end if + ! + if (keep) then + keepcnt = keepcnt + 1 + call expandarray(idxs) + idxs(keepcnt) = icol + end if + end do + ! + ! -- update nfiltcol + this%nfiltcol = keepcnt + ! + ! -- allocate filtcols + allocate (this%filtcols(this%nfiltcol)) + ! + ! -- set filtcols + do icol = 1, this%nfiltcol + this%filtcols(icol) = dfncols(idxs(icol)) + end do + ! + ! -- cleanup + deallocate (dfncols) + deallocate (idxs) + deallocate (parse_str) + ! + ! -- return + return + end subroutine set_filtered_cols + + !> @brief allocate and set input array to filtered param set + !! + !< + subroutine filtered_cols(this, cols, ncol) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + character(len=LENVARNAME), dimension(:), allocatable, & + intent(inout) :: cols + integer(I4B), intent(inout) :: ncol + integer(I4B) :: n + ! + if (allocated(cols)) deallocate (cols) + ! + ncol = this%nfiltcol + ! + allocate (cols(ncol)) + ! + do n = 1, ncol + cols(n) = this%filtcols(n) + end do + ! + ! -- return + return + end subroutine filtered_cols + + !> @brief determine if input param is in scope for a package + !! + !< + function pkg_param_in_scope(mf6_input, tagname) result(in_scope) + ! -- modules + use MemoryManagerModule, only: get_isize, mem_setptr + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + ! -- dummy + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: tagname + ! -- return + logical(LGP) :: in_scope + ! -- locals + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: pdim_isize, popt_isize + integer(I4B), pointer :: pdim + ! + ! -- initialize + in_scope = .false. + ! + idt => get_param_definition_type(mf6_input%param_dfns, & + mf6_input%component_type, & + mf6_input%subcomponent_type, & + 'PERIOD', tagname, '') + ! + if (idt%required) then + ! -- required params always included + in_scope = .true. + else + ! + ! -- package specific logic to determine if input params to be read + select case (mf6_input%subcomponent_type) + case ('EVT') + ! + if (tagname == 'PXDP' .or. tagname == 'PETM') then + call get_isize('NSEG', mf6_input%mempath, pdim_isize) + if (pdim_isize > 0) then + call mem_setptr(pdim, 'NSEG', mf6_input%mempath) + if (pdim > 1) then + in_scope = .true. + end if + end if + else if (tagname == 'PETM0') then + call get_isize('SURFRATESPEC', mf6_input%mempath, popt_isize) + if (popt_isize > 0) then + in_scope = .true. + end if + end if + ! + case default + end select + end if + ! + ! -- return + return + end function pkg_param_in_scope + +end module BoundInputContextModule diff --git a/src/Utilities/Idm/IdmLoad.f90 b/src/Utilities/Idm/IdmLoad.f90 new file mode 100644 index 00000000000..b7c95f238dd --- /dev/null +++ b/src/Utilities/Idm/IdmLoad.f90 @@ -0,0 +1,676 @@ +!> @brief This module contains the IdmLoadModule +!! +!! This module contains routines for managing static +!! and dynamic input loading for supported sources. +!! +!< +module IdmLoadModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, & + LENEXCHANGENAME, LENCOMPONENTNAME + use SimModule, only: store_error, store_error_filename + use ListModule, only: ListType + use InputLoadTypeModule, only: StaticPkgLoadBaseType, & + DynamicPkgLoadBaseType, & + ModelDynamicPkgsType + use InputDefinitionModule, only: InputParamDefinitionType + use ModflowInputModule, only: ModflowInputType, getModflowInput + + implicit none + private + public :: simnam_load + public :: load_models + public :: load_exchanges + public :: idm_df + public :: idm_rp + public :: idm_ad + public :: idm_da + + type(ListType) :: model_dynamic_pkgs + +contains + + !> @brief advance package dynamic data for period steps + !< + subroutine idm_df() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%df() + end do + ! + ! -- return + return + end subroutine idm_df + + !> @brief load package dynamic data for period + !< + subroutine idm_rp() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%rp() + end do + ! + ! -- return + return + end subroutine idm_rp + + !> @brief advance package dynamic data for period steps + !< + subroutine idm_ad() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%ad() + end do + ! + ! -- return + return + end subroutine idm_ad + + !> @brief idm deallocate routine + !< + subroutine idm_da(iout) + use SimVariablesModule, only: idm_context + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path, split_mem_path + use MemoryManagerExtModule, only: memorylist_remove + use CharacterStringModule, only: CharacterStringType + integer(I4B), intent(in) :: iout + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mempaths + character(len=LENCOMPONENTNAME) :: exg_comp, exg_subcomp + character(len=LENMEMPATH) :: input_mempath, mempath + integer(I4B) :: n + ! + ! -- deallocate dynamic loaders + call dynamic_da(iout) + ! + ! -- deallocate EXG mempaths + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + call mem_setptr(mempaths, 'EXGMEMPATHS', input_mempath) + do n = 1, size(mempaths) + mempath = mempaths(n) + if (mempath /= '') then + call split_mem_path(mempath, exg_comp, exg_subcomp) + call memorylist_remove(exg_comp, exg_subcomp, idm_context) + end if + end do + ! + ! -- return + return + end subroutine idm_da + + !> @brief load an integrated model package from supported source + !< + subroutine model_pkg_load(model_pkg_inputs, itype, ipkg, iout) + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceLoadModule, only: create_input_loader + type(ModelPackageInputsType), intent(in) :: model_pkg_inputs + integer(I4B), intent(in) :: itype + integer(I4B), intent(in) :: ipkg + integer(I4B), intent(in) :: iout + class(StaticPkgLoadBaseType), pointer :: static_loader + class(DynamicPkgLoadBaseType), pointer :: dynamic_loader + class(ModelDynamicPkgsType), pointer :: dynamic_pkgs => null() + ! + ! -- create model package loader + static_loader => & + create_input_loader(model_pkg_inputs%component_type, & + model_pkg_inputs%pkglist(itype)%subcomponent_type, & + model_pkg_inputs%modelname, & + model_pkg_inputs%pkglist(itype)%pkgnames(ipkg), & + model_pkg_inputs%pkglist(itype)%pkgtype, & + model_pkg_inputs%pkglist(itype)%filenames(ipkg), & + model_pkg_inputs%modelfname) + ! + ! -- load static input and set dynamic loader + dynamic_loader => static_loader%load(iout) + ! + if (associated(dynamic_loader)) then + ! + ! -- set pointer to model dynamic packages list + dynamic_pkgs => dynamic_model_pkgs(model_pkg_inputs%modelname, & + static_loader%component_input_name, & + iout) + ! + ! -- add dynamic pkg loader to list + call dynamic_pkgs%add(dynamic_loader) + ! + end if + ! + ! -- cleanup + call static_loader%destroy() + deallocate (static_loader) + ! + ! -- return + return + end subroutine model_pkg_load + + !> @brief load integrated model package files + !< + subroutine load_model_pkgs(model_pkg_inputs, iout) + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceLoadModule, only: open_source_file + use IdmDfnSelectorModule, only: idm_integrated + type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + integer(i4B), intent(in) :: iout + integer(I4B) :: itype, ipkg + ! + ! -- load package instances by type + do itype = 1, size(model_pkg_inputs%pkglist) + ! + ! -- load package instances + do ipkg = 1, model_pkg_inputs%pkglist(itype)%pnum + + if (idm_integrated(model_pkg_inputs%component_type, & + model_pkg_inputs%pkglist(itype)%subcomponent_type)) & + then + ! + ! -- only load if model pkg can read from input context + call model_pkg_load(model_pkg_inputs, itype, ipkg, iout) + else + ! + ! -- open input file for package parser + model_pkg_inputs%pkglist(itype)%inunits(ipkg) = & + open_source_file(model_pkg_inputs%pkglist(itype)%pkgtype, & + model_pkg_inputs%pkglist(itype)%filenames(ipkg), & + model_pkg_inputs%modelfname, iout) + end if + end do + end do + ! + ! -- return + return + end subroutine load_model_pkgs + + !> @brief load model namfiles and model package files + !< + subroutine load_models(model_loadmask, iout) + ! -- modules + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_setptr + use CharacterStringModule, only: CharacterStringType + use SimVariablesModule, only: idm_context + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceCommonModule, only: idm_component_type + use SourceLoadModule, only: load_modelnam + ! -- dummy + integer(I4B), dimension(:), intent(in) :: model_loadmask + integer(I4B), intent(in) :: iout + ! -- locals + character(len=LENMEMPATH) :: input_mempath + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mtypes !< model types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mfnames !< model file names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mnames !< model names + character(len=LINELENGTH) :: mtype, mfname + character(len=LENMODELNAME) :: mname + type(ModelPackageInputsType), allocatable :: model_pkg_inputs + integer(I4B) :: n + ! + ! -- set input memory path + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- set pointers to input context model attribute arrays + call mem_setptr(mtypes, 'MTYPE', input_mempath) + call mem_setptr(mfnames, 'MFNAME', input_mempath) + call mem_setptr(mnames, 'MNAME', input_mempath) + ! + do n = 1, size(mtypes) + ! + ! -- attributes for this model + mtype = mtypes(n) + mfname = mfnames(n) + mname = mnames(n) + ! + ! -- load specified model inputs + if (model_loadmask(n) > 0) then + ! + ! -- load model nam file + call load_modelnam(mtype, mfname, mname, iout) + ! + ! -- create description of model packages + allocate (model_pkg_inputs) + call model_pkg_inputs%init(mtype, mfname, mname, iout) + ! + ! -- load packages + call load_model_pkgs(model_pkg_inputs, iout) + ! + ! -- publish pkg info to input context + call model_pkg_inputs%memload() + ! + ! -- cleanup + call model_pkg_inputs%destroy() + deallocate (model_pkg_inputs) + end if + end do + ! + ! -- return + return + end subroutine load_models + + !> @brief load exchange files + !< + subroutine load_exchanges(model_loadmask, iout) + ! -- modules + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_setptr, mem_allocate, & + mem_deallocate, get_isize + use CharacterStringModule, only: CharacterStringType + use SimVariablesModule, only: idm_context, simfile + use SourceCommonModule, only: idm_subcomponent_type, ifind_charstr + use SourceLoadModule, only: create_input_loader, remote_model_ndim + ! -- dummy + integer(I4B), dimension(:), intent(in) :: model_loadmask + integer(I4B), intent(in) :: iout + ! -- locals + type(CharacterStringType), dimension(:), contiguous, & + pointer :: etypes !< exg types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: efiles !< exg file names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: emnames_a !< model a names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: emnames_b !< model b names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: emempaths !< exg mempaths + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mtypes !< model types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mfnames !< model file names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mnames !< model names + character(len=LENMEMPATH) :: input_mempath, mempath + integer(I4B), pointer :: exgid, ncelldim + character(len=LINELENGTH) :: exgtype, efname, mfname + character(len=LENMODELNAME) :: mname1, mname2, mname + character(len=LENCOMPONENTNAME) :: sc_type, sc_name, mtype + class(StaticPkgLoadBaseType), pointer :: static_loader + class(DynamicPkgLoadBaseType), pointer :: dynamic_loader + integer(I4B) :: n, m1_idx, m2_idx, irem, isize + ! + ! -- set input memory path + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- set pointers to input context exg and model attribute arrays + call mem_setptr(etypes, 'EXGTYPE', input_mempath) + call mem_setptr(efiles, 'EXGFILE', input_mempath) + call mem_setptr(emnames_a, 'EXGMNAMEA', input_mempath) + call mem_setptr(emnames_b, 'EXGMNAMEB', input_mempath) + call mem_setptr(mtypes, 'MTYPE', input_mempath) + call mem_setptr(mfnames, 'MFNAME', input_mempath) + call mem_setptr(mnames, 'MNAME', input_mempath) + ! + ! -- allocate mempaths array for exchanges + call mem_allocate(emempaths, LENMEMPATH, size(etypes), 'EXGMEMPATHS', & + input_mempath) + ! + ! -- load exchanges for local models + do n = 1, size(etypes) + ! + ! -- attributes for this exchange + exgtype = etypes(n) + efname = efiles(n) + mname1 = emnames_a(n) + mname2 = emnames_b(n) + ! + ! initialize mempath as no path + emempaths(n) = '' + irem = 0 + ! + ! -- set indexes for exchange model names + m1_idx = ifind_charstr(mnames, mname1) + m2_idx = ifind_charstr(mnames, mname2) + ! + if (m1_idx <= 0 .or. m2_idx <= 0) then + errmsg = 'Exchange has invalid (unrecognized) model name(s):' + if (m1_idx <= 0) errmsg = trim(errmsg)//' '//trim(mname1) + if (m2_idx <= 0) errmsg = trim(errmsg)//' '//trim(mname2) + call store_error(errmsg) + call store_error_filename(simfile) + end if + ! + ! -- load the exchange input if either model local + if (model_loadmask(m1_idx) > 0 .or. model_loadmask(m2_idx) > 0) then + ! + ! -- set index if either model is remote + if (model_loadmask(m1_idx) == 0) then + irem = m1_idx + else if (model_loadmask(m2_idx) == 0) then + irem = m2_idx + end if + ! + ! -- allocate and set remote model NCELLDIM + if (irem > 0) then + mtype = mtypes(irem) + mfname = mfnames(irem) + mname = mnames(irem) + mempath = create_mem_path(component=mname, context=idm_context) + call get_isize('NCELLDIM', mempath, isize) + if (isize < 0) then + call mem_allocate(ncelldim, 'NCELLDIM', mempath) + ncelldim = remote_model_ndim(mtype, mfname) + else + call mem_setptr(ncelldim, 'NCELLDIM', mempath) + end if + else + nullify (ncelldim) + end if + ! + ! -- set subcomponent strings + sc_type = trim(idm_subcomponent_type('EXG', exgtype)) + write (sc_name, '(a,i0)') trim(sc_type)//'_', n + ! + ! -- create and set exchange mempath + mempath = create_mem_path('EXG', sc_name, idm_context) + emempaths(n) = mempath + ! + ! -- allocate and set exgid + call mem_allocate(exgid, 'EXGID', mempath) + exgid = n + ! + ! -- create exchange loader + static_loader => create_input_loader('EXG', sc_type, 'EXG', sc_name, & + exgtype, efname, simfile) + ! -- load static input + dynamic_loader => static_loader%load(iout) + ! + if (associated(dynamic_loader)) then + errmsg = 'IDM unimplemented. Dynamic Exchanges not supported.' + call store_error(errmsg) + call store_error_filename(efname) + else + call static_loader%destroy() + deallocate (static_loader) + end if + ! + end if + ! + end do + ! + ! -- clean up temporary NCELLDIM for remote models + do n = 1, size(mnames) + if (model_loadmask(n) == 0) then + mname = mnames(n) + mempath = create_mem_path(component=mname, context=idm_context) + call get_isize('NCELLDIM', mempath, isize) + if (isize > 0) then + call mem_setptr(ncelldim, 'NCELLDIM', mempath) + call mem_deallocate(ncelldim) + end if + end if + end do + ! + ! -- return + return + end subroutine load_exchanges + + !> @brief MODFLOW 6 mfsim.nam input load routine + !< + subroutine simnam_load(paramlog) + use SourceLoadModule, only: load_simnam + integer(I4B), intent(inout) :: paramlog + ! + ! -- load sim nam file + call load_simnam() + ! + ! -- allocate any unallocated simnam params + call simnam_allocate() + ! + ! -- read and set input parameter logging keyword + paramlog = input_param_log() + ! + ! -- memload summary info + call simnam_load_dim() + ! + ! --return + return + end subroutine simnam_load + + !> @brief retrieve list of model dynamic loaders + !< + function dynamic_model_pkgs(modelname, modelfname, iout) & + result(model_dynamic_input) + use InputLoadTypeModule, only: AddDynamicModelToList, GetDynamicModelFromList + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + integer(I4B), intent(in) :: iout + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + class(ModelDynamicPkgsType), pointer :: temp + integer(I4B) :: id + ! + ! -- initialize + nullify (model_dynamic_input) + ! + ! -- assign model loader object if found + do id = 1, model_dynamic_pkgs%Count() + temp => GetDynamicModelFromList(model_dynamic_pkgs, id) + if (temp%modelname == modelname) then + model_dynamic_input => temp + exit + end if + end do + ! + ! -- create if not found + if (.not. associated(model_dynamic_input)) then + allocate (model_dynamic_input) + call model_dynamic_input%init(modelname, modelfname, iout) + call AddDynamicModelToList(model_dynamic_pkgs, model_dynamic_input) + end if + ! + ! -- return + return + end function dynamic_model_pkgs + + !> @brief deallocate all model dynamic loader collections + !< + subroutine dynamic_da(iout) + use InputLoadTypeModule, only: GetDynamicModelFromList + integer(I4B), intent(in) :: iout + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%destroy() + deallocate (model_dynamic_input) + nullify (model_dynamic_input) + end do + ! + call model_dynamic_pkgs%Clear() + ! + ! -- return + return + end subroutine dynamic_da + + !> @brief return sim input context PRINT_INTPUT value + !< + function input_param_log() result(paramlog) + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_setptr + use SimVariablesModule, only: idm_context + character(len=LENMEMPATH) :: simnam_mempath + integer(I4B) :: paramlog + integer(I4B), pointer :: p + ! + ! -- read and set input value of PRINT_INPUT + simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) + call mem_setptr(p, 'PRINT_INPUT', simnam_mempath) + paramlog = p + ! + ! -- return + return + end function input_param_log + + !> @brief load simulation summary info to input context + !< + subroutine simnam_load_dim() + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_allocate, mem_setptr + use SimVariablesModule, only: idm_context + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH) :: sim_mempath, simnam_mempath + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mtypes !< model types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: etypes !< model types + integer(I4B), pointer :: nummodels => null() + integer(I4B), pointer :: numexchanges => null() + ! + ! -- set memory paths + sim_mempath = create_mem_path(component='SIM', context=idm_context) + simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- set pointers to loaded simnam arrays + call mem_setptr(mtypes, 'MTYPE', simnam_mempath) + call mem_setptr(etypes, 'EXGTYPE', simnam_mempath) + ! + ! -- allocate variables + call mem_allocate(nummodels, 'NUMMODELS', sim_mempath) + call mem_allocate(numexchanges, 'NUMEXCHANGES', sim_mempath) + ! + ! -- set values + nummodels = size(mtypes) + numexchanges = size(etypes) + ! + ! -- return + return + end subroutine simnam_load_dim + + !> @brief set sim nam input context default integer value + !< + subroutine allocate_simnam_int(input_mempath, idt) + use MemoryManagerModule, only: mem_allocate + use SimVariablesModule, only: isimcontinue, isimcheck, simfile + character(len=LENMEMPATH), intent(in) :: input_mempath + type(InputParamDefinitionType), pointer, intent(in) :: idt + integer(I4B), pointer :: intvar => null() + ! + ! -- allocate and set default + call mem_allocate(intvar, idt%mf6varname, input_mempath) + ! + select case (idt%mf6varname) + case ('CONTINUE') + intvar = isimcontinue + case ('NOCHECK') + intvar = isimcheck + case ('MAXERRORS') + intvar = 1000 !< MessageType max_message + case ('MXITER') + intvar = 1 + case ('PRINT_INPUT') + intvar = 0 + case default + write (errmsg, '(a,a)') & + 'Programming error. Idm SIMNAM Load default value setting '& + &'is unhandled for this variable: ', & + trim(idt%mf6varname) + call store_error(errmsg) + call store_error_filename(simfile) + end select + ! + ! -- return + return + end subroutine allocate_simnam_int + + !> @brief MODFLOW 6 mfsim.nam parameter allocate and set + !< + subroutine allocate_simnam_param(input_mempath, idt) + use SimVariablesModule, only: simfile + use MemoryManagerModule, only: mem_allocate + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH), intent(in) :: input_mempath + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=LINELENGTH), pointer :: cstr => null() + type(CharacterStringType), dimension(:), & + pointer, contiguous :: acharstr1d => null() + ! + ! -- initialize + ! + select case (idt%datatype) + case ('KEYWORD', 'INTEGER') + ! + ! -- allocate and set default + call allocate_simnam_int(input_mempath, idt) + ! + case ('STRING') + ! + ! -- did this param originate from sim namfile RECARRAY type + if (idt%in_record) then + ! + ! -- allocate 0 size CharacterStringType array + call mem_allocate(acharstr1d, LINELENGTH, 0, idt%mf6varname, & + input_mempath) + else + ! + ! -- allocate empty string + call mem_allocate(cstr, LINELENGTH, idt%mf6varname, input_mempath) + cstr = '' + end if + case default + write (errmsg, '(a,a)') & + 'Programming error. IdmLoad unhandled datatype: ', & + trim(idt%datatype) + call store_error(errmsg) + call store_error_filename(simfile) + end select + ! + ! -- return + return + end subroutine allocate_simnam_param + + !> @brief MODFLOW 6 mfsim.nam input context parameter allocation + !< + subroutine simnam_allocate() + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: get_isize, mem_allocate + use SimVariablesModule, only: idm_context + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH) :: input_mempath + type(ModflowInputType) :: mf6_input + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam, isize + ! + ! -- set memory path + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- create description of input + mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM') + ! + ! -- allocate sim namfile parameters if not in input context + do iparam = 1, size(mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => mf6_input%param_dfns(iparam) + ! + ! -- check if variable is already allocated + call get_isize(idt%mf6varname, input_mempath, isize) + ! + if (isize < 0) then + ! + ! -- allocate and set parameter + call allocate_simnam_param(input_mempath, idt) + ! + end if + end do + ! + ! -- return + return + end subroutine simnam_allocate + +end module IdmLoadModule diff --git a/src/Utilities/Idm/IdmLogger.f90 b/src/Utilities/Idm/IdmLogger.f90 index de88f8cba14..b5a52f6cdf5 100644 --- a/src/Utilities/Idm/IdmLogger.f90 +++ b/src/Utilities/Idm/IdmLogger.f90 @@ -14,6 +14,8 @@ module IdmLoggerModule private public :: idm_log_header public :: idm_log_close + public :: idm_log_period_header + public :: idm_log_period_close public :: idm_log_var interface idm_log_var @@ -21,7 +23,8 @@ module IdmLoggerModule idm_log_var_int1d, idm_log_var_int2d, & idm_log_var_int3d, idm_log_var_dbl, & idm_log_var_dbl1d, idm_log_var_dbl2d, & - idm_log_var_dbl3d, idm_log_var_str + idm_log_var_dbl3d, idm_log_var_str, & + idm_log_var_ts end interface idm_log_var contains @@ -47,10 +50,54 @@ subroutine idm_log_close(component, subcomponent, iout) integer(I4B), intent(in) :: iout if (iparamlog > 0 .and. iout > 0) then - write (iout, '(1x,a,/)') 'Loading input complete...' + write (iout, '(1x,a)') 'Loading input complete...' end if end subroutine idm_log_close + !> @ brief log a dynamic header message + !< + subroutine idm_log_period_header(component, iout) + use TdisModule, only: kper, kstp + character(len=*), intent(in) :: component !< component name + integer(I4B), intent(in) :: iout + + if (iparamlog > 0 .and. iout > 0 .and. kstp == 1) then + write (iout, '(/1x,a,i0,a)') 'IDP PERIOD ', kper, & + ' load for component: '//trim(component) + end if + end subroutine idm_log_period_header + + !> @ brief log the period closing message + !< + subroutine idm_log_period_close(iout) + use TdisModule, only: kstp + integer(I4B), intent(in) :: iout + + if (iparamlog > 0 .and. iout > 0 .and. kstp == 1) then + !backspace iout + write (iout, '(1x,a,/)') 'IDP component dynamic load complete...' + end if + end subroutine idm_log_period_close + + !> @ brief log the period closing message + !< + subroutine idm_log_var_ts(varname, mempath, iout, is_tas) + character(len=*), intent(in) :: varname !< variable name + character(len=*), intent(in) :: mempath !< variable memory path + integer(I4B), intent(in) :: iout + logical(LGP), intent(in) :: is_tas + + if (iparamlog > 0 .and. iout > 0) then + if (is_tas) then + write (iout, '(3x, a, ": ", a)') & + 'Time-array-series controlled dynamic variable detected', trim(varname) + else + write (iout, '(3x, a, ": ", a)') & + 'Time-series controlled dynamic variable detected', trim(varname) + end if + end if + end subroutine idm_log_var_ts + !> @brief Log type specific information logical !< subroutine idm_log_var_logical(p_mem, varname, mempath, iout) diff --git a/src/Utilities/Idm/IdmSimulation.f90 b/src/Utilities/Idm/IdmSimulation.f90 deleted file mode 100644 index ecb8da877a7..00000000000 --- a/src/Utilities/Idm/IdmSimulation.f90 +++ /dev/null @@ -1,246 +0,0 @@ -!> @brief This module contains the IdmSimulationModule -!! -!! This module contains the high-level routines for loading -!! sim namefile parameters into the input context -!! -!< -module IdmSimulationModule - - use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: LINELENGTH, LENMEMPATH - use SimModule, only: store_error - use SimVariablesModule, only: iout - use InputOutputModule, only: openfile, getunit - use InputDefinitionModule, only: InputParamDefinitionType - use ModflowInputModule, only: ModflowInputType, getModflowInput - use IdmMf6FileModule, only: input_load - - implicit none - private - public :: simnam_load - public :: load_models - -contains - - !> @brief load simulation summary info to input context - !< - subroutine simnam_load_dim() - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_allocate, mem_setptr - use SimVariablesModule, only: idm_context - use CharacterStringModule, only: CharacterStringType - character(len=LENMEMPATH) :: sim_mempath, simnam_mempath - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mtypes !< model types - type(CharacterStringType), dimension(:), contiguous, & - pointer :: etypes !< model types - integer(I4B), pointer :: nummodels => null() - integer(I4B), pointer :: numexchanges => null() - ! - ! -- set memory paths - sim_mempath = create_mem_path(component='SIM', context=idm_context) - simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- set pointers to loaded simnam arrays - call mem_setptr(mtypes, 'MTYPE', simnam_mempath) - call mem_setptr(etypes, 'EXGTYPE', simnam_mempath) - ! - ! -- allocate variables - call mem_allocate(nummodels, 'NUMMODELS', sim_mempath) - call mem_allocate(numexchanges, 'NUMEXCHANGES', sim_mempath) - ! - ! -- set values - nummodels = size(mtypes) - numexchanges = size(etypes) - ! - ! -- return - return - end subroutine simnam_load_dim - - !> @brief MODFLOW 6 mfsim.nam parameter set default value - !< - subroutine set_default_value(intvar, mf6varname) - use SimVariablesModule, only: isimcontinue, isimcheck - integer(I4B), pointer, intent(in) :: intvar - character(len=*), intent(in) :: mf6varname - character(len=LINELENGTH) :: errmsg - logical(LGP) :: terminate = .true. - ! - ! -- load defaults for keyword/integer types - select case (mf6varname) - ! - case ('CONTINUE') - intvar = isimcontinue - ! - case ('NOCHECK') - intvar = isimcheck - ! - case ('MAXERRORS') - intvar = 1000 !< MessageType max_message - ! - case ('MXITER') - intvar = 1 - ! - case ('PRINT_INPUT') - intvar = 0 - ! - case default - write (errmsg, '(a,a)') & - 'IdmSimulation set_default_value unhandled variable: ', & - trim(mf6varname) - call store_error(errmsg, terminate) - end select - ! - ! -- return - return - end subroutine set_default_value - - !> @brief MODFLOW 6 mfsim.nam input context parameter allocation - !< - subroutine simnam_allocate() - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: get_isize, mem_allocate - use SimVariablesModule, only: idm_context - use CharacterStringModule, only: CharacterStringType - character(len=LENMEMPATH) :: input_mempath - type(ModflowInputType) :: mf6_input - type(InputParamDefinitionType), pointer :: idt - integer(I4B) :: iparam, isize - logical(LGP) :: terminate = .true. - integer(I4B), pointer :: intvar - character(len=LINELENGTH), pointer :: cstr - type(CharacterStringType), dimension(:), & - pointer, contiguous :: acharstr1d - character(len=LINELENGTH) :: errmsg - ! - ! -- set memory path - input_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- create description of input - mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM') - ! - ! -- allocate sim namfile parameters if not in input context - do iparam = 1, size(mf6_input%param_dfns) - ! - ! -- assign param definition pointer - idt => mf6_input%param_dfns(iparam) - ! - ! -- check if variable is already allocated - call get_isize(idt%mf6varname, input_mempath, isize) - ! - if (isize < 0) then - ! - ! -- reset pointers - nullify (intvar) - nullify (acharstr1d) - nullify (cstr) - ! - select case (idt%datatype) - case ('KEYWORD', 'INTEGER') - ! - ! -- allocate and set default - call mem_allocate(intvar, idt%mf6varname, input_mempath) - call set_default_value(intvar, idt%mf6varname) - case ('STRING') - ! - ! -- did this param originate from sim namfile RECARRAY type - if (idt%in_record) then - ! - ! -- allocate 0 size CharacterStringType array - call mem_allocate(acharstr1d, LINELENGTH, 0, idt%mf6varname, & - input_mempath) - else - ! - ! -- allocate empty string - call mem_allocate(cstr, LINELENGTH, idt%mf6varname, input_mempath) - cstr = '' - end if - case default - write (errmsg, '(a,a)') & - 'IdmSimulation unhandled datatype: ', & - trim(idt%datatype) - call store_error(errmsg, terminate) - end select - end if - end do - ! - ! -- return - return - end subroutine simnam_allocate - - !> @brief source indenpendent model load entry point - !< - subroutine load_models(model_loadmask, iout) - ! -- modules - use IdmMf6FileModule, only: load_models_mf6 - ! -- dummy - integer(I4B), dimension(:), intent(in) :: model_loadmask - integer(I4B), intent(in) :: iout - ! -- locals - ! - ! -- mf6 blockfile model load - call load_models_mf6(model_loadmask, iout) - ! - ! -- return - return - end subroutine load_models - - function input_param_log() result(paramlog) - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_setptr - use SimVariablesModule, only: idm_context - character(len=LENMEMPATH) :: simnam_mempath - integer(I4B) :: paramlog - integer(I4B), pointer :: p - ! - ! -- read and set input value of PRINT_INPUT - simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) - call mem_setptr(p, 'PRINT_INPUT', simnam_mempath) - ! - paramlog = p - ! - ! -- return - return - end function input_param_log - - !> @brief MODFLOW 6 mfsim.nam input load routine - !< - subroutine simnam_load(paramlog) - use SimVariablesModule, only: simfile - use GenericUtilitiesModule, only: sim_message - integer(I4B), intent(inout) :: paramlog - integer(I4B) :: inunit - logical :: lexist - character(len=LINELENGTH) :: line - ! - ! -- load mfsim.nam if it exists - inquire (file=trim(adjustl(simfile)), exist=lexist) - ! - if (lexist) then - ! - ! -- write name of namfile to stdout - write (line, '(2(1x,a))') 'Using Simulation name file:', & - trim(adjustl(simfile)) - call sim_message(line, skipafter=1) - ! - ! -- open namfile and load to input context - inunit = getunit() - call openfile(inunit, iout, trim(adjustl(simfile)), 'NAM') - call input_load('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', inunit, iout) - close (inunit) - end if - ! - ! -- allocate any unallocated simnam params - call simnam_allocate() - ! - ! -- read and set input parameter logging keyword - paramlog = input_param_log() - ! - ! -- memload summary info - call simnam_load_dim() - ! - ! --return - return - end subroutine simnam_load - -end module IdmSimulationModule diff --git a/src/Utilities/Idm/InputDefinition.f90 b/src/Utilities/Idm/InputDefinition.f90 index c4dfa5f09bf..0d488e50d90 100644 --- a/src/Utilities/Idm/InputDefinition.f90 +++ b/src/Utilities/Idm/InputDefinition.f90 @@ -7,6 +7,7 @@ module InputDefinitionModule use KindModule, only: LGP + use ConstantsModule, only: LENVARNAME implicit none private @@ -24,13 +25,14 @@ module InputDefinitionModule character(len=100) :: subcomponent_type = '' character(len=100) :: blockname = '' character(len=100) :: tagname = '' - character(len=100) :: mf6varname = '' - character(len=100) :: datatype = '' + character(len=LENVARNAME) :: mf6varname = '' + character(len=120) :: datatype = '' character(len=100) :: shape = '' logical(LGP) :: required = .false. logical(LGP) :: in_record = .false. logical(LGP) :: preserve_case = .false. logical(LGP) :: layered = .false. + logical(LGP) :: timeseries = .false. end type InputParamDefinitionType !> @brief derived type for storing block information diff --git a/src/Utilities/Idm/InputLoadType.f90 b/src/Utilities/Idm/InputLoadType.f90 new file mode 100644 index 00000000000..24001ba17d6 --- /dev/null +++ b/src/Utilities/Idm/InputLoadType.f90 @@ -0,0 +1,417 @@ +!> @brief This module contains the InputLoadTypeModule +!! +!! This module defines types that support generic IDP +!! static and dynamic input loading. +!! +!< +module InputLoadTypeModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LINELENGTH, LENCOMPONENTNAME, LENMODELNAME + use ModflowInputModule, only: ModflowInputType + use ListModule, only: ListType + use InputDefinitionModule, only: InputParamDefinitionType + + implicit none + private + public :: StaticPkgLoadBaseType + public :: DynamicPkgLoadBaseType + public :: ModelDynamicPkgsType + public :: AddDynamicModelToList, GetDynamicModelFromList + public :: StaticPkgLoadType, DynamicPkgLoadType + + !> @brief derived type for source static load + !! + !! This derived type is a base concrete type for a model + !! package static load + !! + !< + type StaticPkgLoadType + type(ModflowInputType) :: mf6_input !< description of modflow6 input + character(len=LENCOMPONENTNAME) :: component_name !< name of component + character(len=LINELENGTH) :: component_input_name !< name of component input name, e.g. filename + character(len=LINELENGTH) :: input_name !< source name, e.g. name of input file + integer(I4B) :: iperblock + contains + procedure :: init => static_init + procedure :: destroy => static_destroy + end type StaticPkgLoadType + + !> @brief base abstract type for source static load + !! + !! IDM sources should extend and implement this type + !! + !< + type, abstract, extends(StaticPkgLoadType) :: StaticPkgLoadBaseType + contains + procedure(load_if), deferred :: load + end type StaticPkgLoadBaseType + + !> @brief derived type for source dynamic load + !! + !! This derived type is a base concrete type for a model + !! package dynamic (period) load + !! + !< + type :: DynamicPkgLoadType + type(ModflowInputType) :: mf6_input !< description of modflow6 input + character(len=LENMODELNAME) :: modelname !< name of model + character(len=LINELENGTH) :: modelfname !< name of model input file + character(len=LINELENGTH) :: sourcename !< source name, e.g. name of file + logical(LGP) :: readasarrays + integer(I4B) :: iperblock + integer(I4B) :: iout + contains + procedure :: init => dynamic_init + procedure :: df => dynamic_df + procedure :: ad => dynamic_ad + procedure :: destroy => dynamic_destroy + end type DynamicPkgLoadType + + !> @brief base abstract type for source dynamic load + !! + !! IDM sources should extend and implement this type + !! + !< + type, abstract, extends(DynamicPkgLoadType) :: DynamicPkgLoadBaseType + contains + procedure(period_load_if), deferred :: rp + end type DynamicPkgLoadBaseType + + !> @brief load interfaces for source static and dynamic types + !< + abstract interface + function load_if(this, iout) result(dynamic_loader) + import StaticPkgLoadBaseType, DynamicPkgLoadBaseType, I4B + class(StaticPkgLoadBaseType), intent(inout) :: this + integer(I4B), intent(in) :: iout + class(DynamicPkgLoadBaseType), pointer :: dynamic_loader + end function load_if + subroutine period_load_if(this) + import DynamicPkgLoadBaseType, I4B + class(DynamicPkgLoadBaseType), intent(inout) :: this + end subroutine + end interface + + !> @brief derived type for storing a dynamic package load list + !! + !! This derived type is used to store a list of package + !! dynamic load types for a model + !! + !< + type :: ModelDynamicPkgsType + character(len=LENMODELNAME) :: modelname !< name of model + character(len=LINELENGTH) :: modelfname !< name of model input file + type(ListType) :: pkglist !< list of pointers to model dynamic package loaders + integer(I4B) :: iout + contains + procedure :: init => dynamicpkgs_init + procedure :: add => dynamicpkgs_add + procedure :: get => dynamicpkgs_get + procedure :: rp => dynamicpkgs_rp + procedure :: df => dynamicpkgs_df + procedure :: ad => dynamicpkgs_ad + procedure :: size => dynamicpkgs_size + procedure :: destroy => dynamicpkgs_destroy + end type ModelDynamicPkgsType + +contains + + !> @brief initialize static package loader + !! + !< + subroutine static_init(this, mf6_input, component_name, component_input_name, & + input_name) + class(StaticPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: component_name + character(len=*), intent(in) :: component_input_name + character(len=*), intent(in) :: input_name + integer(I4B) :: iblock + ! + this%mf6_input = mf6_input + this%component_name = component_name + this%component_input_name = component_input_name + this%input_name = input_name + this%iperblock = 0 + ! + ! -- identify period block definition + do iblock = 1, size(mf6_input%block_dfns) + ! + if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') then + this%iperblock = iblock + exit + end if + end do + ! + return + end subroutine static_init + + subroutine static_destroy(this) + class(StaticPkgLoadType), intent(inout) :: this + ! + return + end subroutine static_destroy + + !> @brief initialize dynamic package loader + !! + !! Any managed memory pointed to from model/package context + !! must be allocated when derived dynamic loader is initialized. + !! + !< + subroutine dynamic_init(this, mf6_input, modelname, modelfname, source, & + iperblock, iout) + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + class(DynamicPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + ! + this%mf6_input = mf6_input + this%modelname = modelname + this%modelfname = modelfname + this%sourcename = source + this%iperblock = iperblock + this%iout = iout + ! + ! -- throw error and exit if not found + if (this%iperblock == 0) then + write (errmsg, '(a,a)') & + 'Programming error. (IDM) PERIOD block not found in '& + &'dynamic package input block dfns: ', & + trim(mf6_input%subcomponent_name) + call store_error(errmsg) + call store_error_filename(this%sourcename) + else + ! + this%readasarrays = (.not. mf6_input%block_dfns(iperblock)%aggregate) + end if + ! + ! -- return + return + end subroutine dynamic_init + + !> @brief dynamic package loader define + !! + !< + subroutine dynamic_df(this) + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! override in derived type + ! + return + end subroutine dynamic_df + + !> @brief dynamic package loader advance + !! + !< + subroutine dynamic_ad(this) + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! override in derived type + ! + return + end subroutine dynamic_ad + + !> @brief dynamic package loader destroy + !! + !< + subroutine dynamic_destroy(this) + use MemoryManagerExtModule, only: memorylist_remove + use SimVariablesModule, only: idm_context + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! -- deallocate package static and dynamic input context + call memorylist_remove(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, & + idm_context) + ! + return + end subroutine dynamic_destroy + + !> @brief model dynamic packages init + !! + !< + subroutine dynamicpkgs_init(this, modelname, modelfname, iout) + class(ModelDynamicPkgsType), intent(inout) :: this + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + integer(I4B), intent(in) :: iout + ! + this%modelname = modelname + this%modelfname = modelfname + this%iout = iout + ! + return + end subroutine dynamicpkgs_init + + !> @brief add package to model dynamic packages list + !! + !< + subroutine dynamicpkgs_add(this, dynamic_pkg) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer, intent(inout) :: dynamic_pkg + class(*), pointer :: obj + ! + obj => dynamic_pkg + call this%pkglist%add(obj) + ! + return + end subroutine dynamicpkgs_add + + !> @brief retrieve package from model dynamic packages list + !! + !< + function dynamicpkgs_get(this, idx) result(res) + class(ModelDynamicPkgsType), intent(inout) :: this + integer(I4B), intent(in) :: idx + class(DynamicPkgLoadBaseType), pointer :: res + class(*), pointer :: obj + ! + nullify (res) + obj => this%pkglist%GetItem(idx) + ! + if (associated(obj)) then + select type (obj) + class is (DynamicPkgLoadBaseType) + res => obj + end select + end if + ! + return + end function dynamicpkgs_get + + !> @brief read and prepare model dynamic packages + !! + !< + subroutine dynamicpkgs_rp(this) + use IdmLoggerModule, only: idm_log_period_header, idm_log_period_close + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + call idm_log_period_header(this%modelname, this%iout) + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%rp() + end do + ! + call idm_log_period_close(this%iout) + ! + return + end subroutine dynamicpkgs_rp + + !> @brief define model dynamic packages + !! + !< + subroutine dynamicpkgs_df(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%df() + end do + ! + return + end subroutine dynamicpkgs_df + + !> @brief advance model dynamic packages + !! + !< + subroutine dynamicpkgs_ad(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%ad() + end do + ! + return + end subroutine dynamicpkgs_ad + + !> @brief get size of model dynamic packages list + !! + !< + function dynamicpkgs_size(this) result(size) + class(ModelDynamicPkgsType), intent(inout) :: this + integer(I4B) :: size + ! + size = this%pkglist%Count() + ! + return + end function dynamicpkgs_size + + !> @brief destroy model dynamic packages object + !! + !< + subroutine dynamicpkgs_destroy(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%destroy() + deallocate (dynamic_pkg) + nullify (dynamic_pkg) + end do + ! + call this%pkglist%Clear() + ! + return + end subroutine dynamicpkgs_destroy + + !> @brief add model dynamic packages object to list + !! + !< + subroutine AddDynamicModelToList(list, model_dynamic) + ! -- dummy variables + type(ListType), intent(inout) :: list !< package list + class(ModelDynamicPkgsType), pointer, intent(inout) :: model_dynamic + ! -- local variables + class(*), pointer :: obj + ! + obj => model_dynamic + call list%Add(obj) + ! + ! -- return + return + end subroutine AddDynamicModelToList + + !> @brief get model dynamic packages object from list + !! + !< + function GetDynamicModelFromList(list, idx) result(res) + ! -- dummy variables + type(ListType), intent(inout) :: list !< spd list + integer(I4B), intent(in) :: idx !< package number + class(ModelDynamicPkgsType), pointer :: res + ! -- local variables + class(*), pointer :: obj + ! + ! -- initialize res + res => null() + ! + ! -- get the object from the list + obj => list%GetItem(idx) + if (associated(obj)) then + select type (obj) + class is (ModelDynamicPkgsType) + res => obj + end select + end if + ! + ! -- return + return + end function GetDynamicModelFromList + +end module InputLoadTypeModule diff --git a/src/Utilities/Idm/ModelPackageInputs.f90 b/src/Utilities/Idm/ModelPackageInputs.f90 index 25ea01001a6..9e57f8910d0 100644 --- a/src/Utilities/Idm/ModelPackageInputs.f90 +++ b/src/Utilities/Idm/ModelPackageInputs.f90 @@ -7,8 +7,9 @@ module ModelPackageInputsModule use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & - LENPACKAGETYPE, LENPACKAGENAME + LENPACKAGETYPE, LENPACKAGENAME, LENCOMPONENTNAME use SimModule, only: store_error, store_error_filename use SimVariablesModule, only: iout use ArrayHandlersModule, only: expandarray @@ -16,46 +17,8 @@ module ModelPackageInputsModule implicit none private - public :: NIUNIT_GWF, NIUNIT_GWT public :: ModelPackageInputsType - ! -- GWF base package types, ordered for memload - integer(I4B), parameter :: GWF_NBASEPKG = 50 - character(len=LENPACKAGETYPE), dimension(GWF_NBASEPKG) :: GWF_BASEPKG - data GWF_BASEPKG/'DIS6 ', 'DISV6', 'DISU6', ' ', ' ', & ! 5 - &'NPF6 ', 'BUY6 ', 'VSC6 ', 'GNC6 ', ' ', & ! 10 - &'HFB6 ', 'STO6 ', 'IC6 ', ' ', ' ', & ! 15 - &'MVR6 ', 'OC6 ', 'OBS6 ', ' ', ' ', & ! 20 - &30*' '/ ! 50 - - ! -- GWF multi package types, ordered for memload - integer(I4B), parameter :: GWF_NMULTIPKG = 50 - character(len=LENPACKAGETYPE), dimension(GWF_NMULTIPKG) :: GWF_MULTIPKG - data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', ' ', & ! 5 - &'RCH6 ', 'EVT6 ', 'CHD6 ', 'CSUB6', ' ', & ! 10 - &'MAW6 ', 'SFR6 ', 'LAK6 ', 'UZF6 ', 'API6 ', & ! 15 - &35*' '/ ! 50 - - ! -- GWT base package types, ordered for memload - integer(I4B), parameter :: GWT_NBASEPKG = 50 - character(len=LENPACKAGETYPE), dimension(GWT_NBASEPKG) :: GWT_BASEPKG - data GWT_BASEPKG/'DIS6 ', 'DISV6', 'DISU6', ' ', ' ', & ! 5 - &'IC6 ', 'FMI6 ', 'MST6 ', 'ADV6 ', ' ', & ! 10 - &'DSP6 ', 'SSM6 ', 'MVT6 ', 'OC6 ', ' ', & ! 15 - &'OBS6 ', ' ', ' ', ' ', ' ', & ! 20 - &30*' '/ ! 50 - - ! -- GWT multi package types, ordered for memload - integer(I4B), parameter :: GWT_NMULTIPKG = 50 - character(len=LENPACKAGETYPE), dimension(GWT_NMULTIPKG) :: GWT_MULTIPKG - data GWT_MULTIPKG/'CNC6 ', 'SRC6 ', 'LKT6 ', 'IST6 ', ' ', & ! 5 - &'SFT6 ', 'MWT6 ', 'UZT6 ', 'API6 ', ' ', & ! 10 - &40*' '/ ! 50 - - ! -- size of supported model package arrays - integer(I4B), parameter :: NIUNIT_GWF = GWF_NBASEPKG + GWF_NMULTIPKG - integer(I4B), parameter :: NIUNIT_GWT = GWT_NBASEPKG + GWT_NMULTIPKG - !> @brief derived type for loadable package type !! !! This derived type is used to store package instance @@ -63,10 +26,10 @@ module ModelPackageInputsModule !! !< type :: LoadablePackageType - ! -- package type, e.g. 'DIS6 or CHD6' + ! -- package type, e.g. 'DIS6' or 'CHD6' character(len=LENPACKAGETYPE) :: pkgtype - ! -- component type, e.g. 'DIS or CHD' - character(len=LENFTYPE) :: component_type + ! -- component type, e.g. 'DIS' or 'CHD' + character(len=LENCOMPONENTNAME) :: subcomponent_type ! -- package instance attribute arrays character(len=LINELENGTH), dimension(:), allocatable :: filenames character(len=LENPACKAGENAME), dimension(:), allocatable :: pkgnames @@ -92,8 +55,9 @@ module ModelPackageInputsModule character(len=LINELENGTH) :: modelfname character(len=LENMODELNAME) :: modelname ! -- component type - character(len=LENFTYPE) :: component_type ! -- e.g. 'GWF' - ! -- model mempath + character(len=LENCOMPONENTNAME) :: component_type ! -- e.g. 'GWF' + ! -- mempaths + character(len=LENMEMPATH) :: input_mempath character(len=LENMEMPATH) :: model_mempath ! -- pointers to created managed memory type(CharacterStringType), dimension(:), contiguous, & @@ -123,101 +87,29 @@ module ModelPackageInputsModule contains - !> @brief set supported package types for model - !< - subroutine supported_model_packages(mtype, pkgtypes, numpkgs) - ! -- modules - ! -- dummy - character(len=LENFTYPE), intent(in) :: mtype - character(len=LENPACKAGETYPE), dimension(:), allocatable, & - intent(inout) :: pkgtypes - integer(I4B), intent(inout) :: numpkgs - ! -- local - ! - select case (mtype) - case ('GWF6') - numpkgs = GWF_NBASEPKG + GWF_NMULTIPKG - allocate (pkgtypes(numpkgs)) - pkgtypes = [GWF_BASEPKG, GWF_MULTIPKG] - ! - case ('GWT6') - numpkgs = GWT_NBASEPKG + GWT_NMULTIPKG - allocate (pkgtypes(numpkgs)) - pkgtypes = [GWT_BASEPKG, GWT_MULTIPKG] - ! - case default - end select - ! - ! -- return - return - end subroutine supported_model_packages - - !> @brief component from package or model type - !< - function component_type(pkgtype) !result(componenttype) - ! -- modules - ! -- dummy - character(len=LENPACKAGETYPE), intent(in) :: pkgtype - ! -- return - character(len=LENFTYPE) :: component_type - ! -- local - integer(I4B) :: i, ilen - ! - component_type = '' - ! - ilen = len_trim(pkgtype) - do i = 1, ilen - if (pkgtype(i:i) == '6') then - write (component_type, '(a)') trim(pkgtype(1:i - 1)) - end if - end do - ! - ! -- return - return - end function component_type - !> @brief does model support multiple instances of this package type !< function multi_pkg_type(mtype_component, ptype_component, pkgtype) & result(multi_pkg) ! -- modules use IdmDfnSelectorModule, only: idm_integrated, idm_multi_package + use ModelPackageInputModule, only: multi_package_type ! -- dummy - character(len=LENFTYPE), intent(in) :: mtype_component - character(len=LENFTYPE), intent(in) :: ptype_component + character(len=LENCOMPONENTNAME), intent(in) :: mtype_component + character(len=LENCOMPONENTNAME), intent(in) :: ptype_component character(len=LENFTYPE), intent(in) :: pkgtype ! -- return logical(LGP) :: multi_pkg ! -- local - integer(I4B) :: n ! multi_pkg = .false. ! if (idm_integrated(mtype_component, ptype_component)) then - ! multi_pkg = idm_multi_package(mtype_component, ptype_component) ! else + multi_pkg = multi_package_type(mtype_component, ptype_component, pkgtype) ! - select case (mtype_component) - case ('GWF') - do n = 1, GWF_NMULTIPKG - if (GWF_MULTIPKG(n) == pkgtype) then - multi_pkg = .true. - exit - end if - end do - ! - case ('GWT') - do n = 1, GWT_NMULTIPKG - if (GWT_MULTIPKG(n) == pkgtype) then - multi_pkg = .true. - exit - end if - end do - ! - case default - end select end if ! ! -- return @@ -226,17 +118,19 @@ end function multi_pkg_type !> @brief create a new package type !< - subroutine pkgtype_create(this, modelname, pkgtype) + subroutine pkgtype_create(this, modeltype, modelname, pkgtype) ! -- modules + use SourceCommonModule, only: idm_subcomponent_type ! -- dummy class(LoadablePackageType) :: this + character(len=*), intent(in) :: modeltype character(len=*), intent(in) :: modelname character(len=*), intent(in) :: pkgtype ! -- local ! ! -- initialize this%pkgtype = pkgtype - this%component_type = component_type(pkgtype) + this%subcomponent_type = idm_subcomponent_type(modeltype, pkgtype) this%pnum = 0 ! ! -- allocate arrays @@ -256,8 +150,10 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & ! -- modules use MemoryManagerModule, only: mem_allocate use MemoryHelperModule, only: create_mem_path + use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context use IdmDfnSelectorModule, only: idm_integrated, idm_multi_package + use SourceCommonModule, only: idm_subcomponent_name ! -- dummy class(LoadablePackageType) :: this character(len=*), intent(in) :: modelname @@ -267,7 +163,7 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & character(len=*), intent(in) :: pkgname integer(I4B), intent(in) :: iout ! -- local - character(len=LENPACKAGENAME) :: sc_name + character(len=LENPACKAGENAME) :: sc_name, pname character(len=LENMEMPATH) :: mempath character(len=LINELENGTH), pointer :: cstr ! @@ -283,17 +179,18 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & this%pkgnames(this%pnum) = pkgname this%inunits(this%pnum) = 0 ! + ! -- set pkgname if empty + if (this%pkgnames(this%pnum) == '') then + write (pname, '(a,i0)') trim(this%subcomponent_type)//'-', this%pnum + this%pkgnames(this%pnum) = pname + end if + ! ! -- set up input context for model - if (idm_integrated(mtype_component, this%component_type)) then + if (idm_integrated(mtype_component, this%subcomponent_type)) then ! ! -- set subcomponent name - if (idm_multi_package(mtype_component, this%component_type)) then - ! - sc_name = pkgname - else - ! - sc_name = this%component_type - end if + sc_name = idm_subcomponent_name(mtype_component, this%subcomponent_type, & + this%pkgnames(this%pnum)) ! ! -- create and store the mempath this%mempaths(this%pnum) = & @@ -303,6 +200,7 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & mempath = create_mem_path(modelname, sc_name, idm_context) call mem_allocate(cstr, LINELENGTH, 'INPUT_FNAME', mempath) cstr = filename + ! else ! ! -- set mempath empty @@ -338,6 +236,8 @@ subroutine modelpkgs_init(this, modeltype, modelfname, modelname, iout) use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_allocate use SimVariablesModule, only: idm_context + use SourceCommonModule, only: idm_component_type + use ModelPackageInputModule, only: supported_model_packages ! -- dummy class(ModelPackageInputsType) :: this character(len=*), intent(in) :: modeltype @@ -350,13 +250,14 @@ subroutine modelpkgs_init(this, modeltype, modelfname, modelname, iout) this%modeltype = modeltype this%modelfname = modelfname this%modelname = modelname - this%component_type = component_type(modeltype) + this%component_type = idm_component_type(modeltype) this%iout = iout ! ! -- allocate and set model supported package types call supported_model_packages(modeltype, this%cunit, this%niunit) ! - ! -- set model memory path + ! -- set memory paths + this%input_mempath = create_mem_path(this%modelname, 'NAM', idm_context) this%model_mempath = create_mem_path(component=this%modelname, & context=idm_context) ! @@ -390,7 +291,6 @@ subroutine modelpkgs_create(this, ftypes) character(len=LENPACKAGETYPE) :: ftype integer(I4B) :: n, m logical(LGP) :: found - character(len=LINELENGTH) :: errmsg ! ! -- allocate allocate (cunit_idxs(0)) @@ -398,7 +298,7 @@ subroutine modelpkgs_create(this, ftypes) ! -- identify input packages and check that each is supported do n = 1, size(ftypes) ! - ! -- type from model name file packages block + ! -- type from model nam file packages block ftype = ftypes(n) found = .false. ! @@ -440,7 +340,8 @@ subroutine modelpkgs_create(this, ftypes) ! ! -- create sorted LoadablePackageType object list do n = 1, size(cunit_idxs) - call this%pkglist(n)%create(this%modelname, this%cunit(cunit_idxs(n))) + call this%pkglist(n)%create(this%modeltype, this%modelname, & + this%cunit(cunit_idxs(n))) end do ! ! -- cleanup @@ -482,9 +383,7 @@ end subroutine modelpkgs_add !< subroutine modelpkgs_addpkgs(this) ! -- modules - use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_setptr - use SimVariablesModule, only: idm_context ! -- dummy class(ModelPackageInputsType) :: this ! -- local @@ -494,17 +393,13 @@ subroutine modelpkgs_addpkgs(this) pointer :: fnames !< file names type(CharacterStringType), dimension(:), contiguous, & pointer :: pnames !< package names - character(len=LENMEMPATH) :: input_mempath character(len=LINELENGTH) :: ftype, fname, pname integer(I4B) :: n ! - ! -- set input memory path - input_mempath = create_mem_path(this%modelname, 'NAM', idm_context) - ! ! -- set pointers to input context model package attribute arrays - call mem_setptr(ftypes, 'FTYPE', input_mempath) - call mem_setptr(fnames, 'FNAME', input_mempath) - call mem_setptr(pnames, 'PNAME', input_mempath) + call mem_setptr(ftypes, 'FTYPE', this%input_mempath) + call mem_setptr(fnames, 'FNAME', this%input_mempath) + call mem_setptr(pnames, 'PNAME', this%input_mempath) ! ! -- create the package list call this%create(ftypes) @@ -517,9 +412,6 @@ subroutine modelpkgs_addpkgs(this) fname = fnames(n) pname = pnames(n) ! - ! TODO: name pkg here if not provided, this is expected to cause - ! failures for multi-pkg types when names aren't provided - ! ! -- add this instance to package list call this%add(ftype, fname, pname) end do @@ -539,7 +431,6 @@ function modelpkgs_pkgcount(this) result(pnum) integer(I4B) :: pnum ! -- local integer(I4B) :: n - character(len=LINELENGTH) :: errmsg ! ! -- initialize pnum = 0 @@ -548,7 +439,7 @@ function modelpkgs_pkgcount(this) result(pnum) do n = 1, size(this%pkglist) ! if (multi_pkg_type(this%component_type, & - this%pkglist(n)%component_type, & + this%pkglist(n)%subcomponent_type, & this%pkglist(n)%pkgtype)) then ! multiple instances ok else diff --git a/src/Utilities/Idm/ModflowInput.f90 b/src/Utilities/Idm/ModflowInput.f90 index d8c316ecfc0..74e63c35da8 100644 --- a/src/Utilities/Idm/ModflowInput.f90 +++ b/src/Utilities/Idm/ModflowInput.f90 @@ -32,12 +32,13 @@ module ModflowInputModule !! !< type ModflowInputType - character(len=LENPACKAGETYPE) :: pkgtype + character(len=LENCOMPONENTNAME) :: pkgtype character(len=LENCOMPONENTNAME) :: component_type character(len=LENCOMPONENTNAME) :: subcomponent_type character(len=LENCOMPONENTNAME) :: component_name character(len=LENCOMPONENTNAME) :: subcomponent_name character(len=LENMEMPATH) :: mempath + character(len=LENMEMPATH) :: component_mempath type(InputBlockDefinitionType), dimension(:), pointer :: block_dfns type(InputParamDefinitionType), dimension(:), pointer :: aggregate_dfns type(InputParamDefinitionType), dimension(:), pointer :: param_dfns @@ -47,29 +48,120 @@ module ModflowInputModule !> @brief function to return ModflowInputType !< - function getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, subcomponent_name) & + function getModflowInput(pkgtype, component_type, subcomponent_type, & + component_name, subcomponent_name, filename) & result(mf6_input) character(len=*), intent(in) :: pkgtype !< package type to load, such as DIS6, DISV6, NPF6 character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE + character(len=*), optional, intent(in) :: filename !< optional name of package input file type(ModflowInputType) :: mf6_input + character(len=LENPACKAGETYPE) :: dfn_subcomponent_type + ! -- set subcomponent type + if (present(filename)) then + dfn_subcomponent_type = update_sc_type(pkgtype, filename, component_type, & + subcomponent_type) + else + dfn_subcomponent_type = trim(subcomponent_type) + end if + + ! -- set input attributes mf6_input%pkgtype = trim(pkgtype) mf6_input%component_type = trim(component_type) - mf6_input%subcomponent_type = trim(subcomponent_type) + mf6_input%subcomponent_type = trim(dfn_subcomponent_type) mf6_input%component_name = trim(component_name) mf6_input%subcomponent_name = trim(subcomponent_name) + ! -- set mempaths mf6_input%mempath = create_mem_path(component_name, subcomponent_name, & idm_context) + mf6_input%component_mempath = create_mem_path(component=component_name, & + context=idm_context) - mf6_input%block_dfns => block_definitions(component_type, subcomponent_type) - mf6_input%aggregate_dfns => aggregate_definitions(component_type, & - subcomponent_type) - mf6_input%param_dfns => param_definitions(component_type, subcomponent_type) + ! -- set input definitions + mf6_input%block_dfns => block_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) + mf6_input%aggregate_dfns => aggregate_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) + mf6_input%param_dfns => param_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) end function getModflowInput + function update_sc_type(filetype, filename, component_type, subcomponent_type) & + result(sc_type) + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + ! -- result + character(len=LENPACKAGETYPE) :: sc_type + ! + sc_type = subcomponent_type + ! + select case (subcomponent_type) + case ('RCH', 'EVT', 'SCP') + sc_type = read_as_arrays(filetype, filename, component_type, & + subcomponent_type) + case default + end select + ! + ! -- return + return + end function update_sc_type + + function read_as_arrays(filetype, filename, component_type, subcomponent_type) & + result(sc_type) + use ConstantsModule, only: LINELENGTH + use InputOutputModule, only: openfile, getunit + use BlockParserModule, only: BlockParserType + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + ! -- result + character(len=LENPACKAGETYPE) :: sc_type + type(BlockParserType) :: parser + integer(I4B) :: ierr, inunit + logical(LGP) :: isfound + logical(LGP) :: endOfBlock + character(len=LINELENGTH) :: keyword + ! + sc_type = subcomponent_type + ! + inunit = getunit() + ! + call openfile(inunit, 0, trim(adjustl(filename)), filetype, & + 'FORMATTED', 'SEQUENTIAL', 'OLD') + ! + call parser%Initialize(inunit, 0) + ! + ! -- get options block + call parser%GetBlock('OPTIONS', isfound, ierr, & + supportOpenClose=.true., blockRequired=.false.) + ! + ! -- parse options block if detected + if (isfound) then + do + call parser%GetNextLine(endOfBlock) + ! + if (endOfBlock) exit + ! + call parser%GetStringCaps(keyword) + ! + if (keyword == 'READASARRAYS') then + write (sc_type, '(a)') trim(subcomponent_type)//'A' + exit + end if + end do + end if + ! + call parser%clear() + ! + ! -- return + return + end function read_as_arrays + end module ModflowInputModule diff --git a/src/Utilities/Idm/SourceCommon.f90 b/src/Utilities/Idm/SourceCommon.f90 new file mode 100644 index 00000000000..3ba4640a2bf --- /dev/null +++ b/src/Utilities/Idm/SourceCommon.f90 @@ -0,0 +1,436 @@ +!> @brief This module contains the SourceCommonModule +!! +!! This module contains source independent input +!! processing helper routines. +!! +!< +module SourceCommonModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & + LENPACKAGETYPE, LENPACKAGENAME, LENCOMPONENTNAME + use SimModule, only: store_error, store_error_filename + + implicit none + private + public :: package_source_type + public :: idm_component_type, idm_subcomponent_type, idm_subcomponent_name + public :: set_model_shape + public :: get_shape_from_string + public :: mem_allocate_naux + public :: file_ext + public :: ifind_charstr + public :: filein_fname + +contains + + !> @brief source identifier from model namfile FNAME array + !! + !! Return the source type for a package listed in the + !! model nam file packages block FNAME field. + !! + !< + function package_source_type(sourcename) result(sourcetype) + ! -- modules + use InputOutputModule, only: upcase + ! -- dummy + character(len=*), intent(in) :: sourcename + ! -- result + character(len=LENPACKAGENAME) :: sourcetype + ! -- locals + ! + sourcetype = sourcename + call upcase(sourcetype) + ! + select case (sourcetype) + case default + sourcetype = 'MF6FILE' + end select + ! + ! -- return + return + end function package_source_type + + !> @brief component from package or model type + !! + !! Return the component type typically derived from package file type, + !! i.e. return GWF when input is GWF6. This function checks the + !! resultant commponent type and throws a terminating error if not + !! supported by IDM in some capacity. + !! + !< + function idm_component_type(component) result(component_type) + ! -- modules + use IdmDfnSelectorModule, only: idm_component + ! -- dummy + character(len=*), intent(in) :: component + ! -- return + character(len=LENCOMPONENTNAME) :: component_type + ! -- local + integer(I4B) :: i, ilen, idx + ! + ! -- initialize + component_type = '' + idx = 0 + ! + ilen = len_trim(component) + do i = 1, ilen + if (component(i:i) == '6' .or. component(i:i) == '-') then + else + idx = idx + 1 + component_type(idx:idx) = component(i:i) + end if + end do + ! + if (.not. idm_component(component_type)) then + write (errmsg, '(a)') & + 'IDP input error, unrecognized component: "'//trim(component)//'"' + call store_error(errmsg, .true.) + end if + ! + ! -- return + return + end function idm_component_type + + !> @brief component from package or model type + !! + !! Return the subcomponent type typically derived from package file type, + !! i.e. return CHD when input is CHD6. Note this function is called on + !! file types that are both idm integrated and not and should not set + !! an error based on this difference. + !! + !< + function idm_subcomponent_type(component, subcomponent) & + result(subcomponent_type) + ! -- modules + ! -- dummy + character(len=*), intent(in) :: component !< component, e.g. GWF6 + character(len=*), intent(in) :: subcomponent !< subcomponent, e.g. CHD6 + ! -- return + character(len=LENCOMPONENTNAME) :: subcomponent_type + ! -- local + character(len=LENCOMPONENTNAME) :: component_type + integer(I4B) :: i, ilen, idx + ! + ! -- initialize + subcomponent_type = '' + idx = 0 + ! + ! -- verify component + component_type = idm_component_type(component) + ! + ilen = len_trim(subcomponent) + do i = 1, ilen + if (subcomponent(i:i) == '6' .or. subcomponent(i:i) == '-') then + else + idx = idx + 1 + subcomponent_type(idx:idx) = subcomponent(i:i) + end if + end do + ! + ! -- return + return + end function idm_subcomponent_type + + !> @brief model package subcomponent name + !! + !! Return the IDM component name, which is the pacage type for + !! base packages and the package name for mutli package (i.e. + !! stress) types. + !! + !< + function idm_subcomponent_name(component_type, subcomponent_type, sc_name) & + result(subcomponent_name) + ! -- modules + use IdmDfnSelectorModule, only: idm_multi_package + ! -- dummy + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: sc_name + ! -- return + character(len=LENPACKAGENAME) :: subcomponent_name + ! -- local + ! + subcomponent_name = '' + ! + if (idm_multi_package(component_type, subcomponent_type)) then + ! + subcomponent_name = sc_name + else + ! + subcomponent_name = subcomponent_type + end if + ! + ! -- return + return + end function idm_subcomponent_name + + !> @brief input file extension + !! + !! Return the input file extension, or an empty string if + !! not identified. + !! + !< + function file_ext(filename) result(ext) + ! -- modules + use IdmDfnSelectorModule, only: idm_multi_package + ! -- dummy + character(len=*), intent(in) :: filename + ! -- return + character(len=LENPACKAGETYPE) :: ext + ! -- local + integer(I4B) :: i, istart, istop + ! + ! -- initialize + ext = '' + istart = 0 + istop = len_trim(filename) + ! + ! -- identify '.' character position from back of string + do i = istop, 1, -1 + if (filename(i:i) == '.') then + istart = i + exit + end if + end do + ! + ! + if (istart > 0) then + ext = filename(istart + 1:istop) + end if + ! + ! -- return + return + end function file_ext + + subroutine get_shape_from_string(shape_string, array_shape, memoryPath) + use InputOutputModule, only: parseline + use MemoryManagerModule, only: mem_setptr + character(len=*), intent(in) :: shape_string + integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + integer(I4B) :: ndim + integer(I4B) :: i + integer(I4B), pointer :: int_ptr + character(len=16), dimension(:), allocatable :: array_shape_string + character(len=:), allocatable :: shape_string_copy + ! + ! -- parse the string into multiple words + shape_string_copy = trim(shape_string)//' ' + call ParseLine(shape_string_copy, ndim, array_shape_string) + allocate (array_shape(ndim)) + ! + ! -- find shape in memory manager and put into array_shape + do i = 1, ndim + call mem_setptr(int_ptr, array_shape_string(i), memoryPath) + array_shape(i) = int_ptr + end do + ! + ! -- return + return + end subroutine get_shape_from_string + + !> @brief routine for setting the model shape + !! + !! The model shape must be set in the memory manager because + !! individual packages need to know the shape of the arrays + !! to read. + !! + !< + subroutine set_model_shape(ftype, fname, model_mempath, dis_mempath, & + model_shape) + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + character(len=*), intent(in) :: ftype + character(len=*), intent(in) :: fname + character(len=*), intent(in) :: model_mempath + character(len=*), intent(in) :: dis_mempath + integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape + integer(I4B), pointer :: ndim1 + integer(I4B), pointer :: ndim2 + integer(I4B), pointer :: ndim3 + integer(I4B), pointer :: ncelldim + integer(I4B) :: dim1_size, dim2_size, dim3_size + ! + ! -- allocate and set model shape in model input context + select case (ftype) + case ('DIS6') + ! + call get_isize('NLAY', dis_mempath, dim1_size) + call get_isize('NROW', dis_mempath, dim2_size) + call get_isize('NCOL', dis_mempath, dim3_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NLAY" not found.' + call store_error(errmsg) + end if + ! + if (dim2_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NROW" not found.' + call store_error(errmsg) + end if + ! + if (dim3_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NCOL" not found.' + call store_error(errmsg) + end if + ! + if (dim1_size >= 1 .and. dim2_size >= 1 .and. dim3_size >= 1) then + call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NLAY', dis_mempath) + call mem_setptr(ndim2, 'NROW', dis_mempath) + call mem_setptr(ndim3, 'NCOL', dis_mempath) + model_shape = [ndim1, ndim2, ndim3] + else + call store_error_filename(fname) + end if + ! + case ('DISV6') + ! + call get_isize('NLAY', dis_mempath, dim1_size) + call get_isize('NCPL', dis_mempath, dim2_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NLAY" not found.' + call store_error(errmsg) + end if + ! + if (dim2_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NCPL" not found.' + call store_error(errmsg) + end if + ! + if (dim1_size >= 1 .and. dim2_size >= 1) then + call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NLAY', dis_mempath) + call mem_setptr(ndim2, 'NCPL', dis_mempath) + model_shape = [ndim1, ndim2] + else + call store_error_filename(fname) + end if + case ('DISU6') + ! + call get_isize('NODES', dis_mempath, dim1_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NODES" not found.' + call store_error(errmsg) + call store_error_filename(fname) + end if + ! + call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NODES', dis_mempath) + model_shape = [ndim1] + end select + ! + ! -- allocate and set ncelldim in model input context + call mem_allocate(ncelldim, 'NCELLDIM', model_mempath) + ncelldim = size(model_shape) + ! + ! -- return + return + end subroutine set_model_shape + + subroutine mem_allocate_naux(mempath) + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + character(len=*), intent(in) :: mempath + integer(I4B), pointer :: naux => null() + integer(I4B) :: isize + ! + ! -- allocate optional input scalars locally + call get_isize('NAUX', mempath, isize) + if (isize < 0) then + call mem_allocate(naux, 'NAUX', mempath) + naux = 0 + end if + ! + ! -- return + return + end subroutine mem_allocate_naux + + function ifind_charstr(array, str) + use CharacterStringModule, only: CharacterStringType + ! -- Find the first array element containing str + ! -- Return -1 if not found. + implicit none + ! -- return + integer(I4B) :: ifind_charstr + ! -- dummy + type(CharacterStringType), dimension(:), intent(in) :: array + character(len=*) :: str + character(len=LINELENGTH) :: compare_str + ! -- local + integer(I4B) :: i + ! + ! -- initialize + ifind_charstr = -1 + ! + findloop: do i = 1, size(array) + compare_str = array(i) + if (compare_str == str) then + ifind_charstr = i + exit findloop + end if + end do findloop + ! + ! -- return + return + end function ifind_charstr + + !> @brief enforce and set a single input filename provided via FILEIN keyword + !! + !! Set a FILEIN filename provided via an OPTIONS block. + !! Only use this function if a maximum of one FILEIN file name + !! string is expected. + !! + !! Return true if single FILEIN file name found and set, return + !! false if FILEIN tag not found. + !! + !< + function filein_fname(filename, tagname, input_mempath, input_fname) & + result(found) + use SimModule, only: store_error, store_error_filename + use MemoryManagerModule, only: mem_setptr, get_isize + use CharacterStringModule, only: CharacterStringType + character(len=*), intent(inout) :: filename + character(len=*), intent(in) :: tagname + character(len=*), intent(in) :: input_mempath + character(len=*), intent(in) :: input_fname + logical(LGP) :: found + type(CharacterStringType), dimension(:), pointer, & + contiguous :: fnames + integer(I4B) :: isize + ! + ! -- initialize + found = .false. + filename = '' + ! + call get_isize(tagname, input_mempath, isize) + ! + if (isize > 0) then + ! + if (isize /= 1) then + errmsg = 'Multiple FILEIN keywords detected for tag "'//trim(tagname)// & + '" in OPTIONS block. Only one entry allowed.' + call store_error(errmsg) + call store_error_filename(input_fname) + end if + ! + call mem_setptr(fnames, tagname, input_mempath) + ! + filename = fnames(1) + found = .true. + ! + end if + ! + ! -- return + return + end function filein_fname + +end module SourceCommonModule diff --git a/src/Utilities/Idm/SourceLoad.F90 b/src/Utilities/Idm/SourceLoad.F90 new file mode 100644 index 00000000000..a41a4393464 --- /dev/null +++ b/src/Utilities/Idm/SourceLoad.F90 @@ -0,0 +1,254 @@ +!> @brief This module contains the SourceLoadModule +!! +!! This module contains the routines needed to generate +!! a loader object for an input source and routines +!! that distribute processing to a particular source. +!! +!< +module SourceLoadModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & + LENPACKAGETYPE, LENPACKAGENAME + use SimModule, only: store_error, store_error_filename + use ModflowInputModule, only: ModflowInputType, getModflowInput + + implicit none + private + public :: create_input_loader + public :: open_source_file + public :: load_modelnam, load_simnam + public :: remote_model_ndim + +contains + + !> @brief factory function to create and setup model package static loader + !< + function create_input_loader(component_type, subcomponent_type, & + component_name, subcomponent_name, input_type, & + input_fname, component_fname) result(loader) + use SourceCommonModule, only: package_source_type, idm_subcomponent_name + use InputLoadTypeModule, only: StaticPkgLoadBaseType + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: component_name + character(len=*), intent(in) :: subcomponent_name + character(len=*), intent(in) :: input_type + character(len=*), intent(in) :: input_fname + character(len=*), intent(in) :: component_fname + class(StaticPkgLoadBaseType), pointer :: loader + type(ModflowInputType) :: mf6_input + character(len=LENPACKAGENAME) :: source_type + character(len=LENPACKAGENAME) :: sc_name + ! + ! -- set subcomponent name + sc_name = idm_subcomponent_name(component_type, subcomponent_type, & + subcomponent_name) + ! + ! -- create description of input + mf6_input = getModflowInput(input_type, component_type, subcomponent_type, & + component_name, sc_name, input_fname) + ! + ! -- set package source + source_type = package_source_type(input_fname) + ! + ! -- set source loader for model package + loader => package_loader(source_type) + ! + ! -- initialize loader + call loader%init(mf6_input, component_name, component_fname, input_fname) + ! + ! -- return + return + end function create_input_loader + + !> @brief allocate source model package static loader + !< + function package_loader(source_type) result(loader) + use InputLoadTypeModule, only: StaticPkgLoadBaseType + use IdmMf6FileModule, only: Mf6FileStaticPkgLoadType + character(len=*), intent(inout) :: source_type + class(Mf6FileStaticPkgLoadType), pointer :: mf6file_loader + class(StaticPkgLoadBaseType), pointer :: loader + ! + ! -- initialize + nullify (loader) + ! + ! -- allocate derived object + select case (source_type) + case ('MF6FILE') + allocate (mf6file_loader) + loader => mf6file_loader + case default + write (errmsg, '(a)') & + 'Simulation package input source type "'//trim(source_type)// & + '" not currently supported.' + call store_error(errmsg, .true.) + end select + ! + ! -- return + return + end function package_loader + + function open_source_file(pkgtype, filename, modelfname, iout) result(fd) + use SourceCommonModule, only: package_source_type + use IdmMf6FileModule, only: open_mf6file + character(len=*), intent(in) :: pkgtype + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: modelfname + integer(I4B), intent(in) :: iout + integer(I4B) :: fd + character(len=LENPACKAGENAME) :: source_type + ! + ! -- initialize + fd = 0 + ! + ! -- set source type + source_type = package_source_type(filename) + ! + select case (source_type) + case ('MF6FILE') + fd = open_mf6file(pkgtype, filename, modelfname, iout) + case default + end select + ! + ! -- return + return + end function open_source_file + + subroutine load_modelnam(mtype, mfname, mname, iout) + use SimVariablesModule, only: simfile + use SourceCommonModule, only: package_source_type, idm_component_type + use IdmMf6FileModule, only: input_load + character(len=*), intent(in) :: mtype + character(len=*), intent(in) :: mfname + character(len=*), intent(in) :: mname + integer(I4B), intent(in) :: iout + type(ModflowInputType) :: mf6_input + character(len=LENPACKAGENAME) :: source_type + ! + ! -- set source type + source_type = package_source_type(mfname) + ! + ! -- create description of input + mf6_input = getModflowInput(mtype, idm_component_type(mtype), 'NAM', & + mname, 'NAM', mfname) + ! + select case (source_type) + case ('MF6FILE') + call input_load(mfname, mf6_input, simfile, iout) + case default + end select + ! + ! -- return + return + end subroutine load_modelnam + + subroutine load_simnam() + use SimVariablesModule, only: simfile, iout + use MessageModule, only: write_message + use IdmMf6FileModule, only: input_load + type(ModflowInputType) :: mf6_input + character(len=LINELENGTH) :: line + logical :: lexist + ! + ! -- load mfsim.nam if it exists + inquire (file=trim(adjustl(simfile)), exist=lexist) + ! + if (lexist) then + ! + ! -- write name of namfile to stdout + write (line, '(2(1x,a))') 'Using Simulation name file:', & + trim(adjustl(simfile)) + call write_message(line, skipafter=1) + ! + ! -- create description of input + mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', simfile) + ! + ! -- open namfile and load to input context + call input_load(simfile, mf6_input, simfile, iout) + end if + ! + ! -- return + return + end subroutine load_simnam + + function remote_model_ndim(mtype, mfname) result(ncelldim) + use SourceCommonModule, only: package_source_type + use ConstantsModule, only: LINELENGTH + use InputOutputModule, only: openfile, getunit + use BlockParserModule, only: BlockParserType + character(len=*), intent(in) :: mtype + character(len=*), intent(in) :: mfname + integer(I4B) :: ncelldim + character(len=LENPACKAGENAME) :: source_type + type(BlockParserType) :: parser + integer(I4B) :: ierr, inunit + logical(LGP) :: isfound, endOfBlock + character(len=LINELENGTH) :: ptype + ! + ! -- initialize + ncelldim = 0 + ! + ! -- set source type + source_type = package_source_type(mfname) + ! + select case (source_type) + case ('MF6FILE') + ! + ! -- open name file + inunit = getunit() + call openfile(inunit, 0, trim(adjustl(mfname)), mtype, & + 'FORMATTED', 'SEQUENTIAL', 'OLD') + ! + ! -- initialize parser + call parser%Initialize(inunit, 0) + ! + ! -- get options block + call parser%GetBlock('OPTIONS', isfound, ierr, & + supportOpenClose=.true., blockRequired=.false.) + ! -- iterate through options + if (isfound) then + do + call parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + end do + end if + ! + ! -- get packages block + call parser%GetBlock('PACKAGES', isfound, ierr, & + supportOpenClose=.true., blockRequired=.true.) + if (isfound) then + ! -- read through packages + do + call parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + ! + call parser%GetStringCaps(ptype) + ! + select case (ptype) + case ('DIS6') + ncelldim = 3 + exit + case ('DISV6') + ncelldim = 2 + exit + case ('DISU6') + ncelldim = 1 + exit + case default + end select + end do + end if + ! + call parser%clear() + ! + case default + end select + ! + ! -- return + return + end function remote_model_ndim + +end module SourceLoadModule diff --git a/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 b/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 new file mode 100644 index 00000000000..081f31f1579 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 @@ -0,0 +1,34 @@ +!> @brief This module contains the AsciiInputLoadTypeModule +!! +!! This module defines an abstract type that support generic +!! IDP dynamic input loading for traditional MODFLOW 6 ascii +!! files. +!! +!< +module AsciiInputLoadTypeModule + + use KindModule, only: DP, I4B, LGP + use InputLoadTypeModule, only: DynamicPkgLoadType + use BlockParserModule, only: BlockParserType + + implicit none + private + public :: AsciiDynamicPkgLoadBaseType + + !> @brief base abstract type for ascii source dynamic load + !! + !< + type, abstract, extends(DynamicPkgLoadType) :: AsciiDynamicPkgLoadBaseType + contains + procedure(ascii_period_load_if), deferred :: rp + end type AsciiDynamicPkgLoadBaseType + + abstract interface + subroutine ascii_period_load_if(this, parser) + import AsciiDynamicPkgLoadBaseType, BlockParserType + class(AsciiDynamicPkgLoadBaseType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser !< block parser + end subroutine + end interface + +end module AsciiInputLoadTypeModule diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 4e844c23fed..365cafcdefb 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -1,25 +1,31 @@ !> @brief This module contains the IdmMf6FileModule !! -!! This module contains the high-level routines for loading -!! a MODFLOW input file to the input context. +!! This module contains high-level routines for loading +!! MODFLOW 6 ASCII source input. !! !< module IdmMf6FileModule use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, & - LENPACKAGENAME, LENFTYPE, LENPACKAGETYPE + LENPACKAGENAME, LENFTYPE, LENPACKAGETYPE, & + LENAUXNAME, LENBOUNDNAME, LENTIMESERIESNAME, & + LENLISTLABEL, LENVARNAME, DNODATA, & + DZERO, IZERO use SimModule, only: store_error, store_error_filename use InputOutputModule, only: openfile, getunit use BlockParserModule, only: BlockParserType use ModflowInputModule, only: ModflowInputType, getModflowInput use CharacterStringModule, only: CharacterStringType - use ModelPackageInputsModule, only: ModelPackageInputsType + use InputLoadTypeModule, only: StaticPkgLoadBaseType, DynamicPkgLoadBaseType + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType implicit none private - public :: input_load ! TODO: remove - public :: load_models_mf6 + public :: input_load + public :: Mf6FileStaticPkgLoadType, Mf6FileDynamicPkgLoadType + public :: open_mf6file !> @brief derived type for storing package loader !! @@ -39,11 +45,38 @@ subroutine IPackageLoad(parser, mf6_input, iout) use BlockParserModule, only: BlockParserType use ModflowInputModule, only: ModflowInputType type(BlockParserType), intent(inout) :: parser !< block parser - type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType object that describes the input + type(ModflowInputType), intent(in) :: mf6_input !< description of input integer(I4B), intent(in) :: iout !< unit number for output end subroutine IPackageLoad end interface + !> @brief MF6File static loader derived type + !< + type, extends(StaticPkgLoadBaseType) :: Mf6FileStaticPkgLoadType + contains + procedure :: init => static_init + procedure :: load => static_load + procedure :: destroy => static_destroy + end type Mf6FileStaticPkgLoadType + + !> @brief MF6File dynamic loader derived type + !< + type, extends(DynamicPkgLoadBaseType) :: Mf6FileDynamicPkgLoadType + type(BlockParserType), pointer :: parser !< parser for MF6File period blocks + integer(I4B), pointer :: iper => null() + integer(I4B), pointer :: ionper => null() + class(AsciiDynamicPkgLoadBaseType), pointer :: block_loader => null() + contains + procedure :: init => dynamic_init + procedure :: df => dynamic_df + procedure :: ad => dynamic_ad + procedure :: set => dynamic_set + procedure :: rp => dynamic_rp + procedure :: read_ionper => dynamic_read_ionper + procedure :: create_loader => dynamic_create_loader + procedure :: destroy => dynamic_destroy + end type Mf6FileDynamicPkgLoadType + contains !> @brief generic procedure to MODFLOW 6 load routine @@ -51,286 +84,369 @@ end subroutine IPackageLoad subroutine generic_mf6_load(parser, mf6_input, iout) use LoadMf6FileModule, only: idm_load type(BlockParserType), intent(inout) :: parser !< block parser - type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType object that describes the input + type(ModflowInputType), intent(in) :: mf6_input !< description of input integer(I4B), intent(in) :: iout !< unit number for output - call idm_load(parser, mf6_input%pkgtype, & - mf6_input%component_type, mf6_input%subcomponent_type, & - mf6_input%component_name, mf6_input%subcomponent_name, & - iout) + call idm_load(parser, mf6_input, iout) end subroutine generic_mf6_load !> @brief input load for traditional mf6 simulation input file !< - subroutine input_load(pkgtype, & - component_type, subcomponent_type, & - component_name, subcomponent_name, & - inunit, iout) - character(len=*), intent(in) :: pkgtype !< pkgtype to load, such as DIS6, DISV6, NPF6 - character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT - character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF - character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL - character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE - integer(I4B), intent(in) :: inunit !< unit number for input + subroutine input_load(filename, mf6_input, component_filename, iout, & + mf6_parser) + character(len=*), intent(in) :: filename + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: component_filename !< component (e.g. model) filename integer(I4B), intent(in) :: iout !< unit number for output - type(BlockParserType), allocatable :: parser !< block parser - type(ModflowInputType) :: mf6_input + type(BlockParserType), pointer, optional, intent(inout) :: mf6_parser + type(BlockParserType), allocatable, target :: parser !< block parser type(PackageLoad) :: pkgloader + integer(I4B) :: inunit ! - ! -- create description of input - mf6_input = getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, & - subcomponent_name) - ! - ! -- set mf6 parser based package loader by file type - select case (pkgtype) + ! -- set parser based package loader by file type + select case (mf6_input%pkgtype) case default + ! + ! -- open input file + inunit = open_mf6file(mf6_input%pkgtype, filename, component_filename, iout) + ! + ! -- allocate and initialize parser allocate (parser) call parser%Initialize(inunit, iout) + ! + ! -- set load interface pkgloader%load_package => generic_mf6_load + ! end select ! ! -- invoke the selected load routine call pkgloader%load_package(parser, mf6_input, iout) ! - ! -- close files and deallocate - if (allocated(parser)) then - !call parser%clear() - deallocate (parser) + ! -- generate a dynamic loader parser if requested + if (present(mf6_parser)) then + ! + ! -- create dynamic parser + allocate (mf6_parser, source=parser) + else + ! + ! -- clear parser file handles + call parser%clear() end if ! + ! -- cleanup + deallocate (parser) + ! ! -- return return end subroutine input_load - !> @brief input load model idm supported package files + !> @brief static loader init !< - subroutine load_model_pkgfiles(model_pkg_inputs, iout) - ! -- modules - use IdmDfnSelectorModule, only: idm_integrated, idm_multi_package - ! -- dummy - type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + subroutine static_init(this, mf6_input, component_name, component_input_name, & + input_name) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: component_name + character(len=*), intent(in) :: component_input_name + character(len=*), intent(in) :: input_name + ! + call this%StaticPkgLoadType%init(mf6_input, component_name, & + component_input_name, input_name) + ! + end subroutine static_init + + !> @brief load routine for static loader + !< + function static_load(this, iout) result(period_loader) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this integer(I4B), intent(in) :: iout - ! -- locals - integer(I4B) :: n, m - character(len=LENPACKAGETYPE) :: pkgtype - character(len=LENPACKAGENAME) :: sc_name + class(DynamicPkgLoadBaseType), pointer :: period_loader + class(Mf6FileDynamicPkgLoadType), pointer :: mf6_loader => null() + type(BlockParserType), pointer :: parser => null() + ! + ! -- initialize + nullify (period_loader) ! - do n = 1, size(model_pkg_inputs%pkglist) + ! -- load model package to input context + if (this%iperblock > 0) then + ! + ! -- package is dynamic, allocate loader + allocate (mf6_loader) + ! + ! -- load static input + call input_load(this%input_name, this%mf6_input, & + this%component_input_name, iout, parser) + ! + ! -- initialize dynamic loader + call mf6_loader%init(this%mf6_input, this%component_name, & + this%component_input_name, this%input_name, & + this%iperblock, iout) + ! + ! -- set parser + call mf6_loader%set(parser) ! - ! -- this list package type - pkgtype = model_pkg_inputs%pkglist(n)%pkgtype + ! -- set return pointer to base dynamic loader + period_loader => mf6_loader ! - ! -- load all idm integrated package type file instances - do m = 1, model_pkg_inputs%pkglist(n)%pnum - ! - if (idm_integrated(model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type)) then - ! - ! -- set subcomponent name - if (idm_multi_package(model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type)) then - ! - sc_name = model_pkg_inputs%pkglist(n)%pkgnames(m) - else - ! - sc_name = model_pkg_inputs%pkglist(n)%component_type - end if - ! - ! -- load model package to input context - call input_load(pkgtype, model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type, & - model_pkg_inputs%modelname, sc_name, & - model_pkg_inputs%pkglist(n)%inunits(m), iout) - ! - ! -- close file and update unit number - close (model_pkg_inputs%pkglist(n)%inunits(m)) - model_pkg_inputs%pkglist(n)%inunits(m) = 0 - ! - else - ! Not an IDM supported package, leave inunit open - end if - end do - end do + else + ! + ! -- load static input + call input_load(this%input_name, this%mf6_input, & + this%component_input_name, iout) + end if ! ! -- return return - end subroutine load_model_pkgfiles + end function static_load - !> @brief open all model package files + !> @brief static loader destroy !< - subroutine open_model_pkgfiles(model_pkg_inputs, iout) - ! -- modules - ! -- dummy - type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + subroutine static_destroy(this) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this + ! + call this%StaticPkgLoadType%destroy() + ! + end subroutine static_destroy + + !> @brief dynamic loader init + !< + subroutine dynamic_init(this, mf6_input, modelname, modelfname, source, & + iperblock, iout) + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use MemoryManagerModule, only: mem_allocate + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock integer(I4B), intent(in) :: iout - ! -- locals - integer(I4B) :: n, m - character(len=LINELENGTH) :: filename - character(len=LENPACKAGETYPE) :: filetype - character(len=LINELENGTH) :: errmsg ! - do n = 1, size(model_pkg_inputs%pkglist) - ! - ! -- this package type - filetype = model_pkg_inputs%pkglist(n)%pkgtype - ! - ! -- open each package type file instance - do m = 1, model_pkg_inputs%pkglist(n)%pnum - ! - ! -- set filename - filename = model_pkg_inputs%pkglist(n)%filenames(m) - ! - if (filename /= '') then - ! - ! -- get unit number, update object and open file - model_pkg_inputs%pkglist(n)%inunits(m) = getunit() - call openfile(model_pkg_inputs%pkglist(n)%inunits(m), iout, & - trim(adjustl(filename)), filetype, 'FORMATTED', & - 'SEQUENTIAL', 'OLD') - ! - else - write (errmsg, '(a,a,a,a,a)') & - 'Package file unspecified, cannot load model package & - &[model=', trim(model_pkg_inputs%modelname), & - ', type=', trim(filetype), '].' - call store_error(errmsg) - call store_error_filename(model_pkg_inputs%modelfname) - end if - end do - end do - ! - ! -- returh + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! + call mem_allocate(this%iper, 'IPER', this%mf6_input%mempath) + call mem_allocate(this%ionper, 'IONPER', this%mf6_input%mempath) + ! + this%iper = 0 + this%ionper = 0 + ! + ! -- allocate and initialize loader + call this%create_loader() + ! + ! -- return + return + end subroutine dynamic_init + + !> @brief dynamic loader set parser object + !< + subroutine dynamic_set(this, parser) + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser + ! + ! -- set the parser + this%parser => parser + ! + ! -- return + return + end subroutine dynamic_set + + !> @brief define routine for dynamic loader + !< + subroutine dynamic_df(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + ! -- read first iper + call this%read_ionper() + ! + call this%block_loader%df() + ! + ! -- return return - end subroutine open_model_pkgfiles + end subroutine dynamic_df - !> @brief load and make pkg info available to models + !> @brief advance routine for dynamic loader !< - subroutine modelpkgs_load(mtype, mfname, mname, iout) + subroutine dynamic_ad(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + call this%block_loader%ad() + ! + ! -- return + return + end subroutine dynamic_ad + + !> @brief read and prepare routine for dynamic loader + !< + subroutine dynamic_rp(this) ! -- modules + use TdisModule, only: kper, nper + use MemoryManagerModule, only: mem_setptr ! -- dummy - character(len=*), intent(in) :: mtype - character(len=*), intent(in) :: mfname - character(len=*), intent(in) :: mname - integer(I4B), intent(in) :: iout + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this ! -- locals - type(ModelPackageInputsType) :: model_pkg_inputs - ! - ! -- set baseline state for model package instances - call model_pkg_inputs%init(mtype, mfname, mname, iout) ! - ! -- open model package files - call open_model_pkgfiles(model_pkg_inputs, iout) + ! -- check if ready to load + if (this%ionper /= kper) return ! - ! -- load model idm integrated package files - call load_model_pkgfiles(model_pkg_inputs, iout) + ! -- dynamic load + call this%block_loader%rp(this%parser) ! - ! -- load descriptions of packages to model input context - call model_pkg_inputs%memload() + ! -- update loaded iper + this%iper = kper ! - ! -- cleanup - call model_pkg_inputs%destroy() + ! -- read next iper + if (kper < nper) then + call this%read_ionper() + else + this%ionper = nper + 1 + end if ! ! -- return return - end subroutine modelpkgs_load + end subroutine dynamic_rp - !> @brief input load a single model namfile and model package files + !> @brief dynamic loader read ionper of next period block !< - subroutine model_load(mtype, mfname, mname, iout) + subroutine dynamic_read_ionper(this) ! -- modules - use SimVariablesModule, only: simfile + use TdisModule, only: kper, nper ! -- dummy - character(len=*), intent(in) :: mtype - character(len=*), intent(in) :: mfname - character(len=*), intent(in) :: mname - integer(I4B), intent(in) :: iout + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this ! -- locals - character(len=LINELENGTH) :: errmsg - integer(I4B) :: inunit + character(len=LINELENGTH) :: line + logical(LGP) :: isblockfound + integer(I4B) :: ierr + character(len=*), parameter :: fmtblkerr = & + &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" ! - ! -- open namfile - inunit = getunit() - call openfile(inunit, iout, trim(mfname), 'NAM') + call this%parser%GetBlock('PERIOD', isblockfound, ierr, & + supportOpenClose=.true., & + blockRequired=.false.) ! - select case (mtype) - case ('GWF6') + ! -- set first period block IPER + if (isblockfound) then ! - ! -- load model namfile to the input context - call input_load('GWF6', 'GWF', 'NAM', mname, 'NAM', inunit, iout) + this%ionper = this%parser%GetInteger() ! - ! -- load and create descriptions of model package files - call modelpkgs_load(mtype, mfname, mname, iout) - ! - case ('GWT6') - ! - call input_load('GWT6', 'GWT', 'NAM', mname, 'NAM', inunit, iout) + if (this%ionper <= this%iper) then + write (errmsg, '(a, i0, a, i0, a, i0, a)') & + 'Error in stress period ', kper, & + '. Period numbers not increasing. Found ', this%ionper, & + ' but last period block was assigned ', this%iper, '.' + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if ! - call modelpkgs_load(mtype, mfname, mname, iout) + else ! - case default - write (errmsg, '(a,a,a,a,a)') & - 'Unknown simulation model type & - &[model=', trim(mname), & - ', type=', trim(mtype), '].' - call store_error(errmsg) - call store_error_filename(simfile) - end select + ! -- PERIOD block not found + if (ierr < 0) then + ! -- End of file found; data applies for remainder of simulation. + this%ionper = nper + 1 + else + ! -- Found invalid block + call this%parser%GetCurrentLine(line) + write (errmsg, fmtblkerr) adjustl(trim(line)) + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if + end if ! - ! -- close namfile - close (inunit) + ! -- return + return + end subroutine dynamic_read_ionper + + !> @brief allocate a dynamic loader based on load context + !< + subroutine dynamic_create_loader(this) + use StressListInputModule, only: StressListInputType + use StressGridInputModule, only: StressGridInputType + ! -- dummy + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + class(StressListInputType), pointer :: list_loader + class(StressGridInputType), pointer :: grid_loader + ! + ! -- allocate and set loader + if (this%readasarrays) then + allocate (grid_loader) + this%block_loader => grid_loader + else + allocate (list_loader) + this%block_loader => list_loader + end if + ! + ! -- initialize loader + call this%block_loader%init(this%mf6_input, & + this%modelname, & + this%modelfname, & + this%sourcename, & + this%iperblock, & + this%iout) ! ! -- return return - end subroutine model_load + end subroutine dynamic_create_loader - !> @brief input load model namfiles and model package files + !> @brief dynamic loader destroy !< - subroutine load_models_mf6(model_loadmask, iout) + subroutine dynamic_destroy(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + ! -- deallocate input context + !call this%DynamicPkgLoadType%destroy() + ! + ! -- deallocate loader + call this%block_loader%destroy() + deallocate (this%block_loader) + ! + ! -- deallocate parser + call this%parser%clear() + deallocate (this%parser) + ! + ! -- deallocate input context + call this%DynamicPkgLoadType%destroy() + ! + ! -- return + return + end subroutine dynamic_destroy + + !> @brief open a model package files + !< + function open_mf6file(filetype, filename, component_fname, iout) result(inunit) ! -- modules - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_setptr - use CharacterStringModule, only: CharacterStringType - use SimVariablesModule, only: idm_context ! -- dummy - integer(I4B), dimension(:), intent(in) :: model_loadmask + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: component_fname integer(I4B), intent(in) :: iout + ! -- return + integer(I4B) :: inunit ! -- locals - character(len=LENMEMPATH) :: input_mempath - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mtypes !< model types - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mfnames !< model file names - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mnames !< model names - character(len=LINELENGTH) :: mtype, mfname - character(len=LENMODELNAME) :: mname - integer(I4B) :: n - ! - ! -- set input memory path - input_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- set pointers to input context model attribute arrays - call mem_setptr(mtypes, 'MTYPE', input_mempath) - call mem_setptr(mfnames, 'MFNAME', input_mempath) - call mem_setptr(mnames, 'MNAME', input_mempath) - ! - do n = 1, size(mtypes) - ! - ! -- attributes for this model - mtype = mtypes(n) - mfname = mfnames(n) - mname = mnames(n) + ! + ! -- initialize + inunit = 0 + ! + if (filename /= '') then ! - ! -- load model namfile - if (model_loadmask(n) > 0) then - call model_load(mtype, mfname, mname, iout) - end if - end do + ! -- get unit number, update object and open file + inunit = getunit() + call openfile(inunit, iout, trim(adjustl(filename)), filetype, & + 'FORMATTED', 'SEQUENTIAL', 'OLD') + else + write (errmsg, '(a,a,a)') & + 'File unspecified, cannot load model or package & + &type "', trim(filetype), '".' + call store_error(errmsg) + call store_error_filename(component_fname) + end if ! ! -- return return - end subroutine load_models_mf6 + end function open_mf6file end module IdmMf6FileModule diff --git a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 index 41c7d84b622..bd33599f244 100644 --- a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 @@ -8,9 +8,9 @@ module LoadMf6FileModule use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME use SimVariablesModule, only: errmsg use SimModule, only: store_error + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME use BlockParserModule, only: BlockParserType use LayeredArrayReaderModule, only: read_dbl1d_layered, & read_dbl2d_layered, & @@ -43,29 +43,17 @@ module LoadMf6FileModule !! memory context location of the memory manager. !! !< - subroutine idm_load(parser, pkgtype, & - component_type, subcomponent_type, & - component_name, subcomponent_name, & - iout) + subroutine idm_load(parser, mf6_input, iout) use SimVariablesModule, only: idm_context + use SourceCommonModule, only: set_model_shape, mem_allocate_naux type(BlockParserType), intent(inout) :: parser !< block parser - character(len=*), intent(in) :: pkgtype !< file type to load, such as DIS6, DISV6, NPF6 - character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT - character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF - character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL - character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType integer(I4B), intent(in) :: iout !< unit number for output integer(I4B) :: iblock !< consecutive block number as defined in definition file - type(ModflowInputType) :: mf6_input !< ModflowInputType character(len=LENMEMPATH) :: componentMemPath integer(I4B), dimension(:), contiguous, pointer :: mshape => null() character(len=LINELENGTH) :: filename !< input filename ! - ! -- construct input object - mf6_input = getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, & - subcomponent_name) - ! ! -- model shape memory path componentMemPath = create_mem_path(component=mf6_input%component_name, & context=idm_context) @@ -79,14 +67,17 @@ subroutine idm_load(parser, pkgtype, & ! ! -- process blocks do iblock = 1, size(mf6_input%block_dfns) + ! + ! -- don't load dynamic input data + if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') exit + ! + ! -- load the block call parse_block(parser, mf6_input, iblock, mshape, filename, iout, .false.) ! - ! -- set model shape if discretization dimensions have been read - if (mf6_input%block_dfns(iblock)%blockname == 'DIMENSIONS' .and. & - pkgtype(1:3) == 'DIS') then - call set_model_shape(mf6_input%pkgtype, componentMemPath, & - mf6_input%mempath, mshape) - end if + ! -- + call block_post_process(mf6_input, mf6_input%block_dfns(iblock)%blockname, & + mshape, filename) + ! end do ! ! -- close logging statement @@ -94,6 +85,41 @@ subroutine idm_load(parser, pkgtype, & mf6_input%subcomponent_name, iout) end subroutine idm_load + subroutine block_post_process(mf6_input, blockname, mshape, filename) + use SourceCommonModule, only: set_model_shape, mem_allocate_naux + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType + character(len=*), intent(in) :: blockname + integer(I4B), dimension(:), contiguous, pointer, intent(inout) :: mshape + character(len=*), intent(in) :: filename + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam + ! + select case (blockname) + case ('OPTIONS') + ! -- allocate naux and set to 0 if not allocated + do iparam = 1, size(mf6_input%param_dfns) + idt => mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'OPTIONS' .and. & + idt%tagname == 'AUXILIARY') then + call mem_allocate_naux(mf6_input%mempath) + exit + end if + end do + case ('DIMENSIONS') + ! -- set model shape if discretization dimensions have been read + if (mf6_input%pkgtype(1:3) == 'DIS') then + call set_model_shape(mf6_input%pkgtype, filename, & + mf6_input%component_mempath, & + mf6_input%mempath, mshape) + end if + case default + end select + ! + ! -- return + return + end subroutine block_post_process + !> @brief procedure to load a block !! !! Use parser to load information from a block into the __INPUT__ @@ -218,7 +244,8 @@ subroutine parse_iofile_tag(parser, mf6_input, iblock, mshape, tag, found, & mf6_input%subcomponent_type, & mf6_input%block_dfns(iblock)%blockname, & words(4), filename) - call load_string_type(parser, idt, mf6_input%mempath, iout) + ! + call load_io_tag(parser, idt, mf6_input%mempath, words(3), iout) ! ! -- io tag loaded found = .true. @@ -293,7 +320,11 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & call parser%DevOpt() end if case ('STRING') - call load_string_type(parser, idt, mf6_input%mempath, iout) + if (idt%shape == 'NAUX') then + call load_auxvar_names(parser, idt, mf6_input%mempath, iout) + else + call load_string_type(parser, idt, mf6_input%mempath, iout) + end if case ('INTEGER') call load_integer_type(parser, idt, mf6_input%mempath, iout) case ('INTEGER1D') @@ -318,7 +349,7 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & ! ! -- continue line if in same record if (idt%in_record) then - + ! ! recursively call parse tag again to read rest of line call parse_tag(parser, mf6_input, iblock, mshape, filename, iout, .true.) end if @@ -327,6 +358,37 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & return end subroutine parse_tag + function block_index_dfn(mf6_input, iblock, iout) result(idt) + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType + integer(I4B), intent(in) :: iblock !< consecutive block number as defined in definition file + integer(I4B), intent(in) :: iout !< unit number for output + type(InputParamDefinitionType) :: idt !< input data type object describing this record + character(len=LENVARNAME) :: varname + integer(I4B) :: ilen + character(len=3) :: block_suffix = 'NUM' + ! + ! -- assign first column as the block number + ilen = len_trim(mf6_input%block_dfns(iblock)%blockname) + ! + if (ilen > (LENVARNAME - len(block_suffix))) then + varname = & + mf6_input%block_dfns(iblock)% & + blockname(1:(LENVARNAME - len(block_suffix)))//block_suffix + else + varname = trim(mf6_input%block_dfns(iblock)%blockname)//block_suffix + end if + ! + idt%component_type = trim(mf6_input%component_type) + idt%subcomponent_type = trim(mf6_input%subcomponent_type) + idt%blockname = trim(mf6_input%block_dfns(iblock)%blockname) + idt%tagname = varname + idt%mf6varname = varname + idt%datatype = 'INTEGER' + ! + ! -- return + return + end function block_index_dfn + !> @brief parse a structured array record into memory manager !! !! A structarray is similar to a numpy recarray. It it used to @@ -346,16 +408,16 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & character(len=*), intent(in) :: filename !< input filename integer(I4B), intent(in) :: iout !< unit number for output type(InputParamDefinitionType), pointer :: idt !< input data type object describing this record - integer(I4B) :: blocknum, iwords, ilen + type(InputParamDefinitionType), target :: blockvar_idt + integer(I4B) :: blocknum, iwords integer(I4B), pointer :: nrow => null() + integer(I4B) :: nrows, nrowsread integer(I4B) :: icol integer(I4B) :: ncol integer(I4B) :: nwords character(len=16), dimension(:), allocatable :: words type(StructArrayType), pointer :: struct_array character(len=:), allocatable :: parse_str - character(len=100) :: varname - character(len=3) :: block_suffix = 'num' ! ! -- set input definition for this block idt => get_aggregate_definition_type(mf6_input%aggregate_dfns, & @@ -381,11 +443,15 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & ! -- use shape to set the max num of rows if (idt%shape /= '') then call mem_setptr(nrow, idt%shape, mf6_input%mempath) + nrows = nrow + else + nrows = 0 end if ! ! -- create a structured array - struct_array => constructStructArray(ncol, nrow, blocknum) - nullify (nrow) + struct_array => constructStructArray(mf6_input, ncol, nrows, blocknum, & + mf6_input%mempath, & + mf6_input%component_mempath) ! ! -- create structarray vectors for each column do icol = 1, ncol @@ -394,27 +460,16 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & if (blocknum > 0) then if (icol == 1) then ! - ! -- assign first column as the block number - ilen = len_trim(mf6_input%block_dfns(iblock)%blockname) - ! - if (ilen > (LENVARNAME - len(block_suffix))) then - varname = & - mf6_input%block_dfns(iblock)% & - blockname(1:(LENVARNAME - len(block_suffix)))//block_suffix - else - varname = trim(mf6_input%block_dfns(iblock)%blockname)//block_suffix - end if + blockvar_idt = block_index_dfn(mf6_input, iblock, iout) + idt => blockvar_idt ! - call struct_array%mem_create_vector(icol, 'INTEGER', & - varname, varname, & - mf6_input%mempath, '', & - .false.) + call struct_array%mem_create_vector(icol, idt) ! ! -- continue as this column managed by internally SA object cycle end if ! - ! -- set indexex (where first column is blocknum) + ! -- set indexes (where first column is blocknum) iwords = icol else ! @@ -430,13 +485,11 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & words(iwords), filename) ! ! -- allocate variable in memory manager - call struct_array%mem_create_vector(icol, idt%datatype, idt%mf6varname, & - idt%tagname, mf6_input%mempath, & - idt%shape, idt%preserve_case) + call struct_array%mem_create_vector(icol, idt) end do ! ! -- read the structured array - call struct_array%read_from_parser(parser, iout) + nrowsread = struct_array%read_from_parser(parser, .false., iout) ! ! -- destroy the structured array reader call destructStructArray(struct_array) @@ -475,6 +528,76 @@ subroutine load_string_type(parser, idt, memoryPath, iout) return end subroutine load_string_type + !> @brief load type string + !< + subroutine load_io_tag(parser, idt, memoryPath, which, iout) + use MemoryManagerModule, only: mem_allocate, mem_reallocate, & + mem_setptr, get_isize + use CharacterStringModule, only: CharacterStringType + type(BlockParserType), intent(inout) :: parser !< block parser + type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + character(len=*), intent(in) :: which + integer(I4B), intent(in) :: iout !< unit number for output + character(len=LINELENGTH) :: cstr + type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d + integer(I4B) :: ilen, isize, idx + ilen = LINELENGTH + if (which == 'FILEIN') then + call get_isize(idt%mf6varname, memoryPath, isize) + if (isize < 0) then + call mem_allocate(charstr1d, ilen, 1, idt%mf6varname, memoryPath) + idx = 1 + else + call mem_setptr(charstr1d, idt%mf6varname, memoryPath) + call mem_reallocate(charstr1d, ilen, isize + 1, idt%mf6varname, & + memoryPath) + idx = isize + 1 + end if + call parser%GetString(cstr, (.not. idt%preserve_case)) + charstr1d(idx) = cstr + else if (which == 'FILEOUT') then + call load_string_type(parser, idt, memoryPath, iout) + end if + return + end subroutine load_io_tag + + !> @brief load aux variable names + !! + !< + subroutine load_auxvar_names(parser, idt, memoryPath, iout) + use ConstantsModule, only: LENAUXNAME, LINELENGTH, LENPACKAGENAME + use InputOutputModule, only: urdaux + use CharacterStringModule, only: CharacterStringType + type(BlockParserType), intent(inout) :: parser !< block parser + type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + integer(I4B), intent(in) :: iout !< unit number for output + character(len=:), allocatable :: line + character(len=LENAUXNAME), dimension(:), allocatable :: caux + integer(I4B) :: lloc + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: i + character(len=LENPACKAGENAME) :: text = '' + integer(I4B), pointer :: intvar + type(CharacterStringType), dimension(:), & + pointer, contiguous :: acharstr1d !< variable for allocation + call mem_allocate(intvar, idt%shape, memoryPath) + intvar = 0 + call parser%GetRemainingLine(line) + lloc = 1 + call urdaux(intvar, parser%iuactive, iout, lloc, & + istart, istop, caux, line, text) + call mem_allocate(acharstr1d, LENAUXNAME, intvar, idt%mf6varname, memoryPath) + do i = 1, intvar + acharstr1d(i) = caux(i) + end do + deallocate (line) + deallocate (caux) + return + end subroutine load_auxvar_names + !> @brief load type integer !< subroutine load_integer_type(parser, idt, memoryPath, iout) @@ -492,6 +615,7 @@ end subroutine load_integer_type !> @brief load type 1d integer !< subroutine load_integer1d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -539,6 +663,7 @@ end subroutine load_integer1d_type !> @brief load type 2d integer !< subroutine load_integer2d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -582,6 +707,7 @@ end subroutine load_integer2d_type !> @brief load type 3d integer !< subroutine load_integer3d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -645,6 +771,7 @@ end subroutine load_double_type !> @brief load type 1d double !< subroutine load_double1d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -691,6 +818,7 @@ end subroutine load_double1d_type !> @brief load type 2d double !< subroutine load_double2d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -734,6 +862,7 @@ end subroutine load_double2d_type !> @brief load type 3d double !< subroutine load_double3d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -780,45 +909,6 @@ subroutine load_double3d_type(parser, idt, memoryPath, mshape, iout) return end subroutine load_double3d_type - !> @brief routine for setting the model shape - !! - !! The model shape must be set in the memory manager because - !! individual packages need to know the shape of the arrays - !! to read. - !! - !< - subroutine set_model_shape(ftype, model_mempath, dis_mempath, model_shape) - use MemoryTypeModule, only: MemoryType - use MemoryManagerModule, only: get_from_memorylist - character(len=*), intent(in) :: ftype - character(len=*), intent(in) :: model_mempath - character(len=*), intent(in) :: dis_mempath - integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape - integer(I4B), pointer :: ndim1 - integer(I4B), pointer :: ndim2 - integer(I4B), pointer :: ndim3 - - select case (ftype) - case ('DIS6') - call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NLAY', dis_mempath) - call mem_setptr(ndim2, 'NROW', dis_mempath) - call mem_setptr(ndim3, 'NCOL', dis_mempath) - model_shape = [ndim1, ndim2, ndim3] - case ('DISV6') - call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NLAY', dis_mempath) - call mem_setptr(ndim2, 'NCPL', dis_mempath) - model_shape = [ndim1, ndim2] - case ('DISU6') - call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NODES', dis_mempath) - model_shape = [ndim1] - end select - - return - end subroutine set_model_shape - subroutine get_layered_shape(mshape, nlay, layer_shape) integer(I4B), dimension(:), intent(in) :: mshape integer(I4B), intent(out) :: nlay @@ -845,27 +935,4 @@ subroutine get_layered_shape(mshape, nlay, layer_shape) end subroutine get_layered_shape - subroutine get_shape_from_string(shape_string, array_shape, memoryPath) - character(len=*), intent(in) :: shape_string - integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape - character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information - integer(I4B) :: ndim - integer(I4B) :: i - integer(I4B), pointer :: int_ptr - character(len=16), dimension(:), allocatable :: array_shape_string - character(len=:), allocatable :: shape_string_copy - - ! parse the string into multiple words - shape_string_copy = trim(shape_string)//' ' - call ParseLine(shape_string_copy, ndim, array_shape_string) - allocate (array_shape(ndim)) - - ! find shape in memory manager and put into array_shape - do i = 1, ndim - call mem_setptr(int_ptr, array_shape_string(i), memoryPath) - array_shape(i) = int_ptr - end do - - end subroutine get_shape_from_string - end module LoadMf6FileModule diff --git a/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 b/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 new file mode 100644 index 00000000000..1cade321848 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 @@ -0,0 +1,513 @@ +!> @brief This module contains the StressGridInputModule +!! +!! This module contains the routines for reading period block +!! array based input. +!! +!< +module StressGridInputModule + + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME, & + LENTIMESERIESNAME, LENAUXNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + use InputDefinitionModule, only: InputParamDefinitionType + use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr + use CharacterStringModule, only: CharacterStringType + use BlockParserModule, only: BlockParserType + use ModflowInputModule, only: ModflowInputType, getModflowInput + use BoundInputContextModule, only: BoundInputContextType + use TimeArraySeriesManagerModule, only: TimeArraySeriesManagerType, & + tasmanager_cr + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType + + implicit none + private + public :: StressGridInputType + + !> @brief Pointer type for read state variable + !< + type ReadStateVar + integer, pointer :: invar + end type ReadStateVar + + !> @brief Ascii grid based dynamic loader type + !< + type, extends(AsciiDynamicPkgLoadBaseType) :: StressGridInputType + integer(I4B) :: tas_active !< Are TAS6 inputs defined + integer(I4B) :: nparam !< number of dynamic parameters other than AUX + type(CharacterStringType), dimension(:), contiguous, & + pointer :: aux_tasnames => null() !< array of AUXVAR TAS names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: param_tasnames => null() !< array of dynamic param TAS names + character(len=LENVARNAME), dimension(:), & + allocatable :: param_names !< dynamic param names + type(ReadStateVar), dimension(:), allocatable :: param_reads !< read states for current load + integer(I4B), dimension(:), allocatable :: idt_idxs !< idt indexes corresponding to dfn param list + type(TimeArraySeriesManagerType), pointer :: tasmanager => null() !< TAS manager object + type(BoundInputContextType) :: bndctx !< boundary package input context + contains + procedure :: init => ingrid_init + procedure :: df => ingrid_df + procedure :: ad => ingrid_ad + procedure :: rp => ingrid_rp + procedure :: destroy => ingrid_destroy + procedure :: reset => ingrid_reset + procedure :: params_alloc => ingrid_params_alloc + procedure :: param_load => ingrid_param_load + procedure :: tas_arrays_alloc => ingrid_tas_arrays_alloc + procedure :: tas_links_create => ingrid_tas_links_create + end type StressGridInputType + +contains + + subroutine ingrid_init(this, mf6_input, modelname, modelfname, & + source, iperblock, iout) + use MemoryManagerModule, only: get_isize + class(StressGridInputType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + type(CharacterStringType), dimension(:), pointer, & + contiguous :: tas_fnames + character(len=LINELENGTH) :: fname + integer(I4B) :: tas6_size, n + ! + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! -- initialize + this%tas_active = 0 + this%nparam = 0 + this%iout = iout + ! + ! -- create tasmanager + allocate (this%tasmanager) + call tasmanager_cr(this%tasmanager, modelname=this%mf6_input%component_name, & + iout=this%iout) + ! + ! -- determine if TAS6 files were provided in OPTIONS block + call get_isize('TAS6_FILENAME', this%mf6_input%mempath, tas6_size) + ! + if (tas6_size > 0) then + ! + this%tas_active = 1 + ! + call mem_setptr(tas_fnames, 'TAS6_FILENAME', this%mf6_input%mempath) + ! + ! -- add files to tasmanager + do n = 1, size(tas_fnames) + fname = tas_fnames(n) + call this%tasmanager%add_tasfile(fname) + end do + ! + end if + ! + ! -- initialize input context memory + call this%bndctx%init(mf6_input, .true.) + ! + ! -- allocate dfn params + call this%params_alloc() + ! + ! -- allocate memory for storing TAS strings + call this%tas_arrays_alloc() + ! + ! -- return + return + end subroutine ingrid_init + + subroutine ingrid_df(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + call this%tasmanager%tasmanager_df() + ! + ! -- return + return + end subroutine ingrid_df + + subroutine ingrid_ad(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + call this%tasmanager%ad() + ! + ! -- return + return + end subroutine ingrid_ad + + subroutine ingrid_rp(this, parser) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use BlockParserModule, only: BlockParserType + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use ArrayHandlersModule, only: ifind + use SourceCommonModule, only: ifind_charstr + use IdmLoggerModule, only: idm_log_header, idm_log_close, idm_log_var + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + type(BlockParserType), pointer, intent(inout) :: parser + ! -- locals + logical(LGP) :: endOfBlock + character(len=LINELENGTH) :: keyword, param_tag + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iaux, iparam + character(len=LENTIMESERIESNAME) :: tas_name + ! + ! -- reset for this period + call this%reset() + ! + ! -- log lst file header + call idm_log_header(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + ! + ! -- read array block + do + ! -- initialize + iaux = 0 + ! + ! -- read next line + call parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + ! + ! -- read param_tag + call parser%GetStringCaps(param_tag) + ! + ! -- is param tag an auxvar? + iaux = ifind_charstr(this%bndctx%auxname_cst, param_tag) + ! + ! -- any auvxar corresponds to the definition tag 'AUX' + if (iaux > 0) param_tag = 'AUX' + ! + ! -- set input definition + idt => get_param_definition_type(this%mf6_input%param_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD', param_tag, this%sourcename) + ! + ! -- look for TAS keyword if tas is active + if (this%tas_active /= 0) then + call parser%GetStringCaps(keyword) + ! + if (keyword == 'TIMEARRAYSERIES') then + call parser%GetStringCaps(tas_name) + ! + if (param_tag == 'AUX') then + this%aux_tasnames(iaux) = tas_name + else + iparam = ifind(this%param_names, param_tag) + this%param_tasnames(iparam) = tas_name + this%param_reads(iparam)%invar = 2 + end if + ! + ! -- log variable + call idm_log_var(param_tag, this%mf6_input%mempath, this%iout, .true.) + ! + ! -- cycle to next input param + cycle + end if + ! + end if + ! + ! -- read and load the parameter + call this%param_load(parser, idt%datatype, idt%mf6varname, idt%tagname, & + this%mf6_input%mempath, iaux) + ! + end do + ! + ! + if (this%tas_active /= 0) then + call this%tas_links_create(parser%iuactive) + end if + ! + ! -- log lst file header + call idm_log_close(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + ! + ! -- return + return + end subroutine ingrid_rp + + subroutine ingrid_destroy(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + deallocate (this%tasmanager) + ! + ! -- return + return + end subroutine ingrid_destroy + + subroutine ingrid_reset(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate, mem_setptr, get_isize + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + integer(I4B) :: n, m + ! + if (this%tas_active /= 0) then + ! + ! -- reset tasmanager + call this%tasmanager%reset(this%mf6_input%subcomponent_name) + ! + ! -- reinitialize tas name arrays + call this%bndctx%param_init('CHARSTR1D', 'AUXTASNAME', & + this%mf6_input%mempath, this%sourcename) + call this%bndctx%param_init('CHARSTR1D', 'PARAMTASNAME', & + this%mf6_input%mempath, this%sourcename) + end if + ! + do n = 1, this%nparam + if (this%param_reads(n)%invar /= 0) then + ! + ! -- reset read state + this%param_reads(n)%invar = 0 + ! + end if + end do + ! + ! -- explicitly reset auxvar array each period + do m = 1, this%bndctx%ncpl + do n = 1, this%bndctx%naux + this%bndctx%auxvar(n, m) = DZERO + end do + end do + ! + ! -- return + return + end subroutine ingrid_reset + + subroutine ingrid_params_alloc(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use ArrayHandlersModule, only: expandarray + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + type(InputParamDefinitionType), pointer :: idt + character(len=LENVARNAME), dimension(:), allocatable :: read_state_varnames + integer(I4B), pointer :: intvar + integer(I4B) :: iparam + ! + ! -- allocate period dfn params + call this%bndctx%bound_params_allocate(this%sourcename) + ! + ! -- allocate dfn input params + do iparam = 1, size(this%mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'PERIOD') then + ! + ! -- store parameter info + if (idt%tagname /= 'AUX') then + this%nparam = this%nparam + 1 + ! + ! -- reallocate param info arrays + call expandarray(this%param_names) + call expandarray(this%idt_idxs) + call expandarray(read_state_varnames) + ! + ! -- internal mf6 param name + this%param_names(this%nparam) = idt%mf6varname + ! -- idt list index of param + this%idt_idxs(this%nparam) = iparam + ! -- allocate and store name of read state variable + read_state_varnames(this%nparam) = & + this%bndctx%allocate_read_state_var(idt%mf6varname) + ! + end if + ! + end if + end do + ! + ! -- allocate and set param_reads pointer array + allocate (this%param_reads(this%nparam)) + ! + ! store read state variable pointers + do iparam = 1, this%nparam + call mem_setptr(intvar, read_state_varnames(iparam), this%mf6_input%mempath) + this%param_reads(iparam)%invar => intvar + end do + ! + ! -- cleanup + deallocate (read_state_varnames) + ! + ! -- return + return + end subroutine ingrid_params_alloc + + subroutine ingrid_param_load(this, parser, datatype, varname, & + tagname, mempath, iaux) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use ArrayHandlersModule, only: ifind + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use Double1dReaderModule, only: read_dbl1d + use Double2dReaderModule, only: read_dbl2d + use Integer1dReaderModule, only: read_int1d + use IdmLoggerModule, only: idm_log_var + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + type(BlockParserType), intent(in) :: parser + character(len=*), intent(in) :: datatype + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: tagname + character(len=*), intent(in) :: mempath + integer(I4B), intent(in) :: iaux + ! -- locals + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B) :: iparam + ! + select case (datatype) + case ('INTEGER1D') + ! + call mem_setptr(int1d, varname, mempath) + call read_int1d(parser, int1d, varname) + call idm_log_var(int1d, tagname, mempath, this%iout) + ! + case ('DOUBLE1D') + ! + call mem_setptr(dbl1d, varname, mempath) + call read_dbl1d(parser, dbl1d, varname) + call idm_log_var(dbl1d, tagname, mempath, this%iout) + ! + case ('DOUBLE2D') + ! + call mem_setptr(dbl2d, varname, mempath) + call read_dbl1d(parser, dbl2d(iaux, :), varname) + call idm_log_var(dbl2d, tagname, mempath, this%iout) + ! + case default + ! + call store_error('Programming error. (IDM) unsupported memload & + &data type for param='//trim(tagname)) + call store_error_filename(this%sourcename) + ! + end select + ! + iparam = ifind(this%param_names, varname) + ! + ! -- if param is tracked set read state + if (iparam > 0) then + this%param_reads(iparam)%invar = 1 + end if + ! + ! -- return + return + end subroutine ingrid_param_load + + subroutine ingrid_tas_arrays_alloc(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + ! + ! -- count params other than AUX + if (this%tas_active /= 0) then + ! + call mem_allocate(this%aux_tasnames, LENTIMESERIESNAME, this%bndctx%naux, & + 'AUXTASNAME', this%mf6_input%mempath) + call mem_allocate(this%param_tasnames, LENTIMESERIESNAME, this%nparam, & + 'PARAMTASNAME', this%mf6_input%mempath) + ! + call this%bndctx%param_init('CHARSTR1D', 'AUXTASNAME', & + this%mf6_input%mempath, & + this%sourcename) + call this%bndctx%param_init('CHARSTR1D', 'PARAMTASNAME', & + this%mf6_input%mempath, & + this%sourcename) + ! + else + ! + call mem_allocate(this%aux_tasnames, LENTIMESERIESNAME, 0, & + 'AUXTASNAME', this%mf6_input%mempath) + call mem_allocate(this%param_tasnames, LENTIMESERIESNAME, 0, & + 'PARAMTASNAME', this%mf6_input%mempath) + ! + end if + ! + ! -- return + return + end subroutine ingrid_tas_arrays_alloc + + ! FLUX and SFAC are handled in model context + subroutine ingrid_tas_links_create(this, inunit) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + integer(I4B), intent(in) :: inunit + ! -- locals + type(InputParamDefinitionType), pointer :: idt + ! -- non-contiguous beacuse a slice of bound is passed + real(DP), dimension(:), pointer :: auxArrayPtr, bndArrayPtr + real(DP), dimension(:), pointer, contiguous :: bound + integer(I4B), dimension(:), pointer, contiguous :: nodelist + character(len=LENTIMESERIESNAME) :: tas_name + character(len=LENAUXNAME) :: aux_name + logical :: convertFlux + integer(I4B) :: n + ! + ! -- initialize + nullify (auxArrayPtr) + nullify (bndArrayPtr) + nullify (nodelist) + convertflux = .false. + ! + ! Create AUX Time Array Series links + do n = 1, this%bndctx%naux + tas_name = this%aux_tasnames(n) + ! + if (tas_name /= '') then + ! + ! -- set auxvar pointer + auxArrayPtr => this%bndctx%auxvar(n, :) + ! + aux_name = this%bndctx%auxname_cst(n) + ! + call this%tasmanager%MakeTasLink(this%mf6_input%subcomponent_name, & + auxArrayPtr, this%bndctx%iprpak, & + tas_name, aux_name, convertFlux, & + nodelist, inunit) + end if + ! + end do + ! + ! Create BND Time Array Series links + do n = 1, this%nparam + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(this%idt_idxs(n)) + ! + if (idt%timeseries) then + ! + if (this%param_reads(n)%invar == 2) then + tas_name = this%param_tasnames(n) + ! + call mem_setptr(bound, idt%mf6varname, this%mf6_input%mempath) + ! + ! -- set bound pointer + bndArrayPtr => bound(:) + ! + call this%tasmanager%MakeTasLink(this%mf6_input%subcomponent_name, & + bndArrayPtr, this%bndctx%iprpak, & + tas_name, idt%mf6varname, & + convertFlux, nodelist, inunit) + end if + end if + end do + + ! + ! -- return + return + end subroutine ingrid_tas_links_create + +end module StressGridInputModule diff --git a/src/Utilities/Idm/mf6blockfile/StressListInput.f90 b/src/Utilities/Idm/mf6blockfile/StressListInput.f90 new file mode 100644 index 00000000000..8528397ad27 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/StressListInput.f90 @@ -0,0 +1,439 @@ +!> @brief This module contains the StressListInputModule +!! +!! This module contains the routines for reading period block +!! list based input. +!! +!< +module StressListInputModule + + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME, & + LENTIMESERIESNAME, LENAUXNAME, LENBOUNDNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors, store_error_unit + use InputOutputModule, only: openfile, getunit + use InputDefinitionModule, only: InputParamDefinitionType + use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr + use CharacterStringModule, only: CharacterStringType + use ModflowInputModule, only: ModflowInputType, getModflowInput + use TimeSeriesManagerModule, only: TimeSeriesManagerType, tsmanager_cr + use BoundInputContextModule, only: BoundInputContextType + use StructArrayModule, only: StructArrayType, constructStructArray, & + destructStructArray + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType + + implicit none + private + public :: StressListInputType + + !> @brief Ascii list based dynamic loader type + !< + type, extends(AsciiDynamicPkgLoadBaseType) :: StressListInputType + integer(I4B) :: ts_active + integer(I4B) :: ibinary + integer(I4B) :: oc_inunit + integer(I4B) :: ncol + integer(I4B) :: iboundname + character(len=LENVARNAME), dimension(:), allocatable :: cols + type(TimeSeriesManagerType), pointer :: tsmanager => null() + type(StructArrayType), pointer :: structarray + type(BoundInputContextType) :: bndctx + contains + procedure :: init => inlist_init + procedure :: df => inlist_df + procedure :: ad => inlist_ad + procedure :: rp => inlist_rp + procedure :: destroy => inlist_destroy + procedure :: reset => inlist_reset + procedure :: ts_link => inlist_ts_link + procedure :: ts_update => inlist_ts_update + procedure :: create_structarray + procedure :: read_control_record + end type StressListInputType + +contains + + subroutine inlist_init(this, mf6_input, modelname, modelfname, & + source, iperblock, iout) + use MemoryManagerModule, only: get_isize + class(StressListInputType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + type(CharacterStringType), dimension(:), pointer, & + contiguous :: ts_fnames + character(len=LINELENGTH) :: fname + integer(I4B) :: ts6_size, n + ! + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! + ! -- initialize + this%ts_active = 0 + this%ibinary = 0 + this%oc_inunit = 0 + ! + ! -- create tsmanager + allocate (this%tsmanager) + call tsmanager_cr(this%tsmanager, iout) + ! + ! -- determine if TS6 files were provided in OPTIONS block + call get_isize('TS6_FILENAME', this%mf6_input%mempath, ts6_size) + ! + if (ts6_size > 0) then + ! + this%ts_active = 1 + call mem_setptr(ts_fnames, 'TS6_FILENAME', this%mf6_input%mempath) + ! + do n = 1, size(ts_fnames) + fname = ts_fnames(n) + call this%tsmanager%add_tsfile(fname, GetUnit()) + end do + ! + end if + ! + ! -- initialize package input context + call this%bndctx%init(mf6_input, .false.) + ! + ! -- set SA cols in scope for list input + call this%bndctx%filtered_cols(this%cols, this%ncol) + ! + ! -- construct and set up the struct array object + call this%create_structarray() + ! + ! -- finalize input context setup + call this%bndctx%enable() + ! + ! -- return + return + end subroutine inlist_init + + subroutine inlist_df(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- define tsmanager + call this%tsmanager%tsmanager_df() + ! + ! -- return + return + end subroutine inlist_df + + subroutine inlist_ad(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- advance tsmanager + call this%tsmanager%ad() + ! + ! -- return + return + end subroutine inlist_ad + + subroutine inlist_rp(this, parser) + ! -- modules + use BlockParserModule, only: BlockParserType + use StructVectorModule, only: StructVectorType + use IdmLoggerModule, only: idm_log_header, idm_log_close + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser + ! -- locals + logical(LGP) :: ts_active + ! + call this%reset() + ! + call this%read_control_record(parser) + ! + ! -- log lst file header + call idm_log_header(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + ! + if (this%ibinary == 1) then + ! + this%bndctx%nbound = & + this%structarray%read_from_binary(this%oc_inunit, this%iout) + ! + call parser%terminateblock() + ! + close (this%oc_inunit) + this%ibinary = 0 + this%oc_inunit = 0 + ! + else + ! + ts_active = (this%ts_active /= 0) + ! + this%bndctx%nbound = & + this%structarray%read_from_parser(parser, & + ts_active, this%iout) + end if + ! + ! update ts links + if (this%ts_active /= 0) then + call this%ts_update() + end if + ! + ! -- close logging statement + call idm_log_close(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + ! + ! -- return + return + end subroutine inlist_rp + + subroutine inlist_destroy(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + deallocate (this%cols) + deallocate (this%tsmanager) + call destructStructArray(this%structarray) + call this%bndctx%destroy() + ! + ! -- return + return + end subroutine inlist_destroy + + subroutine inlist_reset(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- reset tsmanager + call this%tsmanager%reset(this%mf6_input%subcomponent_name) + ! + ! -- return + return + end subroutine inlist_reset + + subroutine inlist_ts_link(this, structvector, ts_strloc) + ! -- modules + use TimeSeriesLinkModule, only: TimeSeriesLinkType + use TimeSeriesManagerModule, only: read_value_or_time_series + use StructVectorModule, only: StructVectorType, TSStringLocType + !use ArrayHandlersModule, only: ifind + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(StructVectorType), pointer, intent(in) :: structvector + type(TSStringLocType), pointer, intent(in) :: ts_strloc + ! -- locals + real(DP), pointer :: bndElem => null() + type(TimeSeriesLinkType), pointer :: tsLinkBnd => null() + type(TimeSeriesLinkType), pointer :: tsLinkAux => null() + type(StructVectorType), pointer :: sv_bound + character(len=LENBOUNDNAME) :: boundname + ! + select case (structvector%memtype) + case (2) + ! + tsLinkBnd => NULL() + ! + ! -- set bound element + bndElem => structvector%dbl1d(ts_strloc%row) + ! + ! -- set link + call read_value_or_time_series(ts_strloc%token, ts_strloc%row, & + ts_strloc%structarray_col, bndElem, & + this%mf6_input%subcomponent_name, & + 'BND', this%tsmanager, & + this%bndctx%iprpak, tsLinkBnd) + ! + if (associated(tsLinkBnd)) then + ! + ! -- set variable name + tsLinkBnd%Text = structvector%idt%mf6varname + ! + ! -- set boundname if provided + if (this%bndctx%inamedbound > 0) then + sv_bound => this%structarray%get(this%iboundname) + boundname = sv_bound%charstr1d(ts_strloc%row) + tsLinkBnd%BndName = boundname + end if + + ! Flux is handled from model context + + end if + ! + case (6) + ! + tsLinkAux => NULL() + ! + ! -- set bound element + bndElem => structvector%dbl2d(ts_strloc%col, ts_strloc%row) + ! + ! -- set link + call read_value_or_time_series(ts_strloc%token, ts_strloc%row, & + ts_strloc%structarray_col, bndElem, & + this%mf6_input%subcomponent_name, & + 'AUX', this%tsmanager, & + this%bndctx%iprpak, tsLinkAux) + + if (associated(tsLinkAux)) then + ! + ! -- set variable name + tsLinkAux%Text = this%bndctx%auxname_cst(ts_strloc%col) + ! + ! -- set boundname if provided + if (this%bndctx%inamedbound > 0) then + sv_bound => this%structarray%get(this%iboundname) + boundname = sv_bound%charstr1d(ts_strloc%row) + tsLinkAux%BndName = boundname + end if + ! + end if + ! + case default + end select + ! + ! -- return + return + end subroutine inlist_ts_link + + subroutine inlist_ts_update(this) + ! -- modules + use StructVectorModule, only: TSStringLocType + use StructVectorModule, only: StructVectorType + ! -- dummy + class(StressListInputType), intent(inout) :: this + ! -- locals + integer(I4B) :: n, m + type(TSStringLocType), pointer :: ts_strloc + type(StructVectorType), pointer :: sv + ! + ! + do m = 1, this%structarray%count() + + sv => this%structarray%get(m) + + if (sv%idt%timeseries) then + ! + do n = 1, sv%ts_strlocs%count() + ts_strloc => sv%get_ts_strloc(n) + call this%ts_link(sv, ts_strloc) + end do + ! + call sv%clear() + end if + end do + ! + ! -- return + return + end subroutine inlist_ts_update + + subroutine create_structarray(this) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + ! -- dummy + class(StressListInputType), intent(inout) :: this + ! -- locals + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: icol + ! + ! -- construct and set up the struct array object + this%structarray => constructStructArray(this%mf6_input, this%ncol, & + this%bndctx%maxbound, 0, & + this%mf6_input%mempath, & + this%mf6_input%component_mempath) + ! + ! -- set up struct array + do icol = 1, this%ncol + ! + idt => get_param_definition_type(this%mf6_input%param_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD', & + this%cols(icol), this%sourcename) + ! + ! -- allocate variable in memory manager + call this%structarray%mem_create_vector(icol, idt) + ! + ! -- store boundname index when found + if (idt%mf6varname == 'BOUNDNAME') this%iboundname = icol + ! + end do + ! + ! -- return + return + end subroutine create_structarray + + subroutine read_control_record(this, parser) + ! -- modules + use InputOutputModule, only: urword + use OpenSpecModule, only: form, access + use ConstantsModule, only: LINELENGTH + use BlockParserModule, only: BlockParserType + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(BlockParserType), intent(inout) :: parser + ! -- local + integer(I4B) :: lloc, istart, istop, idum, inunit, itmp, ierr + integer(I4B) :: nunopn = 99 + character(len=:), allocatable :: line + character(len=LINELENGTH) :: fname + logical :: exists + real(DP) :: r + ! -- formats + character(len=*), parameter :: fmtocne = & + &"('Specified OPEN/CLOSE file ',(A),' does not exist')" + character(len=*), parameter :: fmtobf = & + &"(1X,/1X,'OPENING BINARY FILE ON UNIT ',I0,':',/1X,A)" + ! + inunit = parser%getunit() + ! + ! -- Read to the first non-commented line + lloc = 1 + call parser%line_reader%rdcom(inunit, this%iout, line, ierr) + call urword(line, lloc, istart, istop, 1, idum, r, this%iout, inunit) + ! + if (line(istart:istop) == 'OPEN/CLOSE') then + ! + ! -- get filename + call urword(line, lloc, istart, istop, 0, idum, r, & + this%iout, inunit) + ! + fname = line(istart:istop) + ! + ! -- check to see if file OPEN/CLOSE file exists + inquire (file=fname, exist=exists) + ! + if (.not. exists) then + write (errmsg, fmtocne) line(istart:istop) + call store_error(errmsg) + call store_error('Specified OPEN/CLOSE file does not exist') + call store_error_unit(inunit) + end if + ! + ! -- Check for (BINARY) keyword + call urword(line, lloc, istart, istop, 1, idum, r, & + this%iout, inunit) + ! + if (line(istart:istop) == '(BINARY)') this%ibinary = 1 + ! + ! -- Open the file depending on ibinary flag + if (this%ibinary == 1) then + this%oc_inunit = nunopn + itmp = this%iout + ! + if (this%iout > 0) then + itmp = 0 + write (this%iout, fmtobf) this%oc_inunit, trim(adjustl(fname)) + end if + ! + call openfile(this%oc_inunit, itmp, fname, 'OPEN/CLOSE', & + fmtarg_opt=form, accarg_opt=access) + end if + end if + ! + if (this%ibinary == 0) then + call parser%line_reader%bkspc(parser%getunit()) + end if + ! + ! -- return + return + end subroutine read_control_record + +end module StressListInputModule diff --git a/src/Utilities/Idm/mf6blockfile/StructArray.f90 b/src/Utilities/Idm/mf6blockfile/StructArray.f90 index 5dca7d8becd..49befb0b53a 100644 --- a/src/Utilities/Idm/mf6blockfile/StructArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/StructArray.f90 @@ -8,16 +8,17 @@ module StructArrayModule use KindModule, only: I4B, DP, LGP - use ConstantsModule, only: DNODATA, LINELENGTH + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME use SimVariablesModule, only: errmsg use SimModule, only: store_error use StructVectorModule, only: StructVectorType + use InputDefinitionModule, only: InputParamDefinitionType use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr use CharacterStringModule, only: CharacterStringType use STLVecIntModule, only: STLVecInt use IdmLoggerModule, only: idm_log_var - use MemoryManagerModule, only: mem_setptr use BlockParserModule, only: BlockParserType + use ModflowInputModule, only: ModflowInputType implicit none private @@ -37,14 +38,23 @@ module StructArrayModule integer(I4B) :: blocknum logical(LGP) :: deferred_shape = .false. integer(I4B) :: deferred_size_init = 5 - type(StructVectorType), dimension(:), allocatable :: struct_vector_1d + character(len=LENMEMPATH) :: mempath + character(len=LENMEMPATH) :: component_mempath + type(StructVectorType), dimension(:), allocatable :: struct_vectors + integer(I4B), dimension(:), allocatable :: startidx + integer(I4B), dimension(:), allocatable :: numcols + type(ModflowInputType) :: mf6_input contains procedure :: mem_create_vector - procedure :: add_vector_int1d - procedure :: add_vector_dbl1d - procedure :: add_vector_charstr1d - procedure :: add_vector_intvector + procedure :: count + procedure :: get + procedure :: allocate_int_type + procedure :: allocate_dbl_type + procedure :: allocate_charstr_type + procedure :: allocate_int1d_type + procedure :: allocate_dbl1d_type procedure :: read_from_parser + procedure :: read_from_binary procedure :: memload_vectors procedure :: load_deferred_vector procedure :: log_structarray_vars @@ -56,23 +66,28 @@ module StructArrayModule !> @brief constructor for a struct_array !< - function constructStructArray(ncol, nrow, blocknum) result(struct_array) + function constructStructArray(mf6_input, ncol, nrow, blocknum, mempath, & + component_mempath) result(struct_array) + type(ModflowInputType), intent(in) :: mf6_input integer(I4B), intent(in) :: ncol !< number of columns in the StructArrayType - integer(I4B), pointer, intent(in) :: nrow !< number of rows in the StructArrayType + integer(I4B), intent(in) :: nrow !< number of rows in the StructArrayType integer(I4B), intent(in) :: blocknum !< valid block number or 0 + character(len=*), intent(in) :: mempath !< memory path for storing the vector + character(len=*), intent(in) :: component_mempath type(StructArrayType), pointer :: struct_array !< new StructArrayType ! ! -- allocate StructArrayType allocate (struct_array) ! + ! -- set description of input + struct_array%mf6_input = mf6_input + ! ! -- set number of arrays struct_array%ncol = ncol ! ! -- set rows if known or set deferred - if (associated(nrow)) then - struct_array%nrow = nrow - else - struct_array%nrow = 0 + struct_array%nrow = nrow + if (struct_array%nrow == 0) then struct_array%deferred_shape = .true. end if ! @@ -83,8 +98,14 @@ function constructStructArray(ncol, nrow, blocknum) result(struct_array) struct_array%blocknum = 0 end if ! + ! + struct_array%mempath = mempath + struct_array%component_mempath = component_mempath + ! ! -- allocate StructVectorType objects - allocate (struct_array%struct_vector_1d(ncol)) + allocate (struct_array%struct_vectors(ncol)) + allocate (struct_array%startidx(ncol)) + allocate (struct_array%numcols(ncol)) end function constructStructArray !> @brief destructor for a struct_array @@ -92,317 +113,417 @@ end function constructStructArray subroutine destructStructArray(struct_array) type(StructArrayType), pointer, intent(inout) :: struct_array !< StructArrayType to destroy - deallocate (struct_array%struct_vector_1d) + deallocate (struct_array%struct_vectors) + deallocate (struct_array%startidx) + deallocate (struct_array%numcols) deallocate (struct_array) nullify (struct_array) end subroutine destructStructArray !> @brief create new vector in StructArrayType !< - subroutine mem_create_vector(this, icol, vartype, name, tagname, memoryPath, & - varname_shape, preserve_case) + subroutine mem_create_vector(this, icol, idt) class(StructArrayType) :: this !< StructArrayType integer(I4B), intent(in) :: icol !< column to create - character(len=*), intent(in) :: vartype !< type of column to create - character(len=*), intent(in) :: name !< name of the column to create - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path for storing the vector - character(len=*), intent(in) :: varname_shape !< shape - logical(LGP), optional, intent(in) :: preserve_case !< flag indicating whether or not to preserve case - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d - type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d - type(STLVecInt), pointer :: intvector - integer(I4B) :: j - integer(I4B) :: inodata = 999 !todo: create INODATA in constants? + type(InputParamDefinitionType), pointer :: idt + type(StructVectorType) :: sv + integer(I4B) :: numcol + ! + numcol = 1 + ! + sv%idt => idt + sv%icol = icol + ! + ! -- set size + if (this%deferred_shape) then + sv%size = this%deferred_size_init + else + sv%size = this%nrow + end if ! ! -- allocate array memory for StructVectorType - select case (vartype) - ! - case ('INTEGER1D') - ! - ! -- allocate intvector object - allocate (intvector) - ! - ! -- initialize StructVector and add to StructArray - call this%add_vector_intvector(name, tagname, memoryPath, varname_shape, & - icol, intvector) + select case (idt%datatype) ! case ('INTEGER') ! - if (this%deferred_shape) then - ! -- shape not known, allocate locally - allocate (int1d(this%deferred_size_init)) - else - ! -- shape known, allocate in managed memory - call mem_allocate(int1d, this%nrow, name, memoryPath) - end if - ! - ! -- initialize vector values - do j = 1, this%nrow - int1d(j) = inodata - end do - ! - ! -- initialize StructVector and add to StructArray - call this%add_vector_int1d(name, tagname, memoryPath, icol, int1d) + call this%allocate_int_type(sv) ! case ('DOUBLE') ! - call mem_allocate(dbl1d, this%nrow, name, memoryPath) + call this%allocate_dbl_type(sv) ! - do j = 1, this%nrow - dbl1d(j) = DNODATA - end do + case ('STRING', 'KEYWORD') ! - call this%add_vector_dbl1d(name, tagname, memoryPath, icol, dbl1d) + call this%allocate_charstr_type(sv) ! - case ('STRING', 'KEYWORD') + case ('INTEGER1D') ! - if (this%deferred_shape) then - allocate (charstr1d(this%deferred_size_init)) - else - call mem_allocate(charstr1d, LINELENGTH, this%nrow, name, memoryPath) + call this%allocate_int1d_type(sv) + if (sv%memtype == 5) then + numcol = sv%intshape end if ! - do j = 1, this%nrow - charstr1d(j) = '' - end do + case ('DOUBLE1D') + ! + call this%allocate_dbl1d_type(sv) + numcol = sv%intshape ! - call this%add_vector_charstr1d(name, tagname, memoryPath, icol, charstr1d, & - varname_shape, preserve_case) end select - + ! + ! -- set the object in the Struct Array + this%struct_vectors(icol) = sv + ! + this%numcols(icol) = numcol + if (icol == 1) then + this%startidx(icol) = 1 + else + this%startidx(icol) = this%startidx(icol - 1) + this%numcols(icol - 1) + end if + ! + ! -- return return end subroutine mem_create_vector - !> @brief add int1d to StructArrayType + function count(this) + class(StructArrayType) :: this !< StructArrayType + integer(I4B) :: count + count = size(this%struct_vectors) + end function count + + subroutine set_pointer(sv, sv_target) + type(StructVectorType), pointer :: sv + type(StructVectorType), target :: sv_target + sv => sv_target + end subroutine set_pointer + + function get(this, idx) result(sv) + class(StructArrayType) :: this !< StructArrayType + integer(I4B), intent(in) :: idx + type(StructVectorType), pointer :: sv + call set_pointer(sv, this%struct_vectors(idx)) + end function get + + !> @brief allocate integer input type !< - subroutine add_vector_int1d(this, varname, tagname, memoryPath, icol, int1d) + subroutine allocate_int_type(this, sv) class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - integer(I4B), intent(in) :: icol !< column of the vector - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: int1d !< vector to add - type(StructVectorType) :: sv - ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = '' - sv%mempath = memoryPath - sv%memtype = 1 - sv%int1d => int1d + type(StructVectorType), intent(inout) :: sv + integer(I4B), dimension(:), pointer, contiguous :: int1d + integer(I4B) :: j ! - ! -- set size if (this%deferred_shape) then - sv%size = this%deferred_size_init + ! -- shape not known, allocate locally + allocate (int1d(this%deferred_size_init)) else - sv%size = this%nrow + ! -- shape known, allocate in managed memory + call mem_allocate(int1d, this%nrow, sv%idt%mf6varname, this%mempath) end if ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + ! -- initialize vector values + do j = 1, this%nrow + int1d(j) = IZERO + end do + ! + sv%memtype = 1 + sv%int1d => int1d ! ! -- return return - end subroutine add_vector_int1d + end subroutine allocate_int_type - !> @brief add dbl1d to StructArrayType + !> @brief allocate double input type !< - subroutine add_vector_dbl1d(this, varname, tagname, memoryPath, icol, dbl1d) + subroutine allocate_dbl_type(this, sv) class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - integer(I4B), intent(in) :: icol !< column of the vector - real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d !< vector to add - type(StructVectorType) :: sv + type(StructVectorType), intent(inout) :: sv + real(DP), dimension(:), pointer, contiguous :: dbl1d + integer(I4B) :: j + ! + if (this%deferred_shape) then + ! -- shape not known, allocate locally + allocate (dbl1d(this%deferred_size_init)) + else + ! -- shape known, allocate in managed memory + call mem_allocate(dbl1d, this%nrow, sv%idt%mf6varname, this%mempath) + end if + ! + do j = 1, this%nrow + dbl1d(j) = DZERO + end do ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = '' - sv%mempath = memoryPath sv%memtype = 2 sv%dbl1d => dbl1d - sv%size = this%nrow - ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv ! ! -- return return - end subroutine add_vector_dbl1d + end subroutine allocate_dbl_type - !> @brief add charstr1d to StructArrayType + !> @brief allocate charstr input type !< - subroutine add_vector_charstr1d(this, varname, tagname, memoryPath, icol, & - charstr1d, varname_shape, preserve_case) + subroutine allocate_charstr_type(this, sv) class(StructArrayType) :: this !< StructArrayType - integer(I4B), intent(in) :: icol !< column of the vector - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - type(CharacterStringType), dimension(:), pointer, contiguous, intent(in) :: & - charstr1d !< vector to add - character(len=*), intent(in) :: varname_shape !< shape of variable - logical(LGP), intent(in) :: preserve_case - type(StructVectorType) :: sv - ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = varname_shape - sv%mempath = memoryPath - sv%memtype = 3 - sv%preserve_case = preserve_case - sv%charstr1d => charstr1d + type(StructVectorType), intent(inout) :: sv + type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d + integer(I4B) :: j ! - ! -- set size if (this%deferred_shape) then - sv%size = this%deferred_size_init + allocate (charstr1d(this%deferred_size_init)) else - sv%size = this%nrow + call mem_allocate(charstr1d, LINELENGTH, this%nrow, & + sv%idt%mf6varname, this%mempath) end if ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + do j = 1, this%nrow + charstr1d(j) = '' + end do + ! + sv%memtype = 3 + sv%charstr1d => charstr1d ! ! -- return return - end subroutine add_vector_charstr1d + end subroutine allocate_charstr_type - !> @brief add STLVecInt to StructArrayType + !> @brief allocate int1d input type !< - subroutine add_vector_intvector(this, varname, tagname, memoryPath, & - varname_shape, icol, intvector) + subroutine allocate_int1d_type(this, sv) + use ConstantsModule, only: LENMODELNAME + use MemoryHelperModule, only: create_mem_path + use SimVariablesModule, only: idm_context class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - character(len=*), intent(in) :: varname_shape !< shape of variable - integer(I4B), intent(in) :: icol !< column of the vector - type(STLVecInt), pointer, intent(in) :: intvector !< vector to add - type(StructVectorType) :: sv - ! - ! -- initialize STLVecInt - call intvector%init() + type(StructVectorType), intent(inout) :: sv + integer(I4B), dimension(:, :), pointer, contiguous :: int2d + type(STLVecInt), pointer :: intvector + integer(I4B), pointer :: ncelldim, exgid + character(len=LENMEMPATH) :: input_mempath + character(len=LENMODELNAME) :: mname + type(CharacterStringType), dimension(:), contiguous, & + pointer :: charstr1d ! - ! -- set pointer to dynamic shape - call mem_setptr(sv%intvector_shape, varname_shape, memoryPath) + if (sv%idt%shape == 'NCELLDIM') then + ! + ! -- if EXCHANGE set to NCELLDIM of appropriate model + if (this%mf6_input%component_type == 'EXG') then + ! + ! -- set pointer to EXGID + call mem_setptr(exgid, 'EXGID', this%mf6_input%mempath) + ! + ! -- set pointer to appropriate exchange model array + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + if (sv%idt%tagname == 'CELLIDM1') then + call mem_setptr(charstr1d, 'EXGMNAMEA', input_mempath) + else if (sv%idt%tagname == 'CELLIDM2') then + call mem_setptr(charstr1d, 'EXGMNAMEB', input_mempath) + end if + ! + ! -- set the model name + mname = charstr1d(exgid) + ! + ! -- set ncelldim pointer + input_mempath = create_mem_path(component=mname, context=idm_context) + call mem_setptr(ncelldim, sv%idt%shape, input_mempath) + else + ! + call mem_setptr(ncelldim, sv%idt%shape, this%component_mempath) + end if + ! + if (this%deferred_shape) then + ! -- shape not known, allocate locally + allocate (int2d(ncelldim, this%deferred_size_init)) + else + ! -- shape known, allocate in managed memory + call mem_allocate(int2d, ncelldim, this%nrow, & + sv%idt%mf6varname, this%mempath) + end if + ! + ! -- initialize + int2d = IZERO + ! + sv%memtype = 5 + sv%int2d => int2d + sv%intshape => ncelldim + ! + else + ! + ! -- allocate intvector object + allocate (intvector) + ! + ! -- initialize STLVecInt + call intvector%init() + ! + sv%memtype = 4 + sv%intvector => intvector + sv%size = -1 + ! + ! -- set pointer to dynamic shape + call mem_setptr(sv%intvector_shape, sv%idt%shape, this%mempath) + end if ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = varname_shape - sv%mempath = memoryPath - sv%memtype = 4 - sv%intvector => intvector - sv%size = -1 + ! -- return + return + end subroutine allocate_int1d_type + + !> @brief allocate dbl1d input type + !< + subroutine allocate_dbl1d_type(this, sv) + use MemoryManagerModule, only: get_isize + class(StructArrayType) :: this !< StructArrayType + type(StructVectorType), intent(inout) :: sv + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B), pointer :: naux, nseg, nseg_1 + integer(I4B) :: nseg1_isize ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + if (sv%idt%shape == 'NAUX') then + call mem_setptr(naux, sv%idt%shape, this%mempath) + ! + call mem_allocate(dbl2d, naux, this%nrow, sv%idt%mf6varname, this%mempath) + ! + ! -- initialize + dbl2d = DZERO + ! + sv%memtype = 6 + sv%dbl2d => dbl2d + sv%intshape => naux + ! + else if (sv%idt%shape == 'NSEG-1') then + call mem_setptr(nseg, 'NSEG', this%mempath) + ! + call get_isize('NSEG_1', this%mempath, nseg1_isize) + ! + if (nseg1_isize < 0) then + call mem_allocate(nseg_1, 'NSEG_1', this%mempath) + nseg_1 = nseg - 1 + else + call mem_setptr(nseg_1, 'NSEG_1', this%mempath) + end if + ! + call mem_allocate(dbl2d, nseg_1, this%nrow, sv%idt%mf6varname, this%mempath) + ! + ! -- initialize + dbl2d = DZERO + ! + sv%memtype = 6 + sv%dbl2d => dbl2d + sv%intshape => nseg_1 + ! + else + errmsg = 'Programming error. IDM SA 2d real input param unsupported & + &shape "'//trim(sv%idt%shape)//'".' + call store_error(errmsg, terminate=.TRUE.) + end if ! ! -- return return - end subroutine add_vector_intvector + end subroutine allocate_dbl1d_type subroutine load_deferred_vector(this, icol) use MemoryManagerModule, only: get_isize class(StructArrayType) :: this !< StructArrayType integer(I4B), intent(in) :: icol - integer(I4B) :: i, isize + integer(I4B) :: i, j, isize integer(I4B), dimension(:), pointer, contiguous :: p_int1d + integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d real(DP), dimension(:), pointer, contiguous :: p_dbl1d type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d + character(len=LENVARNAME) :: varname + ! + ! -- set varname + varname = this%struct_vectors(icol)%idt%mf6varname ! ! -- check if already mem managed variable - call get_isize(this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath, isize) + call get_isize(varname, this%mempath, isize) ! ! -- allocate and load based on memtype - select case (this%struct_vector_1d(icol)%memtype) + select case (this%struct_vectors(icol)%memtype) ! case (1) ! -- memtype integer ! if (isize > 0) then ! -- variable exists, reallocate and append - call mem_setptr(p_int1d, this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_setptr(p_int1d, varname, this%mempath) ! -- Currently deferred vectors are appended to managed ! memory vectors when they are already allocated ! (e.g. SIMNAM SolutionGroup) - call mem_reallocate(p_int1d, this%nrow + isize, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_reallocate(p_int1d, this%nrow + isize, varname, this%mempath) do i = 1, this%nrow - p_int1d(isize + i) = this%struct_vector_1d(icol)%int1d(i) + p_int1d(isize + i) = this%struct_vectors(icol)%int1d(i) end do else ! ! -- allocate memory manager vector - call mem_allocate(p_int1d, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_int1d, this%nrow, varname, this%mempath) ! ! -- load local vector to managed memory do i = 1, this%nrow - p_int1d(i) = this%struct_vector_1d(icol)%int1d(i) + p_int1d(i) = this%struct_vectors(icol)%int1d(i) end do end if ! ! -- deallocate local memory - deallocate (this%struct_vector_1d(icol)%int1d) + deallocate (this%struct_vectors(icol)%int1d) ! ! -- update structvector - this%struct_vector_1d(icol)%int1d => p_int1d - this%struct_vector_1d(icol)%size = this%nrow + this%struct_vectors(icol)%int1d => p_int1d + this%struct_vectors(icol)%size = this%nrow ! case (2) ! -- memtype real ! - call mem_allocate(p_dbl1d, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_dbl1d, this%nrow, varname, this%mempath) ! do i = 1, this%nrow - p_dbl1d(i) = this%struct_vector_1d(icol)%dbl1d(i) + p_dbl1d(i) = this%struct_vectors(icol)%dbl1d(i) end do ! - deallocate (this%struct_vector_1d(icol)%dbl1d) + deallocate (this%struct_vectors(icol)%dbl1d) ! ! -- - this%struct_vector_1d(icol)%dbl1d => p_dbl1d - this%struct_vector_1d(icol)%size = this%nrow + this%struct_vectors(icol)%dbl1d => p_dbl1d + this%struct_vectors(icol)%size = this%nrow ! case (3) ! -- memtype charstring if (isize > 0) then - call mem_setptr(p_charstr1d, this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) - call mem_reallocate(p_charstr1d, LINELENGTH, this%nrow + isize, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_setptr(p_charstr1d, varname, this%mempath) + call mem_reallocate(p_charstr1d, LINELENGTH, this%nrow + isize, varname, & + this%mempath) do i = 1, this%nrow - p_charstr1d(isize + i) = this%struct_vector_1d(icol)%charstr1d(i) + p_charstr1d(isize + i) = this%struct_vectors(icol)%charstr1d(i) end do else ! - call mem_allocate(p_charstr1d, LINELENGTH, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_charstr1d, LINELENGTH, this%nrow, varname, & + this%mempath) ! do i = 1, this%nrow - p_charstr1d(i) = this%struct_vector_1d(icol)%charstr1d(i) + p_charstr1d(i) = this%struct_vectors(icol)%charstr1d(i) end do end if ! - deallocate (this%struct_vector_1d(icol)%charstr1d) + deallocate (this%struct_vectors(icol)%charstr1d) ! case (4) ! -- memtype intvector ! no-op + case (5) + call mem_allocate(p_int2d, this%struct_vectors(icol)%intshape, this%nrow, & + varname, this%mempath) + ! + do i = 1, this%nrow + do j = 1, this%struct_vectors(icol)%intshape + p_int2d(j, i) = this%struct_vectors(icol)%int2d(j, i) + end do + end do + ! + deallocate (this%struct_vectors(icol)%int2d) + ! + this%struct_vectors(icol)%int2d => p_int2d + this%struct_vectors(icol)%size = this%nrow + ! + ! TODO: case (6) case default + errmsg = 'Programming error. IDM load_deferred_vector unsupported memtype.' + call store_error(errmsg, terminate=.TRUE.) end select ! ! -- return @@ -415,30 +536,33 @@ subroutine memload_vectors(this) class(StructArrayType) :: this !< StructArrayType integer(I4B) :: icol, j integer(I4B), dimension(:), pointer, contiguous :: p_intvector + character(len=LENVARNAME) :: varname ! do icol = 1, this%ncol ! - if (this%struct_vector_1d(icol)%memtype == 4) then + ! -- set varname + varname = this%struct_vectors(icol)%idt%mf6varname + ! + if (this%struct_vectors(icol)%memtype == 4) then ! -- intvectors always need to be loaded ! ! -- size intvector to number of values read - call this%struct_vector_1d(icol)%intvector%shrink_to_fit() + call this%struct_vectors(icol)%intvector%shrink_to_fit() ! ! -- allocate memory manager vector call mem_allocate(p_intvector, & - this%struct_vector_1d(icol)%intvector%size, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + this%struct_vectors(icol)%intvector%size, & + varname, this%mempath) ! ! -- load local vector to managed memory - do j = 1, this%struct_vector_1d(icol)%intvector%size - p_intvector(j) = this%struct_vector_1d(icol)%intvector%at(j) + do j = 1, this%struct_vectors(icol)%intvector%size + p_intvector(j) = this%struct_vectors(icol)%intvector%at(j) end do ! ! -- cleanup local memory - call this%struct_vector_1d(icol)%intvector%destroy() - deallocate (this%struct_vector_1d(icol)%intvector) - nullify (this%struct_vector_1d(icol)%intvector_shape) + call this%struct_vectors(icol)%intvector%destroy() + deallocate (this%struct_vectors(icol)%intvector) + nullify (this%struct_vectors(icol)%intvector_shape) ! else if (this%deferred_shape) then ! @@ -463,27 +587,49 @@ subroutine log_structarray_vars(this, iout) do j = 1, this%ncol ! ! -- log based on memtype - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! - call idm_log_var(this%struct_vector_1d(j)%int1d, & - this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + call idm_log_var(this%struct_vectors(j)%int1d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) ! case (2) ! -- memtype real ! - call idm_log_var(this%struct_vector_1d(j)%dbl1d, & - this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + if (this%struct_vectors(j)%ts_strlocs%count() > 0) then + call idm_log_var(this%struct_vectors(j)%idt%tagname, & + this%mempath, iout, .false.) + else + call idm_log_var(this%struct_vectors(j)%dbl1d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) + end if ! case (4) ! -- memtype intvector ! - call mem_setptr(int1d, this%struct_vector_1d(j)%varname, & - this%struct_vector_1d(j)%mempath) + call mem_setptr(int1d, this%struct_vectors(j)%idt%mf6varname, & + this%mempath) + ! + call idm_log_var(int1d, this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) + ! + case (5) ! -- memtype int2d + ! + call idm_log_var(this%struct_vectors(j)%int2d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) ! - call idm_log_var(int1d, this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + case (6) ! -- memtype dbl2d + ! + if (this%struct_vectors(j)%ts_strlocs%count() > 0) then + call idm_log_var(this%struct_vectors(j)%idt%tagname, & + this%mempath, iout, .false.) + else + call idm_log_var(this%struct_vectors(j)%dbl2d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) + end if ! end select ! @@ -497,8 +643,9 @@ end subroutine log_structarray_vars !< subroutine check_reallocate(this) class(StructArrayType) :: this !< StructArrayType - integer(I4B) :: i, j, newsize + integer(I4B) :: i, j, k, newsize integer(I4B), dimension(:), pointer, contiguous :: p_int1d + integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d real(DP), dimension(:), pointer, contiguous :: p_dbl1d type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d integer(I4B) :: reallocate_mult @@ -509,66 +656,87 @@ subroutine check_reallocate(this) do j = 1, this%ncol ! ! -- reallocate based on memtype - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! ! -- check if more space needed - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! ! -- calculate new size - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! ! -- allocate new vector allocate (p_int1d(newsize)) ! ! -- copy from old to new - do i = 1, this%struct_vector_1d(j)%size - p_int1d(i) = this%struct_vector_1d(j)%int1d(i) + do i = 1, this%struct_vectors(j)%size + p_int1d(i) = this%struct_vectors(j)%int1d(i) end do ! ! -- deallocate old vector - deallocate (this%struct_vector_1d(j)%int1d) + deallocate (this%struct_vectors(j)%int1d) ! ! -- update struct array object - this%struct_vector_1d(j)%int1d => p_int1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%int1d => p_int1d + this%struct_vectors(j)%size = newsize end if ! case (2) ! -- memtype real - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! allocate (p_dbl1d(newsize)) ! - do i = 1, this%struct_vector_1d(j)%size - p_dbl1d(i) = this%struct_vector_1d(j)%dbl1d(i) + do i = 1, this%struct_vectors(j)%size + p_dbl1d(i) = this%struct_vectors(j)%dbl1d(i) end do ! - deallocate (this%struct_vector_1d(j)%dbl1d) + deallocate (this%struct_vectors(j)%dbl1d) ! - this%struct_vector_1d(j)%dbl1d => p_dbl1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%dbl1d => p_dbl1d + this%struct_vectors(j)%size = newsize end if ! case (3) ! -- memtype charstring - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! allocate (p_charstr1d(newsize)) ! - do i = 1, this%struct_vector_1d(j)%size - p_charstr1d(i) = this%struct_vector_1d(j)%charstr1d(i) + do i = 1, this%struct_vectors(j)%size + p_charstr1d(i) = this%struct_vectors(j)%charstr1d(i) end do ! - deallocate (this%struct_vector_1d(j)%charstr1d) + deallocate (this%struct_vectors(j)%charstr1d) ! - this%struct_vector_1d(j)%charstr1d => p_charstr1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%charstr1d => p_charstr1d + this%struct_vectors(j)%size = newsize end if + case (5) + if (this%nrow > this%struct_vectors(j)%size) then + ! + newsize = this%struct_vectors(j)%size * reallocate_mult + ! + allocate (p_int2d(this%struct_vectors(j)%intshape, newsize)) + ! + do i = 1, this%struct_vectors(j)%size + do k = 1, this%struct_vectors(j)%intshape + p_int2d(k, i) = this%struct_vectors(j)%int2d(k, i) + end do + end do + ! + deallocate (this%struct_vectors(j)%int2d) + ! + this%struct_vectors(j)%int2d => p_int2d + this%struct_vectors(j)%size = newsize + end if + !TODO: case (6) case default + errmsg = 'Programming error. IDM check_reallocate unsupported memtype.' + call store_error(errmsg, terminate=.TRUE.) end select end do ! @@ -578,12 +746,14 @@ end subroutine check_reallocate !> @brief read from the block parser to fill the StructArrayType !< - subroutine read_from_parser(this, parser, iout) + function read_from_parser(this, parser, timeseries, iout) result(irow) class(StructArrayType) :: this !< StructArrayType type(BlockParserType) :: parser !< block parser to read from + logical(LGP), intent(in) :: timeseries integer(I4B), intent(in) :: iout !< unit number for output - logical(LGP) :: endOfBlock - integer(I4B) :: irow, j, k + integer(I4B) :: irow + logical(LGP) :: endOfBlock, preserve_case + integer(I4B) :: j, k integer(I4B) :: intval, numval character(len=LINELENGTH) :: str character(len=:), allocatable :: line @@ -616,51 +786,79 @@ subroutine read_from_parser(this, parser, iout) ! -- handle line reads by column memtype do j = 1, this%ncol ! - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! ! -- if reloadable block and first col, store blocknum if (j == 1 .and. this%blocknum > 0) then ! -- store blocknum - this%struct_vector_1d(j)%int1d(irow) = this%blocknum + this%struct_vectors(j)%int1d(irow) = this%blocknum else ! -- read and store int - this%struct_vector_1d(j)%int1d(irow) = parser%GetInteger() + this%struct_vectors(j)%int1d(irow) = parser%GetInteger() end if ! case (2) ! -- memtype real ! - this%struct_vector_1d(j)%dbl1d(irow) = parser%GetDouble() + if (this%struct_vectors(j)%idt%timeseries .and. timeseries) then + call parser%GetString(str) + this%struct_vectors(j)%dbl1d(irow) = & + this%struct_vectors(j)%read_token(str, this%startidx(j), 1, irow) + else + this%struct_vectors(j)%dbl1d(irow) = parser%GetDouble() + end if ! case (3) ! -- memtype charstring ! - !if (this%struct_vector_1d(j)%shapevar == ':') then - if (this%struct_vector_1d(j)%shapevar /= '') then + !if (this%struct_vectors(j)%idt%shape == ':') then + if (this%struct_vectors(j)%idt%shape /= '') then ! -- if last column with any shape, store rest of line if (j == this%ncol) then call parser%GetRemainingLine(line) - this%struct_vector_1d(j)%charstr1d(irow) = line + this%struct_vectors(j)%charstr1d(irow) = line deallocate (line) end if else ! ! -- read string token - call parser%GetString(str, & - (.not. this%struct_vector_1d(j)%preserve_case)) - this%struct_vector_1d(j)%charstr1d(irow) = str + preserve_case = (.not. this%struct_vectors(j)%idt%preserve_case) + call parser%GetString(str, preserve_case) + this%struct_vectors(j)%charstr1d(irow) = str end if ! case (4) ! -- memtype intvector ! ! -- get shape for this row - numval = this%struct_vector_1d(j)%intvector_shape(irow) + numval = this%struct_vectors(j)%intvector_shape(irow) ! ! -- read and store row values do k = 1, numval intval = parser%GetInteger() - call this%struct_vector_1d(j)%intvector%push_back(intval) + call this%struct_vectors(j)%intvector%push_back(intval) end do + ! + case (5) ! -- memtype int2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + this%struct_vectors(j)%int2d(k, irow) = parser%GetInteger() + end do + ! + case (6) ! -- memtype dbl2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + if (this%struct_vectors(j)%idt%timeseries .and. timeseries) then + call parser%GetString(str) + this%struct_vectors(j)%dbl2d(k, irow) = & + this%struct_vectors(j)%read_token(str, this%startidx(j) + k - 1, & + k, irow) + else + this%struct_vectors(j)%dbl2d(k, irow) = parser%GetDouble() + end if + end do + ! end select end do end do @@ -669,8 +867,132 @@ subroutine read_from_parser(this, parser, iout) call this%memload_vectors() ! ! -- log loaded variables - call this%log_structarray_vars(iout) + if (iout > 0) then + call this%log_structarray_vars(iout) + end if + ! + ! -- return + return + end function read_from_parser - end subroutine read_from_parser + !> @brief read from binary input to fill the StructArrayType + !< + function read_from_binary(this, inunit, iout) result(irow) + class(StructArrayType) :: this !< StructArrayType + integer(I4B), intent(in) :: inunit !< unit number for binary input + integer(I4B), intent(in) :: iout !< unit number for output + integer(I4B) :: irow, ierr + integer(I4B) :: j, k + integer(I4B) :: intval, numval + character(len=LINELENGTH) :: fname + character(len=*), parameter :: fmtlsterronly = & + "('Error reading LIST from file: ',& + &1x,a,1x,' on UNIT: ',I0)" + ! + ! -- set error and exit if deferred shape + if (this%deferred_shape) then + ! + errmsg = 'Programming error. IDM SA deferred shape currently not & + &supported for binary inputs.' + call store_error(errmsg, terminate=.TRUE.) + ! + end if + ! + ! -- initialize + irow = 0 + ierr = 0 + ! + readloop: do + ! + ! -- update irow index + irow = irow + 1 + ! + ! -- handle line reads by column memtype + do j = 1, this%ncol + ! + select case (this%struct_vectors(j)%memtype) + ! + case (1) ! -- memtype integer + read (inunit, iostat=ierr) this%struct_vectors(j)%int1d(irow) + case (2) ! -- memtype real + read (inunit, iostat=ierr) this%struct_vectors(j)%dbl1d(irow) + case (3) ! -- memtype charstring + ! + errmsg = 'Programming error. IDM SA input string types currently not & + &supported for binary inputs.' + call store_error(errmsg, terminate=.TRUE.) + ! + case (4) ! -- memtype intvector + ! + ! -- get shape for this row + numval = this%struct_vectors(j)%intvector_shape(irow) + ! + ! -- read and store row values + do k = 1, numval + if (ierr == 0) then + read (inunit, iostat=ierr) intval + call this%struct_vectors(j)%intvector%push_back(intval) + end if + end do + ! + case (5) ! -- memtype int2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + if (ierr == 0) then + read (inunit, iostat=ierr) this%struct_vectors(j)%int2d(k, irow) + end if + end do + ! + case (6) ! -- memtype dbl2d + do k = 1, this%struct_vectors(j)%intshape + if (ierr == 0) then + read (inunit, iostat=ierr) this%struct_vectors(j)%dbl2d(k, irow) + end if + end do + end select + ! + ! -- handle error cases + select case (ierr) + case (0) + ! no error + case (:-1) + ! + ! -- End of block was encountered + irow = irow - 1 + exit readloop + ! + case (1:) + ! + ! -- Error + inquire (unit=inunit, name=fname) + write (errmsg, fmtlsterronly) trim(adjustl(fname)), inunit + call store_error(errmsg, terminate=.TRUE.) + ! + case default + end select + ! + end do + ! + if (irow == this%nrow) exit readloop + ! + end do readloop + ! + ! -- Stop if errors were detected + !if (count_errors() > 0) then + ! call store_error_unit(inunit) + !end if + ! + ! -- if deferred shape vectors were read, load to input path + call this%memload_vectors() + ! + ! -- log loaded variables + if (iout > 0) then + call this%log_structarray_vars(iout) + end if + ! + ! -- return + return + end function read_from_binary end module StructArrayModule diff --git a/src/Utilities/Idm/mf6blockfile/StructVector.f90 b/src/Utilities/Idm/mf6blockfile/StructVector.f90 index a6c0223b2b7..d9618d4fba9 100644 --- a/src/Utilities/Idm/mf6blockfile/StructVector.f90 +++ b/src/Utilities/Idm/mf6blockfile/StructVector.f90 @@ -7,13 +7,27 @@ module StructVectorModule use KindModule, only: I4B, DP, LGP - use ConstantsModule, only: LENMEMPATH, LENVARNAME + use ConstantsModule, only: DNODATA, LENMEMPATH, LENVARNAME, LINELENGTH, & + LENTIMESERIESNAME + use ListModule, only: ListType + use InputDefinitionModule, only: InputParamDefinitionType use CharacterStringModule, only: CharacterStringType use STLVecIntModule, only: STLVecInt + use ArrayHandlersModule, only: expandarray implicit none private - public :: StructVectorType + public :: StructVectorType, TSStringLocType + + !> @brief derived type which describes time series string field + !< + type :: TSStringLocType + integer(I4B) :: structarray_col !< global SA column index + integer(I4B) :: col !< SV column (1 if 1d array) + integer(I4B) :: row !< SV row + character(LINELENGTH) :: token !< TS string token + contains + end type TSStringLocType !> @brief derived type for generic vector !! @@ -22,20 +36,127 @@ module StructVectorModule !! !< type StructVectorType - character(len=LENVARNAME) :: varname - character(len=100) :: tagname - character(len=LENVARNAME) :: shapevar - character(len=LENMEMPATH) :: mempath - integer(I4B) :: memtype = 0 - integer(I4B) :: size = 0 - logical(LGP) :: preserve_case = .false. + type(InputParamDefinitionType), pointer :: idt !< input definition + ! SA vector attributes + integer(I4B) :: memtype = 0 !< SA memtype + integer(I4B) :: icol = 0 !< SA column + integer(I4B) :: size = 0 !< size of array + ! Data pointers integer(I4B), dimension(:), pointer, contiguous :: int1d => null() + integer(I4B), dimension(:, :), pointer, contiguous :: int2d => null() real(DP), dimension(:), pointer, contiguous :: dbl1d => null() + real(DP), dimension(:, :), pointer, contiguous :: dbl2d => null() type(CharacterStringType), dimension(:), pointer, contiguous :: & charstr1d => null() type(STLVecInt), pointer :: intvector => null() + ! Shape data pointers + integer(I4B), pointer :: intshape => null() integer(I4B), dimension(:), pointer, contiguous :: intvector_shape => null() - + ! TimeSeries strings + type(ListType) :: ts_strlocs + contains + procedure :: clear => sv_clear + procedure :: read_token => sv_read_token + procedure :: add_ts_strloc => sv_add_ts_strloc + procedure :: get_ts_strloc => sv_get_ts_strloc end type StructVectorType +contains + + function sv_read_token(this, token, structarray_col, col, row) result(val) + ! -- modules + ! -- dummy + class(StructVectorType) :: this + character(len=*), intent(in) :: token + integer(I4B), intent(in) :: structarray_col + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + real(DP) :: val + ! -- local + integer(I4B) :: istat + real(DP) :: r + ! + ! -- initialize + val = DNODATA + ! + read (token, *, iostat=istat) r + if (istat == 0) then + val = r + else + call this%add_ts_strloc(token, structarray_col, col, row) + end if + ! + ! -- return + return + end function sv_read_token + + subroutine sv_add_ts_strloc(this, token, structarray_col, col, row) + ! -- dummy variables + class(StructVectorType) :: this + character(len=*), intent(in) :: token + integer(I4B), intent(in) :: structarray_col + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + class(TSStringLocType), pointer :: str_field + ! -- local variables + class(*), pointer :: obj + ! + ! -- + allocate (str_field) + str_field%structarray_col = structarray_col + str_field%col = col + str_field%row = row + str_field%token = token + ! + obj => str_field + call this%ts_strlocs%Add(obj) + ! + ! -- return + return + end subroutine sv_add_ts_strloc + + function sv_get_ts_strloc(this, idx) result(res) + ! -- dummy variables + class(StructVectorType) :: this + integer(I4B), intent(in) :: idx !< package number + class(TSStringLocType), pointer :: res + ! -- local variables + class(*), pointer :: obj + ! + ! -- initialize res + res => null() + ! + ! -- get the package from the list + obj => this%ts_strlocs%GetItem(idx) + if (associated(obj)) then + select type (obj) + class is (TSStringLocType) + res => obj + end select + end if + ! + ! -- return + return + end function sv_get_ts_strloc + + !> @brief + !< + subroutine sv_clear(this) + ! -- modules + ! -- dummy + class(StructVectorType) :: this + class(TSStringLocType), pointer :: ts_strloc + integer(I4B) :: n + ! + do n = 1, this%ts_strlocs%Count() + ts_strloc => this%get_ts_strloc(n) + deallocate (ts_strloc) + nullify (ts_strloc) + end do + ! + call this%ts_strlocs%Clear() + ! + return + end subroutine sv_clear + end module StructVectorModule diff --git a/src/Utilities/Idm/selector/IdmDfnSelector.f90 b/src/Utilities/Idm/selector/IdmDfnSelector.f90 index a3e13b0ead0..a7b6190f6ff 100644 --- a/src/Utilities/Idm/selector/IdmDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmDfnSelector.f90 @@ -1,24 +1,14 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use IdmGwfDfnSelectorModule, only: gwf_param_definitions, & - gwf_aggregate_definitions, & - gwf_block_definitions, & - gwf_idm_multi_package, & - gwf_idm_integrated - use IdmGwtDfnSelectorModule, only: gwt_param_definitions, & - gwt_aggregate_definitions, & - gwt_block_definitions, & - gwt_idm_multi_package, & - gwt_idm_integrated - use IdmSimDfnSelectorModule, only: sim_param_definitions, & - sim_aggregate_definitions, & - sim_block_definitions, & - sim_idm_multi_package, & - sim_idm_integrated + use IdmGwfDfnSelectorModule + use IdmGwtDfnSelectorModule + use IdmExgDfnSelectorModule + use IdmSimDfnSelectorModule implicit none private @@ -27,6 +17,7 @@ module IdmDfnSelectorModule public :: block_definitions public :: idm_multi_package public :: idm_integrated + public :: idm_component contains @@ -40,6 +31,8 @@ function param_definitions(component, subcomponent) result(input_definition) input_definition => gwf_param_definitions(subcomponent) case ('GWT') input_definition => gwt_param_definitions(subcomponent) + case ('EXG') + input_definition => exg_param_definitions(subcomponent) case ('SIM') input_definition => sim_param_definitions(subcomponent) case default @@ -57,6 +50,8 @@ function aggregate_definitions(component, subcomponent) result(input_definition) input_definition => gwf_aggregate_definitions(subcomponent) case ('GWT') input_definition => gwt_aggregate_definitions(subcomponent) + case ('EXG') + input_definition => exg_aggregate_definitions(subcomponent) case ('SIM') input_definition => sim_aggregate_definitions(subcomponent) case default @@ -74,6 +69,8 @@ function block_definitions(component, subcomponent) result(input_definition) input_definition => gwf_block_definitions(subcomponent) case ('GWT') input_definition => gwt_block_definitions(subcomponent) + case ('EXG') + input_definition => exg_block_definitions(subcomponent) case ('SIM') input_definition => sim_block_definitions(subcomponent) case default @@ -90,6 +87,8 @@ function idm_multi_package(component, subcomponent) result(multi_package) multi_package = gwf_idm_multi_package(subcomponent) case ('GWT') multi_package = gwt_idm_multi_package(subcomponent) + case ('EXG') + multi_package = exg_idm_multi_package(subcomponent) case ('SIM') multi_package = sim_idm_multi_package(subcomponent) case default @@ -110,6 +109,8 @@ function idm_integrated(component, subcomponent) result(integrated) integrated = gwf_idm_integrated(subcomponent) case ('GWT') integrated = gwt_idm_integrated(subcomponent) + case ('EXG') + integrated = exg_idm_integrated(subcomponent) case ('SIM') integrated = sim_idm_integrated(subcomponent) case default @@ -117,4 +118,22 @@ function idm_integrated(component, subcomponent) result(integrated) return end function idm_integrated + function idm_component(component) result(integrated) + character(len=*), intent(in) :: component + logical :: integrated + integrated = .false. + select case (component) + case ('GWF') + integrated = .true. + case ('GWT') + integrated = .true. + case ('EXG') + integrated = .true. + case ('SIM') + integrated = .true. + case default + end select + return + end function idm_component + end module IdmDfnSelectorModule diff --git a/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 b/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 new file mode 100644 index 00000000000..fa6aea90bc6 --- /dev/null +++ b/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 @@ -0,0 +1,116 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module IdmExgDfnSelectorModule + + use ConstantsModule, only: LENVARNAME + use SimModule, only: store_error + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + use ExgGwfgwfInputModule + use ExgGwfgwtInputModule + use ExgGwtgwtInputModule + + implicit none + private + public :: exg_param_definitions + public :: exg_aggregate_definitions + public :: exg_block_definitions + public :: exg_idm_multi_package + public :: exg_idm_integrated + +contains + + subroutine set_param_pointer(input_dfn, input_dfn_target) + type(InputParamDefinitionType), dimension(:), pointer :: input_dfn + type(InputParamDefinitionType), dimension(:), target :: input_dfn_target + input_dfn => input_dfn_target + end subroutine set_param_pointer + + subroutine set_block_pointer(input_dfn, input_dfn_target) + type(InputBlockDefinitionType), dimension(:), pointer :: input_dfn + type(InputBlockDefinitionType), dimension(:), target :: input_dfn_target + input_dfn => input_dfn_target + end subroutine set_block_pointer + + function exg_param_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputParamDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('GWFGWF') + call set_param_pointer(input_definition, exg_gwfgwf_param_definitions) + case ('GWFGWT') + call set_param_pointer(input_definition, exg_gwfgwt_param_definitions) + case ('GWTGWT') + call set_param_pointer(input_definition, exg_gwtgwt_param_definitions) + case default + end select + return + end function exg_param_definitions + + function exg_aggregate_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputParamDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('GWFGWF') + call set_param_pointer(input_definition, exg_gwfgwf_aggregate_definitions) + case ('GWFGWT') + call set_param_pointer(input_definition, exg_gwfgwt_aggregate_definitions) + case ('GWTGWT') + call set_param_pointer(input_definition, exg_gwtgwt_aggregate_definitions) + case default + end select + return + end function exg_aggregate_definitions + + function exg_block_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputBlockDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('GWFGWF') + call set_block_pointer(input_definition, exg_gwfgwf_block_definitions) + case ('GWFGWT') + call set_block_pointer(input_definition, exg_gwfgwt_block_definitions) + case ('GWTGWT') + call set_block_pointer(input_definition, exg_gwtgwt_block_definitions) + case default + end select + return + end function exg_block_definitions + + function exg_idm_multi_package(subcomponent) result(multi_package) + character(len=*), intent(in) :: subcomponent + logical :: multi_package + select case (subcomponent) + case ('GWFGWF') + multi_package = exg_gwfgwf_multi_package + case ('GWFGWT') + multi_package = exg_gwfgwt_multi_package + case ('GWTGWT') + multi_package = exg_gwtgwt_multi_package + case default + call store_error('Idm selector subcomponent not found; '//& + &'component="EXG"'//& + &', subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function exg_idm_multi_package + + function exg_idm_integrated(subcomponent) result(integrated) + character(len=*), intent(in) :: subcomponent + logical :: integrated + integrated = .false. + select case (subcomponent) + case ('GWFGWF') + integrated = .true. + case ('GWFGWT') + integrated = .true. + case ('GWTGWT') + integrated = .true. + case default + end select + return + end function exg_idm_integrated + +end module IdmExgDfnSelectorModule diff --git a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 index 4ff5996addd..7cfc9ccd101 100644 --- a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 @@ -1,29 +1,25 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmGwfDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use GwfDisInputModule, only: gwf_dis_param_definitions, & - gwf_dis_aggregate_definitions, & - gwf_dis_block_definitions, & - gwf_dis_multi_package - use GwfDisuInputModule, only: gwf_disu_param_definitions, & - gwf_disu_aggregate_definitions, & - gwf_disu_block_definitions, & - gwf_disu_multi_package - use GwfDisvInputModule, only: gwf_disv_param_definitions, & - gwf_disv_aggregate_definitions, & - gwf_disv_block_definitions, & - gwf_disv_multi_package - use GwfNpfInputModule, only: gwf_npf_param_definitions, & - gwf_npf_aggregate_definitions, & - gwf_npf_block_definitions, & - gwf_npf_multi_package - use GwfNamInputModule, only: gwf_nam_param_definitions, & - gwf_nam_aggregate_definitions, & - gwf_nam_block_definitions, & - gwf_nam_multi_package + use GwfChdInputModule + use GwfDisInputModule + use GwfDisuInputModule + use GwfDisvInputModule + use GwfDrnInputModule + use GwfEvtInputModule + use GwfEvtaInputModule + use GwfGhbInputModule + use GwfIcInputModule + use GwfNpfInputModule + use GwfRchInputModule + use GwfRchaInputModule + use GwfRivInputModule + use GwfWelInputModule + use GwfNamInputModule implicit none private @@ -52,14 +48,34 @@ function gwf_param_definitions(subcomponent) result(input_definition) type(InputParamDefinitionType), dimension(:), pointer :: input_definition nullify (input_definition) select case (subcomponent) + case ('CHD') + call set_param_pointer(input_definition, gwf_chd_param_definitions) case ('DIS') call set_param_pointer(input_definition, gwf_dis_param_definitions) case ('DISU') call set_param_pointer(input_definition, gwf_disu_param_definitions) case ('DISV') call set_param_pointer(input_definition, gwf_disv_param_definitions) + case ('DRN') + call set_param_pointer(input_definition, gwf_drn_param_definitions) + case ('EVT') + call set_param_pointer(input_definition, gwf_evt_param_definitions) + case ('EVTA') + call set_param_pointer(input_definition, gwf_evta_param_definitions) + case ('GHB') + call set_param_pointer(input_definition, gwf_ghb_param_definitions) + case ('IC') + call set_param_pointer(input_definition, gwf_ic_param_definitions) case ('NPF') call set_param_pointer(input_definition, gwf_npf_param_definitions) + case ('RCH') + call set_param_pointer(input_definition, gwf_rch_param_definitions) + case ('RCHA') + call set_param_pointer(input_definition, gwf_rcha_param_definitions) + case ('RIV') + call set_param_pointer(input_definition, gwf_riv_param_definitions) + case ('WEL') + call set_param_pointer(input_definition, gwf_wel_param_definitions) case ('NAM') call set_param_pointer(input_definition, gwf_nam_param_definitions) case default @@ -72,14 +88,34 @@ function gwf_aggregate_definitions(subcomponent) result(input_definition) type(InputParamDefinitionType), dimension(:), pointer :: input_definition nullify (input_definition) select case (subcomponent) + case ('CHD') + call set_param_pointer(input_definition, gwf_chd_aggregate_definitions) case ('DIS') call set_param_pointer(input_definition, gwf_dis_aggregate_definitions) case ('DISU') call set_param_pointer(input_definition, gwf_disu_aggregate_definitions) case ('DISV') call set_param_pointer(input_definition, gwf_disv_aggregate_definitions) + case ('DRN') + call set_param_pointer(input_definition, gwf_drn_aggregate_definitions) + case ('EVT') + call set_param_pointer(input_definition, gwf_evt_aggregate_definitions) + case ('EVTA') + call set_param_pointer(input_definition, gwf_evta_aggregate_definitions) + case ('GHB') + call set_param_pointer(input_definition, gwf_ghb_aggregate_definitions) + case ('IC') + call set_param_pointer(input_definition, gwf_ic_aggregate_definitions) case ('NPF') call set_param_pointer(input_definition, gwf_npf_aggregate_definitions) + case ('RCH') + call set_param_pointer(input_definition, gwf_rch_aggregate_definitions) + case ('RCHA') + call set_param_pointer(input_definition, gwf_rcha_aggregate_definitions) + case ('RIV') + call set_param_pointer(input_definition, gwf_riv_aggregate_definitions) + case ('WEL') + call set_param_pointer(input_definition, gwf_wel_aggregate_definitions) case ('NAM') call set_param_pointer(input_definition, gwf_nam_aggregate_definitions) case default @@ -92,14 +128,34 @@ function gwf_block_definitions(subcomponent) result(input_definition) type(InputBlockDefinitionType), dimension(:), pointer :: input_definition nullify (input_definition) select case (subcomponent) + case ('CHD') + call set_block_pointer(input_definition, gwf_chd_block_definitions) case ('DIS') call set_block_pointer(input_definition, gwf_dis_block_definitions) case ('DISU') call set_block_pointer(input_definition, gwf_disu_block_definitions) case ('DISV') call set_block_pointer(input_definition, gwf_disv_block_definitions) + case ('DRN') + call set_block_pointer(input_definition, gwf_drn_block_definitions) + case ('EVT') + call set_block_pointer(input_definition, gwf_evt_block_definitions) + case ('EVTA') + call set_block_pointer(input_definition, gwf_evta_block_definitions) + case ('GHB') + call set_block_pointer(input_definition, gwf_ghb_block_definitions) + case ('IC') + call set_block_pointer(input_definition, gwf_ic_block_definitions) case ('NPF') call set_block_pointer(input_definition, gwf_npf_block_definitions) + case ('RCH') + call set_block_pointer(input_definition, gwf_rch_block_definitions) + case ('RCHA') + call set_block_pointer(input_definition, gwf_rcha_block_definitions) + case ('RIV') + call set_block_pointer(input_definition, gwf_riv_block_definitions) + case ('WEL') + call set_block_pointer(input_definition, gwf_wel_block_definitions) case ('NAM') call set_block_pointer(input_definition, gwf_nam_block_definitions) case default @@ -111,14 +167,34 @@ function gwf_idm_multi_package(subcomponent) result(multi_package) character(len=*), intent(in) :: subcomponent logical :: multi_package select case (subcomponent) + case ('CHD') + multi_package = gwf_chd_multi_package case ('DIS') multi_package = gwf_dis_multi_package case ('DISU') multi_package = gwf_disu_multi_package case ('DISV') multi_package = gwf_disv_multi_package + case ('DRN') + multi_package = gwf_drn_multi_package + case ('EVT') + multi_package = gwf_evt_multi_package + case ('EVTA') + multi_package = gwf_evta_multi_package + case ('GHB') + multi_package = gwf_ghb_multi_package + case ('IC') + multi_package = gwf_ic_multi_package case ('NPF') multi_package = gwf_npf_multi_package + case ('RCH') + multi_package = gwf_rch_multi_package + case ('RCHA') + multi_package = gwf_rcha_multi_package + case ('RIV') + multi_package = gwf_riv_multi_package + case ('WEL') + multi_package = gwf_wel_multi_package case ('NAM') multi_package = gwf_nam_multi_package case default @@ -134,14 +210,34 @@ function gwf_idm_integrated(subcomponent) result(integrated) logical :: integrated integrated = .false. select case (subcomponent) + case ('CHD') + integrated = .true. case ('DIS') integrated = .true. case ('DISU') integrated = .true. case ('DISV') integrated = .true. + case ('DRN') + integrated = .true. + case ('EVT') + integrated = .true. + case ('EVTA') + integrated = .true. + case ('GHB') + integrated = .true. + case ('IC') + integrated = .true. case ('NPF') integrated = .true. + case ('RCH') + integrated = .true. + case ('RCHA') + integrated = .true. + case ('RIV') + integrated = .true. + case ('WEL') + integrated = .true. case ('NAM') integrated = .true. case default diff --git a/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 b/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 index 9c46a00b9b7..f9e71164ffa 100644 --- a/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 @@ -1,29 +1,17 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmGwtDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use GwtDisInputModule, only: gwt_dis_param_definitions, & - gwt_dis_aggregate_definitions, & - gwt_dis_block_definitions, & - gwt_dis_multi_package - use GwtDisuInputModule, only: gwt_disu_param_definitions, & - gwt_disu_aggregate_definitions, & - gwt_disu_block_definitions, & - gwt_disu_multi_package - use GwtDisvInputModule, only: gwt_disv_param_definitions, & - gwt_disv_aggregate_definitions, & - gwt_disv_block_definitions, & - gwt_disv_multi_package - use GwtDspInputModule, only: gwt_dsp_param_definitions, & - gwt_dsp_aggregate_definitions, & - gwt_dsp_block_definitions, & - gwt_dsp_multi_package - use GwtNamInputModule, only: gwt_nam_param_definitions, & - gwt_nam_aggregate_definitions, & - gwt_nam_block_definitions, & - gwt_nam_multi_package + use GwtDisInputModule + use GwtDisuInputModule + use GwtDisvInputModule + use GwtDspInputModule + use GwtCncInputModule + use GwtIcInputModule + use GwtNamInputModule implicit none private @@ -60,6 +48,10 @@ function gwt_param_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwt_disv_param_definitions) case ('DSP') call set_param_pointer(input_definition, gwt_dsp_param_definitions) + case ('CNC') + call set_param_pointer(input_definition, gwt_cnc_param_definitions) + case ('IC') + call set_param_pointer(input_definition, gwt_ic_param_definitions) case ('NAM') call set_param_pointer(input_definition, gwt_nam_param_definitions) case default @@ -80,6 +72,10 @@ function gwt_aggregate_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwt_disv_aggregate_definitions) case ('DSP') call set_param_pointer(input_definition, gwt_dsp_aggregate_definitions) + case ('CNC') + call set_param_pointer(input_definition, gwt_cnc_aggregate_definitions) + case ('IC') + call set_param_pointer(input_definition, gwt_ic_aggregate_definitions) case ('NAM') call set_param_pointer(input_definition, gwt_nam_aggregate_definitions) case default @@ -100,6 +96,10 @@ function gwt_block_definitions(subcomponent) result(input_definition) call set_block_pointer(input_definition, gwt_disv_block_definitions) case ('DSP') call set_block_pointer(input_definition, gwt_dsp_block_definitions) + case ('CNC') + call set_block_pointer(input_definition, gwt_cnc_block_definitions) + case ('IC') + call set_block_pointer(input_definition, gwt_ic_block_definitions) case ('NAM') call set_block_pointer(input_definition, gwt_nam_block_definitions) case default @@ -119,6 +119,10 @@ function gwt_idm_multi_package(subcomponent) result(multi_package) multi_package = gwt_disv_multi_package case ('DSP') multi_package = gwt_dsp_multi_package + case ('CNC') + multi_package = gwt_cnc_multi_package + case ('IC') + multi_package = gwt_ic_multi_package case ('NAM') multi_package = gwt_nam_multi_package case default @@ -142,6 +146,10 @@ function gwt_idm_integrated(subcomponent) result(integrated) integrated = .true. case ('DSP') integrated = .true. + case ('CNC') + integrated = .true. + case ('IC') + integrated = .true. case ('NAM') integrated = .true. case default diff --git a/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 b/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 index dc216101720..bf18e39f182 100644 --- a/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 @@ -1,13 +1,11 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmSimDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use SimNamInputModule, only: sim_nam_param_definitions, & - sim_nam_aggregate_definitions, & - sim_nam_block_definitions, & - sim_nam_multi_package + use SimNamInputModule implicit none private diff --git a/src/Utilities/InputOutput.f90 b/src/Utilities/InputOutput.f90 index 8d12c1bd21b..4c3094299c5 100644 --- a/src/Utilities/InputOutput.f90 +++ b/src/Utilities/InputOutput.f90 @@ -5,49 +5,41 @@ module InputOutputModule use KindModule, only: DP, I4B, I8B use SimVariablesModule, only: iunext, isim_mode, errmsg use SimModule, only: store_error, store_error_unit - use ConstantsModule, only: IUSTART, IULAST, & - LINELENGTH, LENBIGLINE, LENBOUNDNAME, & - NAMEDBOUNDFLAG, MAXCHARLEN, & - TABLEFT, TABCENTER, TABRIGHT, & - TABSTRING, TABUCSTRING, TABINTEGER, TABREAL, & - DZERO - use GenericUtilitiesModule, only: is_same, sim_message + use ConstantsModule, only: IUSTART, IULAST, LINELENGTH, LENBIGLINE, & + LENBOUNDNAME, NAMEDBOUNDFLAG, MAXCHARLEN, & + TABLEFT, TABCENTER, TABRIGHT, TABSTRING, & + TABUCSTRING, TABINTEGER, TABREAL, DZERO + use MessageModule, only: write_message private - public :: GetUnit, uget_block, & - uterminate_block, UPCASE, URWORD, ULSTLB, UBDSV4, & - ubdsv06, UBDSVB, UCOLNO, ULAPRW, & - ULASAV, ubdsv1, ubdsvc, ubdsvd, UWWORD, & - same_word, get_node, get_ijk, unitinquire, & - ParseLine, ulaprufw, openfile, & - linear_interpolate, lowcase, & - read_line, uget_any_block, & - GetFileFromPath, extract_idnum_or_bndname, urdaux, & - get_jk, print_format, BuildFixedFormat, & - BuildFloatFormat, BuildIntFormat, fseek_stream, & - get_nwords, u9rdcom + public :: GetUnit, UPCASE, URWORD, ULSTLB, UBDSV4, ubdsv06, UBDSVB, UCOLNO, & + ULAPRW, ULASAV, ubdsv1, ubdsvc, ubdsvd, UWWORD, same_word, & + str_pad_left, unitinquire, ParseLine, ulaprufw, openfile, & + linear_interpolate, lowcase, read_line, GetFileFromPath, & + extract_idnum_or_bndname, urdaux, print_format, BuildFixedFormat, & + BuildFloatFormat, BuildIntFormat, fseek_stream, get_nwords, & + u9rdcom, append_processor_id - contains +contains !> @brief Open a file !! !! Subroutine to open a file using the specified arguments - !! !< - subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, & + subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, & filstat_opt, mode_opt) ! -- modules use OpenSpecModule, only: action implicit none - ! -- dummy variables - integer(I4B), intent(inout) :: iu !< unit number - integer(I4B), intent(in) :: iout !< output unit number to write a message (iout=0 does not print) - character(len=*), intent(in) :: fname !< name of the file - character(len=*), intent(in) :: ftype !< file type (e.g. WEL) - character(len=*), intent(in), optional :: fmtarg_opt !< file format, default is 'formatted' - character(len=*), intent(in), optional :: accarg_opt !< file access, default is 'sequential' - character(len=*), intent(in), optional :: filstat_opt !< file status, default is 'old'. Use 'REPLACE' for output file. - integer(I4B), intent(in), optional :: mode_opt !< simulation mode that is evaluated to determine if the file should be opened - ! -- local variables + ! -- dummy + integer(I4B), intent(inout) :: iu !< unit number + integer(I4B), intent(in) :: iout !< output unit number to write a message (iout=0 does not print) + character(len=*), intent(in) :: fname !< name of the file + character(len=*), intent(in) :: ftype !< file type (e.g. WEL) + character(len=*), intent(in), optional :: fmtarg_opt !< file format, default is 'formatted' + character(len=*), intent(in), optional :: accarg_opt !< file access, default is 'sequential' + character(len=*), intent(in), optional :: filstat_opt !< file status, default is 'old'. Use 'REPLACE' for output file. + integer(I4B), intent(in), optional :: mode_opt !< simulation mode that is evaluated to determine if the file should be opened + ! -- local character(len=20) :: fmtarg character(len=20) :: accarg character(len=20) :: filstat @@ -57,23 +49,23 @@ subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, & integer(I4B) :: ivar integer(I4B) :: iuop ! -- formats -50 FORMAT(1X,/1X,'OPENED ',A,/ & - 1X,'FILE TYPE:',A,' UNIT ',I4,3X,'STATUS:',A,/ & - 1X,'FORMAT:',A,3X,'ACCESS:',A/ & - 1X,'ACTION:',A/) -60 FORMAT(1X,/1X,'DID NOT OPEN ',A,/) + character(len=*), parameter :: fmtmsg = & + "(1x,/1x,'OPENED ',a,/1x,'FILE TYPE:',a,' UNIT ',I4,3x,'STATUS:',a,/ & + & 1x,'FORMAT:',a,3x,'ACCESS:',a/1x,'ACTION:',a/)" + character(len=*), parameter :: fmtmsg2 = & + "(1x,/1x,'DID NOT OPEN ',a,/)" ! - ! -- process mode_opt + ! -- Process mode_opt if (present(mode_opt)) then imode = mode_opt else imode = isim_mode end if ! - ! -- evaluate if the file should be opened + ! -- Evaluate if the file should be opened if (isim_mode < imode) then - if(iout > 0) then - write(iout, 60) trim(fname) + if (iout > 0) then + write (iout, fmtmsg2) trim(fname) end if else ! @@ -83,49 +75,49 @@ subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, & filstat = 'OLD' ! ! -- Override defaults - if(present(fmtarg_opt)) then + if (present(fmtarg_opt)) then fmtarg = fmtarg_opt call upcase(fmtarg) - endif - if(present(accarg_opt)) then + end if + if (present(accarg_opt)) then accarg = accarg_opt call upcase(accarg) - endif - if(present(filstat_opt)) then + end if + if (present(filstat_opt)) then filstat = filstat_opt call upcase(filstat) - endif - if(filstat == 'OLD') then + end if + if (filstat == 'OLD') then filact = action(1) else filact = action(2) - endif + end if ! ! -- size of fname iflen = len_trim(fname) ! ! -- Get a free unit number - if(iu <= 0) then + if (iu <= 0) then call freeunitnumber(iu) - endif + end if ! ! -- Check to see if file is already open, if not then open the file - inquire(file=fname(1:iflen), number=iuop) - if(iuop > 0) then + inquire (file=fname(1:iflen), number=iuop) + if (iuop > 0) then ivar = -1 else - open(unit=iu, file=fname(1:iflen), form=fmtarg, access=accarg, & - status=filstat, action=filact, iostat=ivar) - endif + open (unit=iu, file=fname(1:iflen), form=fmtarg, access=accarg, & + status=filstat, action=filact, iostat=ivar) + end if ! ! -- Check for an error - if(ivar /= 0) then + if (ivar /= 0) then write (errmsg, '(3a,1x,i0,a)') & 'Could not open "', fname(1:iflen), '" on unit', iu, '.' - if(iuop > 0) then + if (iuop > 0) then write (errmsg, '(a,1x,a,1x,i0,a)') & trim(errmsg), 'File already open on unit', iuop, '.' - endif + end if write (errmsg, '(a,1x,a,1x,a,a)') & trim(errmsg), 'Specified file status', trim(filstat), '.' write (errmsg, '(a,1x,a,1x,a,a)') & @@ -139,58 +131,53 @@ subroutine openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, & write (errmsg, '(a,1x,a)') & trim(errmsg), 'STOP EXECUTION in subroutine openfile().' call store_error(errmsg, terminate=.TRUE.) - endif + end if ! ! -- Write a message - if(iout > 0) then - write(iout, 50) fname(1:iflen), & - ftype, iu, filstat, & - fmtarg, accarg, & - filact + if (iout > 0) then + write (iout, fmtmsg) fname(1:iflen), ftype, iu, filstat, fmtarg, & + accarg, filact end if end if ! - ! -- return + ! -- Return return end subroutine openfile !> @brief Assign a free unopened unit number !! !! Subroutine to assign a free unopened unit number to the iu dummy argument - !! !< subroutine freeunitnumber(iu) ! -- modules implicit none - ! -- dummy variables - integer(I4B),intent(inout) :: iu !< next free file unit number - ! -- local variables + ! -- dummy + integer(I4B), intent(inout) :: iu !< next free file unit number + ! -- local integer(I4B) :: i logical :: opened ! - ! -- code do i = iunext, iulast - inquire(unit=i, opened=opened) - if(.not. opened) exit - enddo + inquire (unit=i, opened=opened) + if (.not. opened) exit + end do iu = i iunext = iu + 1 ! - ! -- return + ! -- Return return end subroutine freeunitnumber !> @brief Get a free unit number !! !! Function to get a free unit number that hasn't been used - !! !< function getunit() ! -- modules implicit none ! -- return - integer(I4B) :: getunit !< free unit number - ! -- local variables + integer(I4B) :: getunit !< free unit number + ! -- local integer(I4B) :: iunit ! ! -- code @@ -200,250 +187,16 @@ function getunit() ! -- Return return end function getunit - - !> @brief Find a block in a file - !! - !! Subroutine to read from a file until the tag (ctag) for a block is - !! is found. Return isfound with true, if found. - !! - !< - subroutine uget_block(iin, iout, ctag, ierr, isfound, lloc, line, iuext, & - blockRequired, supportopenclose) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit - integer(I4B), intent(in) :: iout !< output listing file unit - character (len=*), intent(in) :: ctag !< block tag - integer(I4B), intent(out) :: ierr !< error - logical, intent(inout) :: isfound !< boolean indicating if the block was found - integer(I4B), intent(inout) :: lloc !< position in line - character (len=:), allocatable, intent(inout) :: line !< line - integer(I4B), intent(inout) :: iuext !< external file unit number - logical, optional, intent(in) :: blockRequired !< boolean indicating if the block is required - logical, optional, intent(in) :: supportopenclose !< boolean indicating if the block supports open/close - ! -- local variables - integer(I4B) :: istart - integer(I4B) :: istop - integer(I4B) :: ival - integer(I4B) :: lloc2 - real(DP) :: rval - character (len=:), allocatable :: line2 - character(len=LINELENGTH) :: fname - character(len=MAXCHARLEN) :: ermsg - logical :: supportoc, blockRequiredLocal - ! - ! -- code - if (present(blockRequired)) then - blockRequiredLocal = blockRequired - else - blockRequiredLocal = .true. - endif - supportoc = .false. - if (present(supportopenclose)) then - supportoc = supportopenclose - endif - iuext = iin - isfound = .false. - mainloop: do - lloc = 1 - call u9rdcom(iin, iout, line, ierr) - if (ierr < 0) then - if (blockRequiredLocal) then - ermsg = 'Required block "' // trim(ctag) // & - '" not found. Found end of file instead.' - call store_error(ermsg) - call store_error_unit(iuext) - end if - ! block not found so exit - exit - end if - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == 'BEGIN') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == ctag) then - isfound = .true. - if (supportoc) then - ! Look for OPEN/CLOSE on 1st line after line starting with BEGIN - call u9rdcom(iin, iout, line2, ierr) - if (ierr < 0) exit - lloc2 = 1 - call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) - if (line2(istart:istop) == 'OPEN/CLOSE') then - ! -- Get filename and preserve case - call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout) - fname = line2(istart:istop) - ! If line contains '(BINARY)' or 'SFAC', handle this block elsewhere - chk: do - call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout) - if (line2(istart:istop) == '') exit chk - if (line2(istart:istop) == '(BINARY)' .or. & - line2(istart:istop) == 'SFAC') then - backspace(iin) - exit mainloop - end if - end do chk - iuext = GetUnit() - call openfile(iuext,iout,fname,'OPEN/CLOSE') - else - backspace(iin) - end if - end if - else - if (blockRequiredLocal) then - ermsg = 'Error: Required block "' // trim(ctag) // & - '" not found. Found block "' // line(istart:istop) // & - '" instead.' - call store_error(ermsg) - call store_error_unit(iuext) - else - backspace(iin) - endif - end if - exit mainloop - else if (line(istart:istop) == 'END') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == ctag) then - ermsg = 'Error: Looking for BEGIN ' // trim(ctag) // & - ' but found END ' // line(istart:istop) // & - ' instead.' - call store_error(ermsg) - call store_error_unit(iuext) - endif - end if - end do mainloop - ! - ! -- return - return - end subroutine uget_block - - !> @brief Find the next block in a file - !! - !! Subroutine to read from a file until next block is found. - !! Return isfound with true, if found, and return the block name. - !! - !< - subroutine uget_any_block(iin,iout,isfound,lloc,line,ctagfound,iuext) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit number - integer(I4B), intent(in) :: iout !< output listing file unit - logical, intent(inout) :: isfound !< boolean indicating if a block was found - integer(I4B), intent(inout) :: lloc !< position in line - character (len=:), allocatable, intent(inout) :: line !< line - character(len=*), intent(out) :: ctagfound !< block name - integer(I4B), intent(inout) :: iuext !< external file unit number - ! -- local variables - integer(I4B) :: ierr, istart, istop - integer(I4B) :: ival, lloc2 - real(DP) :: rval - character(len=100) :: ermsg - character (len=:), allocatable :: line2 - character(len=LINELENGTH) :: fname - ! - ! -- code - isfound = .false. - ctagfound = '' - iuext = iin - do - lloc = 1 - call u9rdcom(iin,iout,line,ierr) - if (ierr < 0) exit - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) == 'BEGIN') then - call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout) - if (line(istart:istop) /= '') then - isfound = .true. - ctagfound = line(istart:istop) - call u9rdcom(iin,iout,line2,ierr) - if (ierr < 0) exit - lloc2 = 1 - call urword(line2,lloc2,istart,istop,1,ival,rval,iout,iin) - if (line2(istart:istop) == 'OPEN/CLOSE') then - iuext = GetUnit() - call urword(line2,lloc2,istart,istop,0,ival,rval,iout,iin) - fname = line2(istart:istop) - call openfile(iuext,iout,fname,'OPEN/CLOSE') - else - backspace(iin) - endif - else - ermsg = 'Block name missing in file.' - call store_error(ermsg) - call store_error_unit(iin) - end if - exit - end if - end do - return - end subroutine uget_any_block - - !> @brief Evaluate if the end of a block has been found - !! - !! Subroutine to evaluate if the end of a block has been found. Abnormal - !! termination if 'begin' is found or if 'end' encountered with - !! incorrect tag. - !! - !< - subroutine uterminate_block(iin,iout,key,ctag,lloc,line,ierr,iuext) - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin !< file unit number - integer(I4B), intent(in) :: iout !< output listing file unit number - character (len=*), intent(in) :: key !< keyword in block - character (len=*), intent(in) :: ctag !< block name - integer(I4B), intent(inout) :: lloc !< position in line - character (len=*), intent(inout) :: line !< line - integer(I4B), intent(inout) :: ierr !< error - integer(I4B), intent(inout) :: iuext !< external file unit number - ! -- local variables - character(len=LENBIGLINE) :: ermsg - integer(I4B) :: istart - integer(I4B) :: istop - integer(I4B) :: ival - real(DP) :: rval - ! -- format -1 format('ERROR. "',A,'" DETECTED WITHOUT "',A,'". ','"END',1X,A, & - '" MUST BE USED TO END ',A,'.') -2 format('ERROR. "',A,'" DETECTED BEFORE "END',1X,A,'". ','"END',1X,A, & - '" MUST BE USED TO END ',A,'.') - ! - ! -- code - ierr = 1 - select case(key) - case ('END') - call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin) - if (line(istart:istop) /= ctag) then - write(ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag) - call store_error(ermsg) - call store_error_unit(iin) - else - ierr = 0 - if (iuext /= iin) then - ! -- close external file - close(iuext) - iuext = iin - endif - end if - case ('BEGIN') - write(ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag) - call store_error(ermsg) - call store_error_unit(iin) - end select - ! - ! -- return - return - end subroutine uterminate_block !> @brief Convert to upper case !! !! Subroutine to convert a character string to upper case. - !! !< subroutine upcase(word) implicit none - ! -- dummy variables - character (len=*), intent(inout) :: word !< word to convert to upper case - ! -- local variables + ! -- dummy + character(len=*), intent(inout) :: word !< word to convert to upper case + ! -- local integer(I4B) :: l integer(I4B) :: idiff integer(I4B) :: k @@ -458,167 +211,197 @@ subroutine upcase(word) word(k:k) = char(ichar(word(k:k)) - idiff) end do ! - ! -- return. + ! -- Return return - end subroutine upcase + end subroutine upcase !> @brief Convert to lower case !! !! Subroutine to convert a character string to lower case. - !! !< subroutine lowcase(word) implicit none - ! -- dummy variables - character(len=*) :: word !< - ! -- local variables + ! -- dummy + character(len=*) :: word + ! -- local integer(I4B) :: idiff, k, l ! - ! -- compute the difference between lowercase and uppercase. + ! -- Compute the difference between lowercase and uppercase. l = len(word) idiff = ichar('a') - ichar('A') ! - ! -- loop through the string and convert any uppercase characters. + ! -- Loop through the string and convert any uppercase characters. do k = 1, l - if(word(k:k) >= 'A' .and. word(k:k) <= 'Z') then - word(k:k)=char(ichar(word(k:k))+idiff) - endif - enddo + if (word(k:k) >= 'A' .and. word(k:k) <= 'Z') then + word(k:k) = char(ichar(word(k:k)) + idiff) + end if + end do ! - ! -- return. + ! -- Return return end subroutine lowcase - !> @brief Create a formatted line + !> @brief Append processor id to a string !! - !! Subroutine to create a formatted line with specified alignment - !! and column separators. Like URWORD, UWWORD works with strings, - !! integers, and floats. Can pass an optional format statement, - !! alignment, and column separator. + !! Subroutine to append the processor id to a string before the file extension + !! (extension is the string after the last '.' in the string. If there is + !! no '.' in the string the processor id is appended to the end of the string. + !< + subroutine append_processor_id(name, proc_id) + ! -- dummy + character(len=LINELENGTH), intent(inout) :: name !< file name + integer(I4B), intent(in) :: proc_id !< processor id + ! -- local + character(len=LINELENGTH) :: name_local + character(len=LINELENGTH) :: name_processor + character(len=LINELENGTH) :: extension_local + integer(I4B) :: ipos0 + integer(I4B) :: ipos1 + ! + name_local = name + call lowcase(name_local) + ipos0 = index(name_local, ".", back=.TRUE.) + ipos1 = len_trim(name) + if (ipos0 > 0) then + write (extension_local, '(a)') name(ipos0:ipos1) + else + ipos0 = ipos1 + extension_local = '' + end if + write (name_processor, '(a,a,i0,a)') & + name(1:ipos0 - 1), '.p', proc_id, trim(adjustl(extension_local)) + name = name_processor + ! + ! -- Return + return + end subroutine append_processor_id + + !> @brief Create a formatted line !! + !! Subroutine to create a formatted line with specified alignment and column + !! separators. Like URWORD, UWWORD works with strings, integers, and floats. + !! Can pass an optional format statement, alignment, and column separator. !< - subroutine UWWORD(LINE,ICOL,ILEN,NCODE,C,N,R,FMT,ALIGNMENT,SEP) + subroutine UWWORD(line, icol, ilen, ncode, c, n, r, fmt, alignment, sep) implicit none - ! -- dummy variables - character (len=*), intent(inout) :: LINE !< line - integer(I4B), intent(inout) :: ICOL !< column to write to line - integer(I4B), intent(in) :: ILEN !< current length of line - integer(I4B), intent(in) :: NCODE !< code for data type to write - character (len=*), intent(in) :: C !< character data type - integer(I4B), intent(in) :: N !< integer data type - real(DP), intent(in) :: R !< float data type - character (len=*), optional, intent(in) :: FMT !< format statement - integer(I4B), optional, intent(in) :: ALIGNMENT !< alignment specifier - character (len=*), optional, intent(in) :: SEP !< column separator - ! -- local variables - character (len=16) :: cfmt - character (len=16) :: cffmt - character (len=ILEN) :: cval + ! -- dummy + character(len=*), intent(inout) :: line !< line + integer(I4B), intent(inout) :: icol !< column to write to line + integer(I4B), intent(in) :: ilen !< current length of line + integer(I4B), intent(in) :: ncode !< code for data type to write + character(len=*), intent(in) :: c !< character data type + integer(I4B), intent(in) :: n !< integer data type + real(DP), intent(in) :: r !< float data type + character(len=*), optional, intent(in) :: fmt !< format statement + integer(I4B), optional, intent(in) :: alignment !< alignment specifier + character(len=*), optional, intent(in) :: sep !< column separator + ! -- local + character(len=16) :: cfmt + character(len=16) :: cffmt + character(len=ILEN) :: cval integer(I4B) :: ialign integer(I4B) :: i integer(I4B) :: ispace integer(I4B) :: istop integer(I4B) :: ipad integer(I4B) :: ireal - ! -- code ! ! -- initialize locals ipad = 0 ireal = 0 ! ! -- process dummy variables - if (present(FMT)) then - CFMT = FMT + if (present(fmt)) then + cfmt = fmt else - select case(NCODE) - case(TABSTRING, TABUCSTRING) - write(cfmt, '(A,I0,A)') '(A', ILEN, ')' - case(TABINTEGER) - write(cfmt, '(A,I0,A)') '(I', ILEN, ')' - case(TABREAL) - ireal = 1 - i = ILEN - 7 - write(cfmt, '(A,I0,A,I0,A)') '(1PG', ILEN, '.', i, ')' - if (R >= DZERO) then - ipad = 1 - end if + select case (ncode) + case (TABSTRING, TABUCSTRING) + write (cfmt, '(a,I0,a)') '(a', ilen, ')' + case (TABINTEGER) + write (cfmt, '(a,I0,a)') '(I', ilen, ')' + case (TABREAL) + ireal = 1 + i = ilen - 7 + write (cfmt, '(a,I0,a,I0,a)') '(1PG', ilen, '.', i, ')' + if (R >= DZERO) then + ipad = 1 + end if end select end if - write(cffmt, '(A,I0,A)') '(A', ILEN, ')' - - if (present(ALIGNMENT)) then - ialign = ALIGNMENT + write (cffmt, '(a,I0,a)') '(a', ilen, ')' + ! + if (present(alignment)) then + ialign = alignment else ialign = TABRIGHT end if ! - ! -- - if (NCODE == TABSTRING .or. NCODE == TABUCSTRING) then + if (ncode == TABSTRING .or. ncode == TABUCSTRING) then cval = C - if (NCODE == TABUCSTRING) then - call UPCASE(cval) + if (ncode == TABUCSTRING) then + call UPcase(cval) end if - else if (NCODE == TABINTEGER) then - write(cval, cfmt) N - else if (NCODE == TABREAL) then - write(cval, cfmt) R + else if (ncode == TABINTEGER) then + write (cval, cfmt) n + else if (ncode == TABREAL) then + write (cval, cfmt) r end if ! - ! -- apply alignment to cval - if (len_trim(adjustl(cval)) > ILEN) then + ! -- Apply alignment to cval + if (len_trim(adjustl(cval)) > ilen) then cval = adjustl(cval) else cval = trim(adjustl(cval)) end if if (ialign == TABCENTER) then i = len_trim(cval) - ispace = (ILEN - i) / 2 + ispace = (ilen - i) / 2 if (ireal > 0) then if (ipad > 0) then - cval = ' ' //trim(adjustl(cval)) + cval = ' '//trim(adjustl(cval)) else cval = trim(adjustl(cval)) end if else - cval = repeat(' ', ispace) // trim(cval) + cval = repeat(' ', ispace)//trim(cval) end if else if (ialign == TABLEFT) then cval = trim(adjustl(cval)) if (ipad > 0) then - cval = ' ' //trim(adjustl(cval)) + cval = ' '//trim(adjustl(cval)) end if else cval = adjustr(cval) end if - if (NCODE == TABUCSTRING) then - call UPCASE(cval) + if (ncode == TABUCSTRING) then + call UPcase(cval) end if ! - ! -- increment istop to the end of the column - istop = ICOL + ILEN - 1 + ! -- Increment istop to the end of the column + istop = icol + ilen - 1 ! - ! -- write final string to line - write(LINE(ICOL:istop), cffmt) cval - - ICOL = istop + 1 - - if (present(SEP)) then - i = len(SEP) - istop = ICOL + i - write(LINE(ICOL:istop), '(A)') SEP - ICOL = istop + ! -- Write final string to line + write (line(icol:istop), cffmt) cval + ! + icoL = istop + 1 + ! + if (present(sep)) then + i = len(sep) + istop = icol + i + write (line(icol:istop), '(a)') sep + icol = istop end if ! - !-- return + ! -- Return return end subroutine UWWORD !> @brief Extract a word from a string !! !! Subroutine to extract a word from a line of text, and optionally - !! convert the word to a number. The last character in the line is - !! set to blank so that if any problems occur with finding a word, - !! istart and istop will point to this blank character. Thus, a word + !! convert the word to a number. The last character in the line is + !! set to blank so that if any problems occur with finding a word, + !! istart and istop will point to this blank character. Thus, a word !! will always be returned unless there is a numeric conversion error. !! Be sure that the last character in line is not an important character !! because it will always be set to blank. @@ -629,552 +412,559 @@ end subroutine UWWORD !! commas separated by one or more spaces as a null word. !! !! For a word that begins with "'" or '"', the word starts with - !! the character after the quote and ends with the character preceding + !! the character after the quote and ends with the character preceding !! a subsequent quote. Thus, a quoted word can include spaces and commas. - !! The quoted word cannot contain a quote character of the same type - !! within the word but can contain a different quote character. For + !! The quoted word cannot contain a quote character of the same type + !! within the word but can contain a different quote character. For !! example, "WORD'S" or 'WORD"S'. !! - !! Number conversion error is written to unit iout if iout is positive; - !! error is written to default output if iout is 0; no error message is + !! Number conversion error is written to unit iout if iout is positive; + !! error is written to default output if iout is 0; no error message is !! written if iout is negative. !! !< - SUBROUTINE URWORD(LINE,ICOL,ISTART,ISTOP,NCODE,N,R,IOUT,IN) - ! -- dummy variables - character(len=*) :: LINE !< line to parse - integer(I4B), intent(inout) :: icol !< current column in line - integer(I4B), intent(inout) :: istart !< starting character position of the word - integer(I4B), intent(inout) :: istop !< ending character position of the word - integer(I4B), intent(in) :: ncode !< word conversion flag (1) upper case, (2) integer, (3) real number - integer(I4B), intent(inout) :: n !< integer data type - real(DP), intent(inout) :: r !< float data type - integer(I4B), intent(in) :: iout !< output listing file unit - integer(I4B), intent(in) :: in !< input file unit number - ! -- local variables - CHARACTER(len=20) STRING - CHARACTER(len=30) RW - CHARACTER(len=1) TAB - CHARACTER(len=1) CHAREND + subroutine URWORD(line, icol, istart, istop, ncode, n, r, iout, in) + ! -- dummy + character(len=*) :: line !< line to parse + integer(I4B), intent(inout) :: icol !< current column in line + integer(I4B), intent(inout) :: istart !< starting character position of the word + integer(I4B), intent(inout) :: istop !< ending character position of the word + integer(I4B), intent(in) :: ncode !< word conversion flag (1) upper case, (2) integer, (3) real number + integer(I4B), intent(inout) :: n !< integer data type + real(DP), intent(inout) :: r !< float data type + integer(I4B), intent(in) :: iout !< output listing file unit + integer(I4B), intent(in) :: in !< input file unit number + ! -- local + character(len=20) string + character(len=30) rw + character(len=1) tab + character(len=1) charend character(len=200) :: msg - character(len=LINELENGTH) :: msg_line - ! - ! -- code - TAB=CHAR(9) + character(len=linelength) :: msg_line + ! -- formats + character(len=*), parameter :: fmtmsgout1 = & + "(1X,'FILE UNIT ',I4,' : ERROR CONVERTING ""',A, & + & '"" TO ',A,' IN LINE:')" + character(len=*), parameter :: fmtmsgout2 = "(1x, & + & 'KEYBOARD INPUT : ERROR CONVERTING ""',a,'"" TO ',a,' IN LINE:')" + character(len=*), parameter :: fmtmsgout3 = "('File unit ', & + & I0,': Error converting ""',a,'"" to ',A,' in following line:')" + character(len=*), parameter :: fmtmsgout4 = & + "('Keyboard input: Error converting ""',a, & + & '"" to ',A,' in following line:')" + ! + tab = char(9) ! ! -- Set last char in LINE to blank and set ISTART and ISTOP to point ! to this blank as a default situation when no word is found. If ! starting location in LINE is out of bounds, do not look for a word. - LINLEN=LEN(LINE) - LINE(LINLEN:LINLEN)=' ' - ISTART=LINLEN - ISTOP=LINLEN - LINLEN=LINLEN-1 - IF(ICOL.LT.1 .OR. ICOL.GT.LINLEN) GO TO 100 + linlen = len(line) + line(linlen:linlen) = ' ' + istart = linlen + istop = linlen + linlen = linlen - 1 + if (icol < 1 .or. icol > linlen) go to 100 ! ! -- Find start of word, which is indicated by first character that ! is not a blank, a comma, or a tab. - DO 10 I=ICOL,LINLEN - IF(LINE(I:I).NE.' ' .AND. LINE(I:I).NE.',' .AND. & - LINE(I:I).NE.TAB) GO TO 20 -10 CONTINUE - ICOL=LINLEN+1 - GO TO 100 + do i = icol, linlen + if (line(i:i) /= ' ' .and. line(i:i) /= ',' .and. & + line(i:i) /= tab) go to 20 + end do + icol = linlen + 1 + go to 100 ! ! -- Found start of word. Look for end. ! When word is quoted, only a quote can terminate it. - ! SEARCH FOR A SINGLE (CHAR(39)) OR DOUBLE (CHAR(34)) QUOTE -20 IF(LINE(I:I).EQ.CHAR(34) .OR. LINE(I:I).EQ.CHAR(39)) THEN - IF (LINE(I:I).EQ.CHAR(34)) THEN - CHAREND = CHAR(34) - ELSE - CHAREND = CHAR(39) - END IF - I=I+1 - IF(I.LE.LINLEN) THEN - DO 25 J=I,LINLEN - IF(LINE(J:J).EQ.CHAREND) GO TO 40 -25 CONTINUE - END IF - ! - ! -- When word is not quoted, space, comma, or tab will terminate. - ELSE - DO 30 J=I,LINLEN - IF(LINE(J:J).EQ.' ' .OR. LINE(J:J).EQ.',' .OR. & - LINE(J:J).EQ.TAB) GO TO 40 -30 CONTINUE - END IF + ! search for a single (char(39)) or double (char(34)) quote +20 if (line(i:i) == char(34) .or. line(i:i) == char(39)) then + if (line(i:i) == char(34)) then + charend = char(34) + else + charend = char(39) + end if + i = i + 1 + if (i <= linlen) then + do j = i, linlen + if (line(j:j) == charend) go to 40 + end do + end if + ! + ! -- When word is not quoted, space, comma, or tab will terminate. + else + do j = i, linlen + if (line(j:j) == ' ' .or. line(j:j) == ',' .or. & + line(j:j) == tab) go to 40 + end do + end if ! ! -- End of line without finding end of word; set end of word to ! end of line. - J=LINLEN+1 + j = linlen + 1 ! ! -- Found end of word; set J to point to last character in WORD and ! set ICOL to point to location for scanning for another word. -40 ICOL=J+1 - J=J-1 - IF(J.LT.I) GO TO 100 - ISTART=I - ISTOP=J +40 icol = j + 1 + j = j - 1 + if (j < i) go to 100 + istart = i + istop = j ! ! -- Convert word to upper case and RETURN if NCODE is 1. - IF(NCODE.EQ.1) THEN - IDIFF=ICHAR('a')-ICHAR('A') - DO 50 K=ISTART,ISTOP - IF(LINE(K:K).GE.'a' .AND. LINE(K:K).LE.'z') & - LINE(K:K)=CHAR(ICHAR(LINE(K:K))-IDIFF) -50 CONTINUE - RETURN - END IF + if (ncode == 1) then + idiff = ichar('a') - ichar('A') + do k = istart, istop + if (line(k:k) >= 'a' .and. line(k:k) <= 'z') & + line(k:k) = char(ichar(line(k:k)) - idiff) + end do + return + end if ! ! -- Convert word to a number if requested. -100 IF(NCODE.EQ.2 .OR. NCODE.EQ.3) THEN - RW=' ' - L=30-ISTOP+ISTART - IF(L.LT.1) GO TO 200 - RW(L:30)=LINE(ISTART:ISTOP) - IF(NCODE.EQ.2) READ(RW,'(I30)',ERR=200) N - IF(NCODE.EQ.3) READ(RW,'(F30.0)',ERR=200) R - END IF - RETURN +100 if (ncode == 2 .or. ncode == 3) then + rw = ' ' + l = 30 - istop + istart + if (l < 1) go to 200 + rw(l:30) = line(istart:istop) + if (ncode == 2) read (rw, '(i30)', err=200) n + if (ncode == 3) read (rw, '(f30.0)', err=200) r + end if + return ! ! -- Number conversion error. -200 IF(NCODE.EQ.3) THEN - STRING= 'A REAL NUMBER' - L=13 - ELSE - STRING= 'AN INTEGER' - L=10 - END IF +200 if (ncode == 3) then + string = 'a real number' + l = 13 + else + string = 'an integer' + l = 10 + end if ! ! -- If output unit is negative, set last character of string to 'E'. - IF(IOUT.LT.0) THEN - N=0 - R=0. - LINE(LINLEN+1:LINLEN+1)='E' - RETURN - ! - ! -- If output unit is positive; write a message to output unit. - ELSE IF(IOUT.GT.0) THEN - IF(IN.GT.0) THEN - write(msg_line,201) IN,LINE(ISTART:ISTOP),STRING(1:L) - ELSE - WRITE(msg_line,202) LINE(ISTART:ISTOP),STRING(1:L) - END IF - call sim_message(msg_line, iunit=IOUT, skipbefore=1) - call sim_message(LINE, iunit=IOUT, fmt='(1x,a)') -201 FORMAT(1X,'FILE UNIT ',I4,' : ERROR CONVERTING "',A, & - '" TO ',A,' IN LINE:') -202 FORMAT(1X,'KEYBOARD INPUT : ERROR CONVERTING "',A, & - '" TO ',A,' IN LINE:') - ! - ! -- If output unit is 0; write a message to default output. - ELSE - IF(IN.GT.0) THEN - write(msg_line,201) IN,LINE(ISTART:ISTOP),STRING(1:L) - ELSE - WRITE(msg_line,202) LINE(ISTART:ISTOP),STRING(1:L) - END IF - call sim_message(msg_line, iunit=IOUT, skipbefore=1) - call sim_message(LINE, iunit=IOUT, fmt='(1x,a)') - END IF + if (iout < 0) then + n = 0 + r = 0. + line(linlen + 1:linlen + 1) = 'E' + return + ! + ! -- If output unit is positive; write a message to output unit. + else if (iout > 0) then + if (in > 0) then + write (msg_line, fmtmsgout1) in, line(istart:istop), string(1:l) + else + write (msg_line, fmtmsgout2) line(istart:istop), string(1:l) + end if + call write_message(msg_line, iunit=IOUT, skipbefore=1) + call write_message(line, iunit=IOUT, fmt='(1x,a)') + ! + ! -- If output unit is 0; write a message to default output. + else + if (in > 0) then + write (msg_line, fmtmsgout1) in, line(istart:istop), string(1:l) + else + write (msg_line, fmtmsgout2) line(istart:istop), string(1:l) + end if + call write_message(msg_line, iunit=iout, skipbefore=1) + call write_message(LINE, iunit=iout, fmt='(1x,a)') + end if ! ! -- STOP after storing error message. call lowcase(string) if (in > 0) then - write(msg,205) in,line(istart:istop),trim(string) + write (msg, fmtmsgout3) in, line(istart:istop), trim(string) else - write(msg,207) line(istart:istop),trim(string) - endif -205 format('File unit ',I0,': Error converting "',A, & - '" to ',A,' in following line:') -207 format('Keyboard input: Error converting "',A, & - '" to ',A,' in following line:') + write (msg, fmtmsgout4) line(istart:istop), trim(string) + end if + ! call store_error(msg) call store_error(trim(line)) call store_error_unit(in) ! - ! -- return -END SUBROUTINE URWORD - - SUBROUTINE ULSTLB(IOUT,LABEL,CAUX,NCAUX,NAUX) -!C ****************************************************************** -!C PRINT A LABEL FOR A LIST -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - CHARACTER(len=*) LABEL - CHARACTER(len=16) CAUX(NCAUX) - CHARACTER(len=400) BUF - CHARACTER(len=1) DASH(400) - DATA DASH/400*'-'/ -!C ------------------------------------------------------------------ -!C -!C1------Construct the complete label in BUF. Start with BUF=LABEL. - BUF=LABEL -!C -!C2------Add auxiliary data names if there are any. - NBUF=LEN(LABEL)+9 - IF(NAUX.GT.0) THEN - DO 10 I=1,NAUX - N1=NBUF+1 - NBUF=NBUF+16 - BUF(N1:NBUF)=CAUX(I) -10 CONTINUE - END IF -!C -!C3------Write the label. - WRITE(IOUT,103) BUF(1:NBUF) - 103 FORMAT(1X,A) -!C -!C4------Add a line of dashes. - WRITE(IOUT,104) (DASH(J),J=1,NBUF) - 104 FORMAT(1X,400A) -!C -!C5------Return. - RETURN - END SUBROUTINE ULSTLB -! - - SUBROUTINE UBDSV4(KSTP,KPER,TEXT,NAUX,AUXTXT,IBDCHN, & - & NCOL,NROW,NLAY,NLIST,IOUT,DELT,PERTIM,TOTIM) -!C ****************************************************************** -!C WRITE HEADER RECORDS FOR CELL-BY-CELL FLOW TERMS FOR ONE COMPONENT -!C OF FLOW PLUS AUXILIARY DATA USING A LIST STRUCTURE. EACH ITEM IN -!C THE LIST IS WRITTEN BY MODULE UBDSVB -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - CHARACTER(len=16) :: TEXT - character(len=16), dimension(:) :: AUXTXT - real(DP),intent(in) :: delt,pertim,totim - character(len=*), parameter :: fmt = & - "(1X,'UBDSV4 SAVING ',A16,' ON UNIT',I7,' AT TIME STEP',I7,"// & - "', STRESS PERIOD',I7)" -!C ------------------------------------------------------------------ -!C -!C1------WRITE UNFORMATTED RECORDS IDENTIFYING DATA. - IF(IOUT.GT.0) WRITE(IOUT,fmt) TEXT,IBDCHN,KSTP,KPER - WRITE(IBDCHN) KSTP,KPER,TEXT,NCOL,NROW,-NLAY - WRITE(IBDCHN) 5,DELT,PERTIM,TOTIM - WRITE(IBDCHN) NAUX+1 - IF(NAUX.GT.0) WRITE(IBDCHN) (AUXTXT(N),N=1,NAUX) - WRITE(IBDCHN) NLIST -!C -!C2------RETURN - RETURN - END SUBROUTINE UBDSV4 - - SUBROUTINE UBDSVB(IBDCHN,ICRL,Q,VAL,NVL,NAUX,LAUX) -!C ****************************************************************** -!C WRITE ONE VALUE OF CELL-BY-CELL FLOW PLUS AUXILIARY DATA USING -!C A LIST STRUCTURE. -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - real(DP), DIMENSION(nvl) :: VAL - real(DP) :: q -!C ------------------------------------------------------------------ -!C -!C1------WRITE CELL NUMBER AND FLOW RATE - IF(NAUX.GT.0) THEN - N2=LAUX+NAUX-1 - WRITE(IBDCHN) ICRL,Q,(VAL(N),N=LAUX,N2) - ELSE - WRITE(IBDCHN) ICRL,Q - END IF -!C -!C2------RETURN - RETURN - END SUBROUTINE UBDSVB - - SUBROUTINE UCOLNO(NLBL1,NLBL2,NSPACE,NCPL,NDIG,IOUT) -!C ****************************************************************** -!C OUTPUT COLUMN NUMBERS ABOVE A MATRIX PRINTOUT -!C NLBL1 IS THE START COLUMN LABEL (NUMBER) -!C NLBL2 IS THE STOP COLUMN LABEL (NUMBER) -!C NSPACE IS NUMBER OF BLANK SPACES TO LEAVE AT START OF LINE -!C NCPL IS NUMBER OF COLUMN NUMBERS PER LINE -!C NDIG IS NUMBER OF CHARACTERS IN EACH COLUMN FIELD -!C IOUT IS OUTPUT CHANNEL -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - CHARACTER(len=1) DOT,SPACE,DG,BF - DIMENSION BF(1000),DG(10) -!C - DATA DG(1),DG(2),DG(3),DG(4),DG(5),DG(6),DG(7),DG(8),DG(9),DG(10)/ & - & '0','1','2','3','4','5','6','7','8','9'/ - DATA DOT,SPACE/'.',' '/ -!C ------------------------------------------------------------------ -!C -!C1------CALCULATE # OF COLUMNS TO BE PRINTED (NLBL), WIDTH -!C1------OF A LINE (NTOT), NUMBER OF LINES (NWRAP). - if (iout<=0) return - WRITE(IOUT,1) - 1 FORMAT(1X) - NLBL=NLBL2-NLBL1+1 - N=NLBL - IF(NLBL.GT.NCPL) N=NCPL - NTOT=NSPACE+N*NDIG - IF(NTOT.GT.1000) GO TO 50 - NWRAP=(NLBL-1)/NCPL + 1 - J1=NLBL1-NCPL - J2=NLBL1-1 -!C -!C2------BUILD AND PRINT EACH LINE - DO 40 N=1,NWRAP -!C -!C3------CLEAR THE BUFFER (BF). - DO 20 I=1,1000 - BF(I)=SPACE - 20 CONTINUE - NBF=NSPACE -!C -!C4------DETERMINE FIRST (J1) AND LAST (J2) COLUMN # FOR THIS LINE. - J1=J1+NCPL - J2=J2+NCPL - IF(J2.GT.NLBL2) J2=NLBL2 -!C -!C5------LOAD THE COLUMN #'S INTO THE BUFFER. - DO 30 J=J1,J2 - NBF=NBF+NDIG - I2=J/10 - I1=J-I2*10+1 - BF(NBF)=DG(I1) - IF(I2.EQ.0) GO TO 30 - I3=I2/10 - I2=I2-I3*10+1 - BF(NBF-1)=DG(I2) - IF(I3.EQ.0) GO TO 30 - I4=I3/10 - I3=I3-I4*10+1 - BF(NBF-2)=DG(I3) - IF(I4.EQ.0) GO TO 30 - IF(I4.GT.9) THEN -!C5A-----If more than 4 digits, use "X" for 4th digit. - BF(NBF-3)='X' - ELSE - BF(NBF-3)=DG(I4+1) - END IF - 30 CONTINUE -!C -!C6------PRINT THE CONTENTS OF THE BUFFER (I.E. PRINT THE LINE). - WRITE(IOUT,31) (BF(I),I=1,NBF) - 31 FORMAT(1X,1000A1) -!C - 40 CONTINUE -!C -!C7------PRINT A LINE OF DOTS (FOR AESTHETIC PURPOSES ONLY). - 50 NTOT=NTOT - IF(NTOT.GT.1000) NTOT=1000 - WRITE(IOUT,51) (DOT,I=1,NTOT) - 51 FORMAT(1X,1000A1) -!C -!C8------RETURN - RETURN - END SUBROUTINE UCOLNO - - SUBROUTINE ULAPRW(BUF,TEXT,KSTP,KPER,NCOL,NROW,ILAY,IPRN,IOUT) -!C ****************************************************************** -!C PRINT 1 LAYER ARRAY -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - CHARACTER(len=16) TEXT - real(DP),dimension(ncol,nrow) :: buf -!C ------------------------------------------------------------------ -!C - if (iout<=0) return -!C1------PRINT A HEADER DEPENDING ON ILAY - IF(ILAY.GT.0) THEN - WRITE(IOUT,1) TEXT,ILAY,KSTP,KPER - 1 FORMAT('1',/2X,A,' IN LAYER ',I3,' AT END OF TIME STEP ',I3, & - & ' IN STRESS PERIOD ',I4/2X,75('-')) - ELSE IF(ILAY.LT.0) THEN - WRITE(IOUT,2) TEXT,KSTP,KPER - 2 FORMAT('1',/1X,A,' FOR CROSS SECTION AT END OF TIME STEP',I3, & - & ' IN STRESS PERIOD ',I4/1X,79('-')) - END IF -!C -!C2------MAKE SURE THE FORMAT CODE (IP OR IPRN) IS -!C2------BETWEEN 1 AND 21. - IP=IPRN - IF(IP.LT.1 .OR. IP.GT.21) IP=12 -!C -!C3------CALL THE UTILITY MODULE UCOLNO TO PRINT COLUMN NUMBERS. - IF(IP.EQ.1) CALL UCOLNO(1,NCOL,0,11,11,IOUT) - IF(IP.EQ.2) CALL UCOLNO(1,NCOL,0,9,14,IOUT) - IF(IP.GE.3 .AND. IP.LE.6) CALL UCOLNO(1,NCOL,3,15,8,IOUT) - IF(IP.GE.7 .AND. IP.LE.11) CALL UCOLNO(1,NCOL,3,20,6,IOUT) - IF(IP.EQ.12) CALL UCOLNO(1,NCOL,0,10,12,IOUT) - IF(IP.GE.13 .AND. IP.LE.18) CALL UCOLNO(1,NCOL,3,10,7,IOUT) - IF(IP.EQ.19) CALL UCOLNO(1,NCOL,0,5,13,IOUT) - IF(IP.EQ.20) CALL UCOLNO(1,NCOL,0,6,12,IOUT) - IF(IP.EQ.21) CALL UCOLNO(1,NCOL,0,7,10,IOUT) -!C -!C4------LOOP THROUGH THE ROWS PRINTING EACH ONE IN ITS ENTIRETY. - DO I=1,NROW - SELECT CASE(IP) - - CASE(1) -!C------------ FORMAT 11G10.3 - WRITE(IOUT,11) I,(BUF(J,I),J=1,NCOL) -11 FORMAT(1X,I3,2X,1PG10.3,10(1X,G10.3):/(5X,11(1X,G10.3))) - - CASE(2) -!C------------ FORMAT 9G13.6 - WRITE(IOUT,21) I,(BUF(J,I),J=1,NCOL) -21 FORMAT(1X,I3,2X,1PG13.6,8(1X,G13.6):/(5X,9(1X,G13.6))) - - CASE(3) -!C------------ FORMAT 15F7.1 - WRITE(IOUT,31) I,(BUF(J,I),J=1,NCOL) -31 FORMAT(1X,I3,1X,15(1X,F7.1):/(5X,15(1X,F7.1))) - - CASE(4) -!C------------ FORMAT 15F7.2 - WRITE(IOUT,41) I,(BUF(J,I),J=1,NCOL) -41 FORMAT(1X,I3,1X,15(1X,F7.2):/(5X,15(1X,F7.2))) - - CASE(5) -!C------------ FORMAT 15F7.3 - WRITE(IOUT,51) I,(BUF(J,I),J=1,NCOL) -51 FORMAT(1X,I3,1X,15(1X,F7.3):/(5X,15(1X,F7.3))) - - CASE(6) -!C------------ FORMAT 15F7.4 - WRITE(IOUT,61) I,(BUF(J,I),J=1,NCOL) -61 FORMAT(1X,I3,1X,15(1X,F7.4):/(5X,15(1X,F7.4))) - - CASE(7) -!C------------ FORMAT 20F5.0 - WRITE(IOUT,71) I,(BUF(J,I),J=1,NCOL) -71 FORMAT(1X,I3,1X,20(1X,F5.0):/(5X,20(1X,F5.0))) - - CASE(8) -!C------------ FORMAT 20F5.1 - WRITE(IOUT,81) I,(BUF(J,I),J=1,NCOL) -81 FORMAT(1X,I3,1X,20(1X,F5.1):/(5X,20(1X,F5.1))) - - CASE(9) -!C------------ FORMAT 20F5.2 - WRITE(IOUT,91) I,(BUF(J,I),J=1,NCOL) -91 FORMAT(1X,I3,1X,20(1X,F5.2):/(5X,20(1X,F5.2))) - - CASE(10) -!C------------ FORMAT 20F5.3 - WRITE(IOUT,101) I,(BUF(J,I),J=1,NCOL) -101 FORMAT(1X,I3,1X,20(1X,F5.3):/(5X,20(1X,F5.3))) - - CASE(11) -!C------------ FORMAT 20F5.4 - WRITE(IOUT,111) I,(BUF(J,I),J=1,NCOL) -111 FORMAT(1X,I3,1X,20(1X,F5.4):/(5X,20(1X,F5.4))) - - CASE(12) -!C------------ FORMAT 10G11.4 - WRITE(IOUT,121) I,(BUF(J,I),J=1,NCOL) -121 FORMAT(1X,I3,2X,1PG11.4,9(1X,G11.4):/(5X,10(1X,G11.4))) - - CASE(13) -!C------------ FORMAT 10F6.0 - WRITE(IOUT,131) I,(BUF(J,I),J=1,NCOL) -131 FORMAT(1X,I3,1X,10(1X,F6.0):/(5X,10(1X,F6.0))) - - CASE(14) -!C------------ FORMAT 10F6.1 - WRITE(IOUT,141) I,(BUF(J,I),J=1,NCOL) -141 FORMAT(1X,I3,1X,10(1X,F6.1):/(5X,10(1X,F6.1))) - - CASE(15) -!C------------ FORMAT 10F6.2 - WRITE(IOUT,151) I,(BUF(J,I),J=1,NCOL) -151 FORMAT(1X,I3,1X,10(1X,F6.2):/(5X,10(1X,F6.2))) - - CASE(16) -!C------------ FORMAT 10F6.3 - WRITE(IOUT,161) I,(BUF(J,I),J=1,NCOL) -161 FORMAT(1X,I3,1X,10(1X,F6.3):/(5X,10(1X,F6.3))) - - CASE(17) -!C------------ FORMAT 10F6.4 - WRITE(IOUT,171) I,(BUF(J,I),J=1,NCOL) -171 FORMAT(1X,I3,1X,10(1X,F6.4):/(5X,10(1X,F6.4))) - - CASE(18) -!C------------ FORMAT 10F6.5 - WRITE(IOUT,181) I,(BUF(J,I),J=1,NCOL) -181 FORMAT(1X,I3,1X,10(1X,F6.5):/(5X,10(1X,F6.5))) + ! -- Return + return + end subroutine URWORD - CASE(19) -!C------------FORMAT 5G12.5 - WRITE(IOUT,191) I,(BUF(J,I),J=1,NCOL) -191 FORMAT(1X,I3,2X,1PG12.5,4(1X,G12.5):/(5X,5(1X,G12.5))) + !> @brief Print a label for a list + !< + subroutine ULSTLB(iout, label, caux, ncaux, naux) + ! -- dummy + character(len=*) :: label + character(len=16) :: caux(ncaux) + ! -- local + character(len=400) buf + ! -- constant + character(len=1) DASH(400) + data DASH/400*'-'/ + ! -- formats + character(len=*), parameter :: fmtmsgout1 = "(1x, a)" + character(len=*), parameter :: fmtmsgout2 = "(1x, 400a)" + ! + ! -- Construct the complete label in BUF. Start with BUF=LABEL. + buf = label + ! + ! -- Add auxiliary data names if there are any. + nbuf = len(label) + 9 + if (naux > 0) then + do i = 1, naux + n1 = nbuf + 1 + nbuf = nbuf + 16 + buf(n1:nbuf) = caux(i) + end do + end if + ! + ! -- Write the label. + write (iout, fmtmsgout1) buf(1:nbuf) + ! + ! -- Add a line of dashes. + write (iout, fmtmsgout2) (DASH(j), j=1, nbuf) + ! + ! -- Return + return + end subroutine ULSTLB - CASE(20) -!C------------FORMAT 6G11.4 - WRITE(IOUT,201) I,(BUF(J,I),J=1,NCOL) -201 FORMAT(1X,I3,2X,1PG11.4,5(1X,G11.4):/(5X,6(1X,G11.4))) + !> @brief Write header records for cell-by-cell flow terms for one component + !! of flow plus auxiliary data using a list structure + !! + !! Each item in the list is written by module UBDSVB + !< + subroutine UBDSV4(kstp, kper, text, naux, auxtxt, ibdchn, & + & ncol, nrow, nlay, nlist, iout, delt, pertim, totim) + ! -- dummy + character(len=16) :: text + character(len=16), dimension(:) :: auxtxt + real(DP), intent(in) :: delt, pertim, totim + ! -- formats + character(len=*), parameter :: fmt = & + & "(1X,'UBDSV4 SAVING ',A16,' ON UNIT',I7,' AT TIME STEP',I7,"// & + & "', STRESS PERIOD',I7)" + ! + ! -- Write unformatted records identifying data + if (iout > 0) write (iout, fmt) text, ibdchn, kstp, kper + write (ibdchn) kstp, kper, text, ncol, nrow, -nlay + write (ibdchn) 5, delt, pertim, totim + write (ibdchn) naux + 1 + if (naux > 0) write (ibdchn) (auxtxt(n), n=1, naux) + write (ibdchn) nlist + ! + ! -- Return + return + end subroutine UBDSV4 - CASE(21) -!C------------FORMAT 7G9.2 - WRITE(IOUT,211) I,(BUF(J,I),J=1,NCOL) -211 FORMAT(1X,I3,2X,1PG9.2,6(1X,G9.2):/(5X,7(1X,G9.2))) + !> @brief Write one value of cell-by-cell flow plus auxiliary data using a + !! list structure + !< + subroutine UBDSVB(ibdchn, icrl, q, val, nvl, naux, laux) + ! -- dummy + real(DP), dimension(nvl) :: val + real(DP) :: q + ! + ! -- Write cell number and flow rate + IF (naux > 0) then + n2 = laux + naux - 1 + write (ibdchn) icrl, q, (val(n), n=laux, n2) + else + write (ibdchn) icrl, q + end if + ! + ! -- Return + return + end subroutine UBDSVB - END SELECT - END DO + !> @brief Output column numbers above a matrix printout + !! + !! nlbl1 is the start column label (number) + !! nlbl2 is the stop column label (number) + !! nspace is number of blank spaces to leave at start of line + !! ncpl is number of column numbers per line + !! ndig is number of characters in each column field + !! iout is output channel + !< + subroutine UCOLNO(nlbl1, nlbl2, nspace, ncpl, ndig, iout) + ! -- local + character(len=1) :: DOT, SPACE, DG, BF + dimension :: BF(1000), DG(10) + ! -- constants + data DG(1), DG(2), DG(3), DG(4), DG(5), DG(6), DG(7), DG(8), DG(9), DG(10)/ & + & '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'/ + data DOT, SPACE/'.', ' '/ + ! -- formats + character(len=*), parameter :: fmtmsgout1 = "(1x)" + character(len=*), parameter :: fmtmsgout2 = "(1x, 1000a1)" + ! + ! -- Calculate # of columns to be printed (nlbl), width + ! of a line (ntot), number of lines (nwrap). + if (iout <= 0) return + write (iout, fmtmsgout1) + ! + nlbl = nlbl2 - nlbl1 + 1 + n = nlbl + ! + if (nlbl < ncpl) n = ncpl + ntot = nspace + n * ndig + ! + if (ntot > 1000) go to 50 + nwrap = (nlbl - 1) / ncpl + 1 + j1 = nlbl1 - ncpl + j2 = nlbl1 - 1 + ! + ! -- Build and print each line + do n = 1, nwrap ! - ! -- flush file - flush(IOUT) + ! -- Clear the buffer (BF) + do i = 1, 1000 + BF(i) = SPACE + end do + nbf = nspace ! - ! -- return - RETURN - END SUBROUTINE ULAPRW - - SUBROUTINE ULASAV(BUF,TEXT,KSTP,KPER,PERTIM,TOTIM,NCOL, & - & NROW,ILAY,ICHN) -!C ****************************************************************** -!C SAVE 1 LAYER ARRAY ON DISK -!C ****************************************************************** -!C -!C SPECIFICATIONS: -!C ------------------------------------------------------------------ - CHARACTER(len=16) TEXT - real(DP),dimension(ncol,nrow) :: buf - real(DP) :: pertim,totim -!C ------------------------------------------------------------------ -!C -!C1------WRITE AN UNFORMATTED RECORD CONTAINING IDENTIFYING -!C1------INFORMATION. - WRITE(ICHN) KSTP,KPER,PERTIM,TOTIM,TEXT,NCOL,NROW,ILAY -!C -!C2------WRITE AN UNFORMATTED RECORD CONTAINING ARRAY VALUES -!C2------THE ARRAY IS DIMENSIONED (NCOL,NROW) - WRITE(ICHN) ((BUF(IC,IR),IC=1,NCOL),IR=1,NROW) + ! -- Determine first (j1) and last (j2) column # for this line. + j1 = j1 + ncpl + j2 = j2 + ncpl + if (j2 > nlbl2) j2 = nlbl2 + ! + ! -- Load the column #'s into the buffer. + do j = j1, j2 + nbf = nbf + ndig + i2 = j / 10 + i1 = j - i2 * 10 + 1 + BF(nbf) = DG(i1) + if (i2 == 0) go to 30 + i3 = i2 / 10 + i2 = i2 - i3 * 10 + 1 + BF(nbf - 1) = DG(i2) + if (i3 == 0) go to 30 + i4 = i3 / 10 + i3 = i3 - i4 * 10 + 1 + BF(nbf - 2) = DG(i3) + if (I4 == 0) go to 30 + if (I4 > 9) then + ! -- If more than 4 digits, use "X" for 4th digit. + BF(nbf - 3) = 'X' + else + BF(nbf - 3) = DG(i4 + 1) + end if +30 end do + ! + ! -- Print the contents of the buffer (i.e. print the line). + write (iout, fmtmsgout2) (BF(i), i=1, nbf) ! - ! -- flush file - flush(ICHN) -!C -!C3------RETURN - RETURN - END SUBROUTINE ULASAV + end do + ! + ! -- Print a line of dots (for aesthetic purposes only). +50 ntot = ntot + if (ntot > 1000) ntot = 1000 + write (iout, fmtmsgout2) (DOT, i=1, ntot) + ! + ! -- Return + return + end subroutine UCOLNO + !> @brief Print 1 layer array + !< + subroutine ULAPRW(buf, text, kstp, kper, ncol, nrow, ilay, iprn, iout) + ! -- dummy + character(len=16) :: text + real(DP), dimension(ncol, nrow) :: buf + ! -- formats + character(len=*), parameter :: fmtmsgout1 = & + & "('1', /2x, a, ' IN LAYER ',I3,' AT END OF TIME STEP ',I3, & + & ' IN STRESS PERIOD ',I4/2x,75('-'))" + character(len=*), parameter :: fmtmsgout2 = & + & "('1',/1x,A,' FOR CROSS SECTION AT END OF TIME STEP',I3, & + & ' IN STRESS PERIOD ',I4/1x,79('-'))" + character(len=*), parameter :: fmtg10 = & + & "(1X,I3,2X,1PG10.3,10(1X,G10.3):/(5X,11(1X,G10.3)))" + character(len=*), parameter :: fmtg13 = & + & "(1x,I3,2x,1PG13.6,8(1x,G13.6):/(5x,9(1x,G13.6)))" + character(len=*), parameter :: fmtf7pt1 = & + & "(1x,I3,1x,15(1x,F7.1):/(5x,15(1x,F7.1)))" + character(len=*), parameter :: fmtf7pt2 = & + & "(1x,I3,1x,15(1x,F7.2):/(5x,15(1x,F7.2)))" + character(len=*), parameter :: fmtf7pt3 = & + & "(1x,I3,1x,15(1x,F7.3):/(5x,15(1x,F7.3)))" + character(len=*), parameter :: fmtf7pt4 = & + & "(1x,I3,1x,15(1x,F7.4):/(5x,15(1x,F7.4)))" + character(len=*), parameter :: fmtf5pt0 = & + & "(1x,I3,1x,20(1x,F5.0):/(5x,20(1x,F5.0)))" + character(len=*), parameter :: fmtf5pt1 = & + & "(1x,I3,1x,20(1x,F5.1):/(5x,20(1x,F5.1)))" + character(len=*), parameter :: fmtf5pt2 = & + & "(1x,I3,1x,20(1x,F5.2):/(5x,20(1x,F5.2)))" + character(len=*), parameter :: fmtf5pt3 = & + & "(1x,I3,1x,20(1x,F5.3):/(5x,20(1x,F5.3)))" + character(len=*), parameter :: fmtf5pt4 = & + & "(1x,I3,1x,20(1x,F5.4):/(5x,20(1x,F5.4)))" + character(len=*), parameter :: fmtg11 = & + & "(1x,I3,2x,1PG11.4,9(1x,G11.4):/(5x,10(1x,G11.4)))" + character(len=*), parameter :: fmtf6pt0 = & + & "(1x,I3,1x,10(1x,F6.0):/(5X,10(1x,F6.0)))" + character(len=*), parameter :: fmtf6pt1 = & + & "(1x,I3,1x,10(1x,F6.1):/(5x,10(1x,F6.1)))" + character(len=*), parameter :: fmtf6pt2 = & + & "(1x,I3,1x,10(1x,F6.2):/(5x,10(1x,F6.2)))" + character(len=*), parameter :: fmtf6pt3 = & + & "(1x,I3,1x,10(1x,F6.3):/(5x,10(1x,F6.3)))" + character(len=*), parameter :: fmtf6pt4 = & + & "(1x,I3,1x,10(1x,F6.4):/(5x,10(1x,F6.4)))" + character(len=*), parameter :: fmtf6pt5 = & + & "(1x,I3,1x,10(1x,F6.5):/(5x,10(1x,F6.5)))" + character(len=*), parameter :: fmtg12 = & + & "(1x,I3,2x,1PG12.5,4(1x,G12.5):/(5x,5(1x,G12.5)))" + character(len=*), parameter :: fmtg11pt4 = & + & "(1x,I3,2x,1PG11.4,5(1x,G11.4):/(5x,6(1x,G11.4)))" + character(len=*), parameter :: fmtg9pt2 = & + & "(1x,I3,2x,1PG9.2,6(1x,G9.2):/(5x,7(1x,G9.2)))" + ! + if (iout <= 0) return + ! -- Print a header depending on ilay + if (ilay > 0) then + write (iout, fmtmsgout1) text, ilay, kstp, kper + else if (ilay < 0) then + write (iout, fmtmsgout2) text, kstp, kper + end if + ! + ! -- Make sure the format code (ip or iprn) is between 1 and 21 + ip = iprn + if (ip < 1 .or. ip > 21) ip = 12 + ! + ! -- Call the utility module ucolno to print column numbers. + if (ip == 1) call ucolno(1, ncol, 0, 11, 11, iout) + if (ip == 2) call ucolno(1, ncol, 0, 9, 14, iout) + if (ip >= 3 .and. ip <= 6) call ucolno(1, ncol, 3, 15, 8, iout) + if (ip >= 7 .and. ip <= 11) call ucolno(1, ncol, 3, 20, 6, iout) + if (ip == 12) call ucolno(1, ncol, 0, 10, 12, iout) + if (ip >= 13 .and. ip <= 18) call ucolno(1, ncol, 3, 10, 7, iout) + if (ip == 19) call ucolno(1, ncol, 0, 5, 13, iout) + if (ip == 20) call ucolno(1, ncol, 0, 6, 12, iout) + if (ip == 21) call ucolno(1, ncol, 0, 7, 10, iout) + ! + ! -- Loop through the rows printing each one in its entirety. + do i = 1, nrow + select case (ip) + ! + case (1) + ! -- format 11G10.3 + write (iout, fmtg10) i, (buf(j, i), j=1, ncol) + ! + case (2) + ! -- format 9G13.6 + write (iout, fmtg13) i, (buf(j, i), j=1, ncol) + ! + case (3) + ! -- format 15F7.1 + write (iout, fmtf7pt1) i, (buf(j, i), j=1, ncol) + ! + case (4) + ! -- format 15F7.2 + write (iout, fmtf7pt2) i, (buf(j, i), j=1, ncol) + ! + case (5) + ! -- format 15F7.3 + write (iout, fmtf7pt3) i, (buf(j, i), j=1, ncol) + ! + case (6) + ! -- format 15F7.4 + write (iout, fmtf7pt4) i, (buf(j, i), j=1, ncol) + ! + case (7) + ! -- format 20F5.0 + write (iout, fmtf5pt0) i, (buf(j, i), j=1, ncol) + ! + case (8) + ! -- format 20F5.1 + write (iout, fmtf5pt1) i, (buf(j, i), j=1, ncol) + ! + case (9) + ! -- format 20F5.2 + write (iout, fmtf5pt2) i, (buf(j, i), j=1, ncol) + ! + case (10) + ! -- format 20F5.3 + write (iout, fmtf5pt3) i, (buf(j, i), j=1, ncol) + ! + case (11) + ! -- format 20F5.4 + write (iout, fmtf5pt4) i, (buf(j, i), j=1, ncol) + ! + case (12) + ! -- format 10G11.4 + write (iout, fmtg11) i, (buf(j, i), j=1, ncol) + ! + case (13) + ! -- format 10F6.0 + write (iout, fmtf6pt0) i, (buf(j, i), j=1, ncol) + ! + case (14) + ! -- format 10F6.1 + write (iout, fmtf6pt1) i, (buf(j, i), j=1, ncol) + ! + case (15) + ! -- format 10F6.2 + write (iout, fmtf6pt2) i, (buf(j, i), j=1, ncol) + ! + case (16) + ! -- format 10F6.3 + write (iout, fmtf6pt3) i, (buf(j, i), j=1, ncol) + ! + case (17) + ! -- format 10F6.4 + write (iout, fmtf6pt4) i, (buf(j, i), j=1, ncol) + ! + case (18) + ! -- format 10F6.5 + write (iout, fmtf6pt5) i, (buf(j, i), j=1, ncol) + ! + case (19) + ! -- format 5G12.5 + write (iout, fmtg12) i, (buf(j, i), j=1, ncol) + ! + case (20) + ! -- format 6G11.4 + write (iout, fmtg11pt4) i, (buf(j, i), j=1, ncol) + ! + case (21) + ! -- format 7G9.2 + write (iout, fmtg9pt2) i, (buf(j, i), j=1, ncol) + ! + end select + end do + ! + ! -- Flush file + flush (iout) + ! + ! -- Return + return + end subroutine ULAPRW + + !> @brief Save 1 layer array on disk + !< + subroutine ulasav(buf, text, kstp, kper, pertim, totim, ncol, nrow, & + ilay, ichn) + ! -- dummy + character(len=16) :: text + real(DP), dimension(ncol, nrow) :: buf + real(DP) :: pertim, totim + ! + ! -- Write an unformatted record containing identifying information + write (ichn) kstp, kper, pertim, totim, text, ncol, nrow, ilay + ! + ! -- Write an unformatted record containing array values. The array is + ! dimensioned (ncol,nrow) + write (ichn) ((buf(ic, ir), ic=1, ncol), ir=1, nrow) + ! + ! -- flush file + flush (ICHN) + ! + ! -- Return + return + end subroutine ulasav + + !> @brief Record cell-by-cell flow terms for one component of flow as a 3-D + !! array with extra record to indicate delt, pertim, and totim + !< subroutine ubdsv1(kstp, kper, text, ibdchn, buff, ncol, nrow, nlay, iout, & delt, pertim, totim) -! ****************************************************************************** -! Record cell-by-cell flow terms for one component of flow as a 3-D array with -! extra record to indicate delt, pertim, and totim -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! -- dummy integer(I4B), intent(in) :: kstp integer(I4B), intent(in) :: kper character(len=*), intent(in) :: text @@ -1189,35 +979,32 @@ subroutine ubdsv1(kstp, kper, text, ibdchn, buff, ncol, nrow, nlay, iout, & real(DP), intent(in) :: totim ! -- format character(len=*), parameter :: fmt = & - "(1X,'UBDSV1 SAVING ',A16,' ON UNIT',I7,' AT TIME STEP',I7,"// & - "', STRESS PERIOD',I7)" -! ------------------------------------------------------------------------------ + & "(1X,'UBDSV1 SAVING ',A16,' ON UNIT',I7,' AT TIME STEP',I7,"// & + & "', STRESS PERIOD',I7)" ! ! -- Write records - if(iout > 0) write(iout, fmt) text, ibdchn, kstp, kper - write(ibdchn) kstp,kper,text,ncol,nrow,-nlay - write(ibdchn) 1,delt,pertim,totim - write(ibdchn) buff + if (iout > 0) write (iout, fmt) text, ibdchn, kstp, kper + write (ibdchn) kstp, kper, text, ncol, nrow, -nlay + write (ibdchn) 1, delt, pertim, totim + write (ibdchn) buff ! ! -- flush file - flush(ibdchn) + flush (ibdchn) ! - ! -- return + ! -- Return return end subroutine ubdsv1 - subroutine ubdsv06(kstp,kper,text, & - modelnam1,paknam1,modelnam2,paknam2, & - ibdchn,naux,auxtxt, & - ncol,nrow,nlay,nlist,iout,delt,pertim,totim) -! ****************************************************************** -! write header records for cell-by-cell flow terms for one component -! of flow. each item in the list is written by module ubdsvc -! ****************************************************************** -! -! specifications: -! ------------------------------------------------------------------ + !> @brief Write header records for cell-by-cell flow terms for one component + !! of flow. + !! + !! Each item in the list is written by module ubdsvc + !< + subroutine ubdsv06(kstp, kper, text, modelnam1, paknam1, modelnam2, paknam2, & + ibdchn, naux, auxtxt, ncol, nrow, nlay, nlist, iout, & + delt, pertim, totim) implicit none + ! -- dummy integer(I4B), intent(in) :: kstp integer(I4B), intent(in) :: kper character(len=*), intent(in) :: text @@ -1236,243 +1023,174 @@ subroutine ubdsv06(kstp,kper,text, & real(DP), intent(in) :: delt real(DP), intent(in) :: pertim real(DP), intent(in) :: totim - ! -- local variables + ! -- local integer(I4B) :: n ! -- format character(len=*), parameter :: fmt = & - "(1X,'UBDSV06 SAVING ',A16,' IN MODEL ',A16,' PACKAGE ',A16,"//& - "'CONNECTED TO MODEL ',A16,' PACKAGE ',A16,"// & - "' ON UNIT',I7,' AT TIME STEP',I7,', STRESS PERIOD',I7)" -! ------------------------------------------------------------------ -! -! write unformatted records identifying data. - if (iout > 0) write(iout,fmt) text, modelnam1, paknam1, & - modelnam2, paknam2, & - ibdchn, kstp, kper - write(ibdchn) kstp,kper,text,ncol,nrow,-nlay - write(ibdchn) 6,delt,pertim,totim - write(ibdchn) modelnam1 - write(ibdchn) paknam1 - write(ibdchn) modelnam2 - write(ibdchn) paknam2 - write(ibdchn) naux+1 - if (naux > 0) write(ibdchn) (auxtxt(n),n=1,naux) - write(ibdchn) nlist + & "(1X,'UBDSV06 SAVING ',A16,' IN MODEL ',A16,' PACKAGE ',A16,"// & + & "'CONNECTED TO MODEL ',A16,' PACKAGE ',A16,"// & + & "' ON UNIT',I7,' AT TIME STEP',I7,', STRESS PERIOD',I7)" + ! + ! -- Write unformatted records identifying data. + if (iout > 0) write (iout, fmt) text, modelnam1, paknam1, modelnam2, & + paknam2, ibdchn, kstp, kper + write (ibdchn) kstp, kper, text, ncol, nrow, -nlay + write (ibdchn) 6, delt, pertim, totim + write (ibdchn) modelnam1 + write (ibdchn) paknam1 + write (ibdchn) modelnam2 + write (ibdchn) paknam2 + write (ibdchn) naux + 1 + if (naux > 0) write (ibdchn) (auxtxt(n), n=1, naux) + write (ibdchn) nlist ! - ! -- return + ! -- Return return end subroutine ubdsv06 + !> @brief Write one value of cell-by-cell flow using a list structure. + !! + !! From node (n) and to node (n2) are written to the file + !< subroutine ubdsvc(ibdchn, n, q, naux, aux) -! ****************************************************************************** -! Write one value of cell-by-cell flow using a list structure. From node (n) -! and to node (n2) are written to the file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! -- dummy integer(I4B), intent(in) :: ibdchn integer(I4B), intent(in) :: n real(DP), intent(in) :: q integer(I4B), intent(in) :: naux real(DP), dimension(naux), intent(in) :: aux - ! -- local variables + ! -- local integer(I4B) :: nn -! ------------------------------------------------------------------------------ ! ! -- Write record if (naux > 0) then - write(ibdchn) n,q,(aux(nn),nn=1,naux) + write (ibdchn) n, q, (aux(nn), nn=1, naux) else - write(ibdchn) n,q + write (ibdchn) n, q end if ! - ! -- return + ! -- Return return end subroutine ubdsvc + !> @brief Write one value of cell-by-cell flow using a list structure. + !! + !! From node (n) and to node (n2) are written to the file + !< subroutine ubdsvd(ibdchn, n, n2, q, naux, aux) -! ****************************************************************************** -! Write one value of cell-by-cell flow using a list structure. From node (n) -! and to node (n2) are written to the file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ implicit none + ! -- dummy integer(I4B), intent(in) :: ibdchn integer(I4B), intent(in) :: n integer(I4B), intent(in) :: n2 real(DP), intent(in) :: q integer(I4B), intent(in) :: naux real(DP), dimension(naux), intent(in) :: aux - ! -- local variables + ! -- local integer(I4B) :: nn -! ------------------------------------------------------------------------------ ! ! -- Write record if (naux > 0) then - write(ibdchn) n,n2,q,(aux(nn),nn=1,naux) + write (ibdchn) n, n2, q, (aux(nn), nn=1, naux) else - write(ibdchn) n,n2,q + write (ibdchn) n, n2, q end if ! - ! -- return + ! -- Return return end subroutine ubdsvd + !> @brief Perform a case-insensitive comparison of two words + !< logical function same_word(word1, word2) - ! Perform a case-insensitive comparison of two words implicit none - ! -- dummy variables variables + ! -- dummy character(len=*), intent(in) :: word1, word2 - ! -- local variables + ! -- local character(len=200) :: upword1, upword2 ! upword1 = word1 call upcase(upword1) upword2 = word2 call upcase(upword2) - same_word = (upword1==upword2) + same_word = (upword1 == upword2) + ! + ! -- Return return end function same_word - function get_node(ilay, irow, icol, nlay, nrow, ncol) - ! Return node number, given layer, row, and column indices - ! for a structured grid. If any argument is invalid, - ! return -1. - implicit none - ! -- return - integer(I4B) :: get_node - ! -- dummy variables - integer(I4B), intent(in) :: ilay, irow, icol, nlay, nrow, ncol - ! - if (nlay>0 .and. nrow>0 .and. ncol>0) then - if (ilay>0 .and. ilay<=nlay) then - if (irow>0 .and. irow<=nrow) then - if (icol>0 .and. icol<=ncol) then - get_node = icol + ncol*(irow-1) + (ilay-1)*nrow*ncol - return - endif - endif - endif - endif - get_node = -1 - return - end function get_node - - subroutine get_ijk(nodenumber, nrow, ncol, nlay, irow, icol, ilay) - ! Calculate irow, icol, and ilay from the nodenumber and grid - ! dimensions. If nodenumber is invalid, set irow, icol, and - ! ilay to -1 - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: nodenumber - integer(I4B), intent(in) :: nrow - integer(I4B), intent(in) :: ncol - integer(I4B), intent(in) :: nlay - integer(I4B), intent(out) :: irow - integer(I4B), intent(out) :: icol - integer(I4B), intent(out) :: ilay - ! -- local variables - integer(I4B) :: nodes - integer(I4B) :: ij - ! - nodes = nlay * nrow * ncol - if(nodenumber < 1 .or. nodenumber > nodes) then - irow = -1 - icol = -1 - ilay = -1 - else - ilay = (nodenumber - 1) / (ncol * nrow) + 1 - ij = nodenumber - (ilay - 1) * ncol * nrow - irow = (ij - 1) / ncol + 1 - icol = ij - (irow - 1) * ncol - endif + !> @brief Function for string manipulation + !< + function str_pad_left(str, width) result(res) + ! -- local + character(len=*), intent(in) :: str + integer, intent(in) :: width + ! -- Return + character(len=max(len_trim(str), width)) :: res ! - return - end subroutine get_ijk - - subroutine get_jk(nodenumber, ncpl, nlay, icpl, ilay) - ! Calculate icpl, and ilay from the nodenumber and grid - ! dimensions. If nodenumber is invalid, set irow, icol, and - ! ilay to -1 - implicit none - ! -- dummy variables - integer(I4B), intent(in) :: nodenumber - integer(I4B), intent(in) :: ncpl - integer(I4B), intent(in) :: nlay - integer(I4B), intent(out) :: icpl - integer(I4B), intent(out) :: ilay - ! -- local variables - integer(I4B) :: nodes - ! - nodes = ncpl * nlay - if(nodenumber < 1 .or. nodenumber > nodes) then - icpl = -1 - ilay = -1 - else - ilay = (nodenumber - 1) / ncpl + 1 - icpl = nodenumber - (ilay - 1) * ncpl - endif + res = str + res = adjustr(res) ! + ! -- Return return - end subroutine get_jk + end function subroutine unitinquire(iu) - ! -- dummy variables + ! -- dummy integer(I4B) :: iu - ! -- local variables + ! -- local character(len=LINELENGTH) :: line character(len=100) :: fname, ac, act, fm, frm, seq, unf ! -- format - character(len=*), parameter :: fmta = & - &"('unit:',i4,' name:',a,' access:',a,' action:',a)" - character(len=*), parameter :: fmtb = & - &"(' formatted:',a,' sequential:',a,' unformatted:',a,' form:',a)" - ! -- code + character(len=*), parameter :: fmta = & + &"('unit:',i4,' name:',a,' access:',a,' action:',a)" + character(len=*), parameter :: fmtb = & + &"(' formatted:',a,' sequential:',a,' unformatted:',a,' form:',a)" ! ! -- set strings using inquire statement - inquire(unit=iu, name=fname, access=ac, action=act, formatted=fm, & - sequential=seq, unformatted=unf, form=frm) + inquire (unit=iu, name=fname, access=ac, action=act, formatted=fm, & + sequential=seq, unformatted=unf, form=frm) ! ! -- write the results of the inquire statement - write(line,fmta) iu, trim(fname), trim(ac), trim(act) - call sim_message(line) - write(line,fmtb) trim(fm), trim(seq), trim(unf), trim(frm) - call sim_message(line) + write (line, fmta) iu, trim(fname), trim(ac), trim(act) + call write_message(line) + write (line, fmtb) trim(fm), trim(seq), trim(unf), trim(frm) + call write_message(line) ! - ! -- return + ! -- Return return end subroutine unitinquire + !> @brief Parse a line into words. + !! + !! Blanks and commas are recognized as delimiters. Multiple blanks between + !! words is OK, but multiple commas between words is treated as an error. + !! Quotation marks are not recognized as delimiters. + !< subroutine ParseLine(line, nwords, words, inunit, filename) - ! Parse a line into words. Blanks and commas are recognized as - ! delimiters. Multiple blanks between words is OK, but multiple - ! commas between words is treated as an error. Quotation marks - ! are not recognized as delimiters. + ! -- modules use ConstantsModule, only: LINELENGTH implicit none - ! -- dummy variables + ! -- dummy character(len=*), intent(in) :: line integer(I4B), intent(inout) :: nwords character(len=*), allocatable, dimension(:), intent(inout) :: words integer(I4B), intent(in), optional :: inunit character(len=*), intent(in), optional :: filename - ! -- local variables + ! -- local integer(I4B) :: i, idum, istart, istop, linelen, lloc real(DP) :: rdum ! nwords = 0 if (allocated(words)) then - deallocate(words) - endif + deallocate (words) + end if linelen = len(line) ! ! -- get the number of words in a line and allocate words array nwords = get_nwords(line) - allocate(words(nwords)) + allocate (words(nwords)) ! ! -- Populate words array and return lloc = 1 @@ -1481,133 +1199,137 @@ subroutine ParseLine(line, nwords, words, inunit, filename) words(i) = line(istart:istop) end do ! - ! -- return + ! -- Return return end subroutine ParseLine + !> @brief Print 1 layer array with user formatting in wrap format + !< subroutine ulaprufw(ncol, nrow, kstp, kper, ilay, iout, buf, text, userfmt, & nvalues, nwidth, editdesc) - ! ************************************************************************** - ! Print 1 layer array with user formatting in wrap format - ! ************************************************************************** - ! - ! Specifications: - ! -------------------------------------------------------------------------- implicit none - ! -- dummy variables + ! -- dummy integer(I4B), intent(in) :: ncol, nrow, kstp, kper, ilay, iout - real(DP),dimension(ncol,nrow), intent(in) :: buf + real(DP), dimension(ncol, nrow), intent(in) :: buf character(len=*), intent(in) :: text character(len=*), intent(in) :: userfmt integer(I4B), intent(in) :: nvalues, nwidth character(len=1), intent(in) :: editdesc - ! -- local variables + ! -- local integer(I4B) :: i, j, nspaces - ! formats - 1 format('1',/2X,A,' IN LAYER ',I3,' AT END OF TIME STEP ',I3, & - ' IN STRESS PERIOD ',I4/2X,75('-')) - 2 format('1',/1X,A,' FOR CROSS SECTION AT END OF TIME STEP',I3, & - ' IN STRESS PERIOD ',I4/1X,79('-')) - ! ------------------------------------------------------------------ - ! - if (iout<=0) return + ! -- formats + character(len=*), parameter :: fmtmsgout1 = & + "('1',/2X,A,' IN LAYER ',I3,' AT END OF TIME STEP ',I3, & +& ' IN STRESS PERIOD ',I4/2X,75('-'))" + character(len=*), parameter :: fmtmsgout2 = & + "('1',/1X,A,' FOR CROSS SECTION AT END OF TIME STEP',I3, & +& ' IN STRESS PERIOD ',I4/1X,79('-'))" + ! + if (iout <= 0) return ! -- Print a header depending on ILAY if (ilay > 0) then - write(iout,1) trim(text), ilay, kstp, kper - else if(ilay < 0) then - write(iout,2) trim(text), kstp, kper + write (iout, fmtmsgout1) trim(text), ilay, kstp, kper + else if (ilay < 0) then + write (iout, fmtmsgout2) trim(text), kstp, kper end if ! ! -- Print column numbers. nspaces = 0 if (editdesc == 'F') nspaces = 3 - call ucolno(1, ncol, nspaces, nvalues, nwidth+1, iout) + call ucolno(1, ncol, nspaces, nvalues, nwidth + 1, iout) ! ! -- Loop through the rows, printing each one in its entirety. - do i=1,nrow - write(iout,userfmt) i,(buf(j,i),j=1,ncol) + do i = 1, nrow + write (iout, userfmt) i, (buf(j, i), j=1, ncol) end do ! ! -- flush file - flush(IOUT) + flush (IOUT) ! - ! -- return + ! -- Return return end subroutine ulaprufw - function read_line(iu, eof) result (astring) - ! This function reads a line of arbitrary length and returns - ! it. The returned string can be stored in a deferred-length - ! character variable, for example: - ! - ! integer(I4B) :: iu - ! character(len=:), allocatable :: my_string - ! logical :: eof - ! iu = 8 - ! open(iu,file='my_file') - ! my_string = read_line(iu, eof) + !> @brief This function reads a line of arbitrary length and returns it. + !! + !! The returned string can be stored in a deferred-length character variable, + !! for example: + !! + !! integer(I4B) :: iu + !! character(len=:), allocatable :: my_string + !! logical :: eof + !! iu = 8 + !! open(iu,file='my_file') + !! my_string = read_line(iu, eof) + !< + function read_line(iu, eof) result(astring) ! implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iu - logical, intent(out) :: eof + ! -- dummy + integer(I4B), intent(in) :: iu + logical, intent(out) :: eof character(len=:), allocatable :: astring - ! -- local variables - integer(I4B) :: isize, istat - character(len=256) :: buffer + ! -- local + integer(I4B) :: isize, istat + character(len=256) :: buffer character(len=1000) :: ermsg, fname - character(len=7) :: fmtd - logical :: lop - ! -- format -20 format('Error in read_line: File ',i0,' is not open.') -30 format('Error in read_line: Attempting to read text ' // & - 'from unformatted file: "',a,'"') -40 format('Error reading from file "',a,'" opened on unit ',i0, & - ' in read_line.') + character(len=7) :: fmtd + logical :: lop + ! -- formats + character(len=*), parameter :: fmterrmsg1 = & + & "('Error in read_line: File ',i0,' is not open.')" + character(len=*), parameter :: fmterrmsg2 = & + & "('Error in read_line: Attempting to read text ' // & + & 'from unformatted file: ""',a,'""')" + character(len=*), parameter :: fmterrmsg3 = & + & "('Error reading from file ""',a,'"" opened on unit ',i0, & + & ' in read_line.')" ! astring = '' eof = .false. do - read(iu, '(a)', advance='NO', iostat=istat, size=isize, end=99) buffer + read (iu, '(a)', advance='NO', iostat=istat, size=isize, end=99) buffer if (istat > 0) then ! Determine error if possible, report it, and stop. if (iu <= 0) then - ermsg = 'Programming error in call to read_line: ' // & + ermsg = 'Programming error in call to read_line: '// & 'Attempt to read from unit number <= 0' else - inquire(unit=iu,opened=lop,name=fname,formatted=fmtd) + inquire (unit=iu, opened=lop, name=fname, formatted=fmtd) if (.not. lop) then - write(ermsg,20) iu + write (ermsg, fmterrmsg1) iu elseif (fmtd == 'NO' .or. fmtd == 'UNKNOWN') then - write(ermsg, 30) trim(fname) + write (ermsg, fmterrmsg2) trim(fname) else - write(ermsg,40) trim(fname), iu - endif - endif + write (ermsg, fmterrmsg3) trim(fname), iu + end if + end if call store_error(ermsg) call store_error_unit(iu) - endif - astring = astring // buffer(:isize) - ! An end-of-record condition stops the loop. + end if + astring = astring//buffer(:isize) + ! -- An end-of-record condition stops the loop. if (istat < 0) then return - endif - enddo + end if + end do ! return 99 continue + ! ! An end-of-file condition returns an empty string. eof = .true. - return ! + ! -- Return + return end function read_line subroutine GetFileFromPath(pathname, filename) implicit none - ! -- dummy variables + ! -- dummy character(len=*), intent(in) :: pathname character(len=*), intent(out) :: filename - ! -- local variables + ! -- local integer(I4B) :: i, istart, istop, lenpath character(len=1) :: fs = '/' character(len=1) :: bs = '\' @@ -1616,40 +1338,44 @@ subroutine GetFileFromPath(pathname, filename) lenpath = len_trim(pathname) istart = 1 istop = lenpath - loop: do i=lenpath,1,-1 + loop: do i = lenpath, 1, -1 if (pathname(i:i) == fs .or. pathname(i:i) == bs) then if (i == istop) then istop = istop - 1 else istart = i + 1 exit loop - endif - endif - enddo loop + end if + end if + end do loop if (istop >= istart) then filename = pathname(istart:istop) - endif + end if ! + ! -- Return return end subroutine GetFileFromPath + !> @brief Starting at position icol, define string as line(istart:istop). + !! + !! If string can be interpreted as an integer(I4B), return integer in idnum + !! argument. If token is not an integer(I4B), assume it is a boundary name, + !! return NAMEDBOUNDFLAG in idnum, convert string to uppercase and return it + !! in bndname. + !< subroutine extract_idnum_or_bndname(line, icol, istart, istop, idnum, bndname) - ! Starting at position icol, define string as line(istart:istop). - ! If string can be interpreted as an integer(I4B), return integer in idnum argument. - ! If token is not an integer(I4B), assume it is a boundary name, return NAMEDBOUNDFLAG - ! in idnum, convert string to uppercase and return it in bndname. implicit none - ! -- dummy variables - character(len=*), intent(inout) :: line - integer(I4B), intent(inout) :: icol, istart, istop - integer(I4B), intent(out) :: idnum - character(len=LENBOUNDNAME), intent(out) :: bndname - ! -- local variables - integer(I4B) :: istat, ndum, ncode=0 + ! -- dummy + character(len=*), intent(inout) :: line + integer(I4B), intent(inout) :: icol, istart, istop + integer(I4B), intent(out) :: idnum + character(len=LENBOUNDNAME), intent(out) :: bndname + ! -- local + integer(I4B) :: istat, ndum, ncode = 0 real(DP) :: rdum ! call urword(line, icol, istart, istop, ncode, ndum, rdum, 0, 0) - read(line(istart:istop),*,iostat=istat) ndum + read (line(istart:istop), *, iostat=istat) ndum if (istat == 0) then idnum = ndum bndname = '' @@ -1657,24 +1383,21 @@ subroutine extract_idnum_or_bndname(line, icol, istart, istop, idnum, bndname) idnum = NAMEDBOUNDFLAG bndname = line(istart:istop) call upcase(bndname) - endif + end if ! + ! -- Return return end subroutine extract_idnum_or_bndname + !> @brief Read auxiliary variables from an input line + !< subroutine urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text) -! ****************************************************************************** -! Read auxiliary variables from an input line -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ArrayHandlersModule, only: ExpandArray - use ConstantsModule, only: LENAUXNAME + use ConstantsModule, only: LENAUXNAME ! -- implicit implicit none - ! -- dummy variables + ! -- dummy integer(I4B), intent(inout) :: naux integer(I4B), intent(in) :: inunit integer(I4B), intent(in) :: iout @@ -1684,18 +1407,19 @@ subroutine urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text) character(len=LENAUXNAME), allocatable, dimension(:), intent(inout) :: auxname character(len=*), intent(inout) :: line character(len=*), intent(in) :: text - ! -- local variables + ! -- local integer(I4B) :: n, linelen integer(I4B) :: iauxlen real(DP) :: rval -! ------------------------------------------------------------------------------ + ! linelen = len(line) - if(naux > 0) then - write(errmsg,'(a)') 'Auxiliary variables already specified. Auxiliary ' // & - 'variables must be specified on one line in the options block.' + if (naux > 0) then + write (errmsg, '(a)') 'Auxiliary variables already specified. '// & + & 'Auxiliary variables must be specified on one line in the '// & + & 'options block.' call store_error(errmsg) call store_error_unit(inunit) - endif + end if auxloop: do call urword(line, lloc, istart, istop, 1, n, rval, iout, inunit) if (istart >= linelen) exit auxloop @@ -1708,57 +1432,53 @@ subroutine urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text) & to ', LENAUXNAME, ' characters.' call store_error(errmsg) call store_error_unit(inunit) - end if + end if naux = naux + 1 call ExpandArray(auxname) auxname(naux) = line(istart:istop) - if(iout > 0) then - write(iout, "(4X,'AUXILIARY ',a,' VARIABLE: ',A)") & + if (iout > 0) then + write (iout, "(4X,'AUXILIARY ',a,' VARIABLE: ',A)") & trim(adjustl(text)), auxname(naux) - endif - enddo auxloop + end if + end do auxloop ! + ! -- Return return end subroutine urdaux + !> @brief Define the print or save format + !! + !! Define cdatafmp as a Fortran output format based on user input. Also define + !! nvalues, nwidth, and editdesc. + !! + !! Syntax for linein: + !! COLUMNS nval WIDTH nwid [DIGITS ndig [options]] + !! + !! Where: + !! nval = Number of values per line. + !! nwid = Number of character places to be used for each value. + !! ndig = Number of digits to the right of the decimal point (required + !! for real array). + !! options are: + !! editoption: One of [EXPONENTIAL, FIXED, GENERAL, SCIENTIFIC] + !! A default value should be passed in for editdesc as G, I, E, F, or S. + !! If I is passed in, then the fortran format will be for an integer variable. + !< subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) -! ****************************************************************************** -! print_format -- define the print or save format -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ -! Define cdatafmp as a Fortran output format based on user input. Also define -! nvalues, nwidth, and editdesc. -! -! Syntax for linein: -! COLUMNS nval WIDTH nwid [DIGITS ndig [options]] -! -! Where: -! nval = Number of values per line. -! nwid = Number of character places to be used for each value. -! ndig = Number of digits to the right of the decimal point (required -! for real array). -! options are: -! editoption: One of [EXPONENTIAL, FIXED, GENERAL, SCIENTIFIC] -! A default value should be passed in for editdesc as G, I, E, F, or S. -! If I is passed in, then the fortran format will be for an integer variable. -! ------------------------------------------------------------------------------ - ! -- dummy variables + ! -- dummy character(len=*), intent(in) :: linein character(len=*), intent(inout) :: cdatafmp character(len=*), intent(inout) :: editdesc integer(I4B), intent(inout) :: nvaluesp integer(I4B), intent(inout) :: nwidthp integer(I4B), intent(in) :: inunit - ! -- local variables + ! -- local character(len=len(linein)) :: line character(len=20), dimension(:), allocatable :: words character(len=100) :: ermsg - integer(I4B) :: ndigits=0, nwords=0 + integer(I4B) :: ndigits = 0, nwords = 0 integer(I4B) :: i, ierr logical :: isint -! ------------------------------------------------------------------------------ ! ! -- Parse line and initialize values line(:) = linein(:) @@ -1766,17 +1486,17 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) ierr = 0 i = 0 isint = .false. - if(editdesc == 'I') isint = .true. + if (editdesc == 'I') isint = .true. ! ! -- Check array name if (nwords < 1) then - ermsg = 'Could not build PRINT_FORMAT from line' // trim(line) + ermsg = 'Could not build PRINT_FORMAT from line'//trim(line) call store_error(trim(ermsg)) ermsg = 'Syntax is: COLUMNS WIDTH DIGITS & & ' call store_error(trim(ermsg)) call store_error_unit(inunit) - endif + end if ! ermsg = 'Error setting PRINT_FORMAT. Syntax is incorrect in line:' if (nwords >= 4) then @@ -1784,14 +1504,14 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) if (.not. same_word(words(3), 'WIDTH')) ierr = 1 ! -- Read nvalues and nwidth if (ierr == 0) then - read(words(2), *, iostat=ierr) nvaluesp - endif + read (words(2), *, iostat=ierr) nvaluesp + end if if (ierr == 0) then - read(words(4), *, iostat=ierr) nwidthp - endif + read (words(4), *, iostat=ierr) nwidthp + end if else ierr = 1 - endif + end if if (ierr /= 0) then call store_error(ermsg) call store_error(line) @@ -1799,7 +1519,7 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) &DIGITS ' call store_error(trim(ermsg)) call store_error_unit(inunit) - endif + end if i = 4 ! if (.not. isint) then @@ -1807,12 +1527,12 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) if (nwords >= 5) then if (.not. same_word(words(5), 'DIGITS')) ierr = 1 ! -- Read ndigits - read(words(6), *, iostat=ierr) ndigits + read (words(6), *, iostat=ierr) ndigits else ierr = 1 - endif + end if i = i + 2 - endif + end if ! ! -- Check for EXPONENTIAL | FIXED | GENERAL | SCIENTIFIC option. ! -- Check for LABEL, WRAP, and STRIP options. @@ -1834,7 +1554,7 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) editdesc = 'S' if (isint) ierr = 1 case default - ermsg = 'Error in format specification. Unrecognized option: ' // words(i) + ermsg = 'Error in format specification. Unrecognized option: '//words(i) call store_error(ermsg) ermsg = 'Valid values are EXPONENTIAL, FIXED, GENERAL, or SCIENTIFIC.' call store_error(ermsg) @@ -1842,13 +1562,13 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) end select else exit - endif - enddo + end if + end do if (ierr /= 0) then call store_error(ermsg) call store_error(line) call store_error_unit(inunit) - endif + end if ! ! -- Build the output format. select case (editdesc) @@ -1860,178 +1580,183 @@ subroutine print_format(linein, cdatafmp, editdesc, nvaluesp, nwidthp, inunit) call BuildFloatFormat(nvaluesp, nwidthp, ndigits, editdesc, cdatafmp) end select ! + ! -- Return return end subroutine print_format + !> @brief Build a fixed format for printing or saving a real array + !< subroutine BuildFixedFormat(nvalsp, nwidp, ndig, outfmt, prowcolnum) - ! Build a fixed format for printing or saving a real array implicit none - ! -- dummy variables + ! -- dummy integer(I4B), intent(in) :: nvalsp, nwidp, ndig character(len=*), intent(inout) :: outfmt - logical, intent(in), optional :: prowcolnum ! default true - ! -- local variables - character(len=8) :: cvalues, cwidth, cdigits - character(len=60) :: ufmt + logical, intent(in), optional :: prowcolnum ! default true + ! -- local + character(len=8) :: cvalues, cwidth, cdigits + character(len=60) :: ufmt logical :: prowcolnumlocal - ! formats - 10 format(i8) + ! -- formats + character(len=*), parameter :: fmtndig = "(i8)" ! if (present(prowcolnum)) then prowcolnumlocal = prowcolnum else prowcolnumlocal = .true. - endif + end if ! ! -- Convert integers to characters and left-adjust - write(cdigits,10) ndig + write (cdigits, fmtndig) ndig cdigits = adjustl(cdigits) ! ! -- Build format for printing to the list file in wrap format - write(cvalues,10) nvalsp + write (cvalues, fmtndig) nvalsp cvalues = adjustl(cvalues) - write(cwidth,10) nwidp + write (cwidth, fmtndig) nwidp cwidth = adjustl(cwidth) if (prowcolnumlocal) then ufmt = '(1x,i3,1x,' else ufmt = '(5x,' - endif - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,f' - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '.' - ufmt = trim(ufmt) // cdigits - ufmt = trim(ufmt) // '):/(5x,' - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,f' - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '.' - ufmt = trim(ufmt) // cdigits - ufmt = trim(ufmt) // ')))' + end if + ! + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,f' + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'.' + ufmt = trim(ufmt)//cdigits + ufmt = trim(ufmt)//'):/(5x,' + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,f' + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'.' + ufmt = trim(ufmt)//cdigits + ufmt = trim(ufmt)//')))' outfmt = ufmt ! + ! -- Return return end subroutine BuildFixedFormat + !> @brief Build a floating-point format for printing or saving a real array + !< subroutine BuildFloatFormat(nvalsp, nwidp, ndig, editdesc, outfmt, prowcolnum) - ! Build a floating-point format for printing or saving a real array implicit none - ! -- dummy variables + ! -- dummy integer(I4B), intent(in) :: nvalsp, nwidp, ndig character(len=*), intent(in) :: editdesc character(len=*), intent(inout) :: outfmt - logical, intent(in), optional :: prowcolnum ! default true - ! -- local variables - character(len=8) :: cvalues, cwidth, cdigits - character(len=60) :: ufmt + logical, intent(in), optional :: prowcolnum ! default true + ! -- local + character(len=8) :: cvalues, cwidth, cdigits + character(len=60) :: ufmt logical :: prowcolnumlocal - ! formats - 10 format(i8) + ! -- formats + character(len=*), parameter :: fmtndig = "(i8)" ! if (present(prowcolnum)) then prowcolnumlocal = prowcolnum else prowcolnumlocal = .true. - endif + end if ! ! -- Build the format - write(cdigits,10) ndig + write (cdigits, fmtndig) ndig cdigits = adjustl(cdigits) ! -- Convert integers to characters and left-adjust - write(cwidth,10) nwidp + write (cwidth, fmtndig) nwidp cwidth = adjustl(cwidth) ! -- Build format for printing to the list file - write(cvalues, 10) (nvalsp - 1) + write (cvalues, fmtndig) (nvalsp - 1) cvalues = adjustl(cvalues) if (prowcolnumlocal) then - ufmt = '(1x,i3,2x,1p,' // editdesc + ufmt = '(1x,i3,2x,1p,'//editdesc else - ufmt = '(6x,1p,' // editdesc - endif - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '.' - ufmt = trim(ufmt) // cdigits - if (nvalsp>1) then - ufmt = trim(ufmt) // ',' - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,' - ufmt = trim(ufmt) // editdesc - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '.' - ufmt = trim(ufmt) // cdigits - ufmt = trim(ufmt) // ')' - endif - ufmt = trim(ufmt) // ':/(5x,' - write(cvalues, 10) nvalsp + ufmt = '(6x,1p,'//editdesc + end if + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'.' + ufmt = trim(ufmt)//cdigits + if (nvalsp > 1) then + ufmt = trim(ufmt)//',' + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,' + ufmt = trim(ufmt)//editdesc + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'.' + ufmt = trim(ufmt)//cdigits + ufmt = trim(ufmt)//')' + end if + ! + ufmt = trim(ufmt)//':/(5x,' + write (cvalues, fmtndig) nvalsp cvalues = adjustl(cvalues) - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,' - ufmt = trim(ufmt) // editdesc - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '.' - ufmt = trim(ufmt) // cdigits - ufmt = trim(ufmt) // ')))' + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,' + ufmt = trim(ufmt)//editdesc + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'.' + ufmt = trim(ufmt)//cdigits + ufmt = trim(ufmt)//')))' outfmt = ufmt ! + ! -- Return return end subroutine BuildFloatFormat + !> @brief Build a format for printing or saving an integer array + !< subroutine BuildIntFormat(nvalsp, nwidp, outfmt, prowcolnum) - ! Build a format for printing or saving an integer array implicit none - ! -- dummy variables + ! -- dummy integer(I4B), intent(in) :: nvalsp, nwidp character(len=*), intent(inout) :: outfmt - logical, intent(in), optional :: prowcolnum ! default true - ! -- local variables - character(len=8) :: cvalues, cwidth - character(len=60) :: ufmt + logical, intent(in), optional :: prowcolnum ! default true + ! -- local + character(len=8) :: cvalues, cwidth + character(len=60) :: ufmt logical :: prowcolnumlocal - ! formats - 10 format(i8) + ! -- formats + character(len=*), parameter :: fmtndig = "(i8)" ! if (present(prowcolnum)) then prowcolnumlocal = prowcolnum else prowcolnumlocal = .true. - endif + end if ! ! -- Build format for printing to the list file in wrap format - write(cvalues,10)nvalsp + write (cvalues, fmtndig) nvalsp cvalues = adjustl(cvalues) - write(cwidth,10)nwidp + write (cwidth, fmtndig) nwidp cwidth = adjustl(cwidth) if (prowcolnumlocal) then ufmt = '(1x,i3,1x,' else ufmt = '(5x,' - endif - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,i' - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // '):/(5x,' - ufmt = trim(ufmt) // cvalues - ufmt = trim(ufmt) // '(1x,i' - ufmt = trim(ufmt) // cwidth - ufmt = trim(ufmt) // ')))' + end if + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,i' + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//'):/(5x,' + ufmt = trim(ufmt)//cvalues + ufmt = trim(ufmt)//'(1x,i' + ufmt = trim(ufmt)//cwidth + ufmt = trim(ufmt)//')))' outfmt = ufmt ! + ! -- Return return end subroutine BuildIntFormat - !> @brief Get the number of words in a string - !! - !! Function to get the number of words in a string - !! !< function get_nwords(line) - ! -- return variable - integer(I4B) :: get_nwords !< number of words in a string - ! -- dummy variables - character(len=*), intent(in) :: line !< line - ! -- local variables + ! -- return + integer(I4B) :: get_nwords !< number of words in a string + ! -- dummy + character(len=*), intent(in) :: line !< line + ! -- local integer(I4B) :: linelen integer(I4B) :: lloc integer(I4B) :: istart @@ -2051,108 +1776,103 @@ function get_nwords(line) get_nwords = get_nwords + 1 end do ! - ! -- return + ! -- Return return end function get_nwords + !> @brief Move the file pointer. + !! + !! Patterned after fseek, which is not supported as part of the fortran + !! standard. For this subroutine to work the file must have been opened with + !! access='stream' and action='readwrite'. + !< subroutine fseek_stream(iu, offset, whence, status) -! ****************************************************************************** -! Move the file pointer. Patterned after fseek, which is not -! supported as part of the fortran standard. For this subroutine to work -! the file must have been opened with access='stream' and action='readwrite'. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy integer(I4B), intent(in) :: iu integer(I4B), intent(in) :: offset integer(I4B), intent(in) :: whence integer(I4B), intent(inout) :: status + ! -- local integer(I8B) :: ipos -! ------------------------------------------------------------------------------ ! - inquire(unit=iu, size=ipos) - - select case(whence) - case(0) + inquire (unit=iu, size=ipos) + ! + select case (whence) + case (0) ! ! -- whence = 0, offset is relative to start of file ipos = 0 + offset - case(1) + case (1) ! ! -- whence = 1, offset is relative to current pointer position - inquire(unit=iu, pos=ipos) + inquire (unit=iu, pos=ipos) ipos = ipos + offset - case(2) + case (2) ! ! -- whence = 2, offset is relative to end of file - inquire(unit=iu, size=ipos) + inquire (unit=iu, size=ipos) ipos = ipos + offset end select ! ! -- position the file pointer to ipos - write(iu, pos=ipos, iostat=status) - inquire(unit=iu, pos=ipos) + write (iu, pos=ipos, iostat=status) + inquire (unit=iu, pos=ipos) ! - ! -- return + ! -- Return return end subroutine fseek_stream - + + !> @brief Read until non-comment line found and then return line. + !! + !! Different from u8rdcom in that line is a deferred length character string, + !! which allows any length lines to be read using the get_line subroutine. + !< subroutine u9rdcom(iin, iout, line, ierr) -! ****************************************************************************** -! Read until non-comment line found and then return line. Different from -! u8rdcom in that line is a deferred length character string, which allows -! any length lines to be read using the get_line subroutine. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- module use, intrinsic :: iso_fortran_env, only: IOSTAT_END implicit none - ! -- dummy variables - integer(I4B), intent(in) :: iin - integer(I4B), intent(in) :: iout - character (len=:), allocatable, intent(inout) :: line - integer(I4B), intent(out) :: ierr - ! -- local variables - character (len=:), allocatable :: linetemp - character (len=2), parameter :: comment = '//' - character(len=1), parameter :: tab = CHAR(9) + ! -- dummy + integer(I4B), intent(in) :: iin + integer(I4B), intent(in) :: iout + character(len=:), allocatable, intent(inout) :: line + integer(I4B), intent(out) :: ierr + ! -- local + character(len=:), allocatable :: linetemp + character(len=2), parameter :: comment = '//' + character(len=1), parameter :: tab = CHAR(9) logical :: iscomment integer(I4B) :: i, j, l, istart, lsize -! ------------------------------------------------------------------------------ - !code ! !readerrmsg = '' line = comment pcomments: do call get_line(iin, line, ierr) if (ierr == IOSTAT_END) then - ! -- End of file reached. - ! -- Backspace is needed for gfortran. - backspace(iin) + ! -- End of file reached. Return with ierr = IOSTAT_END + ! and line as an empty string line = ' ' exit pcomments elseif (ierr /= 0) then ! -- Other error...report it call unitinquire(iin) - write(errmsg, *) 'u9rdcom: Could not read from unit: ',iin + write (errmsg, *) 'u9rdcom: Could not read from unit: ', iin call store_error(errmsg, terminate=.TRUE.) - endif - if (len_trim(line).lt.1) then + end if + if (len_trim(line) < 1) then line = comment cycle end if ! - ! Ensure that any initial tab characters are treated as spaces + ! -- Ensure that any initial tab characters are treated as spaces cleartabs: do ! ! -- adjustl manually to avoid stack overflow lsize = len(line) istart = 1 - allocate(character(len=lsize) :: linetemp) + allocate (character(len=lsize) :: linetemp) do j = 1, lsize - if (line(j:j) /= ' ' .and. line(j:j) /= ',' .and. line(j:j) /= char(9)) then + if (line(j:j) /= ' ' .and. line(j:j) /= ',' .and. & + line(j:j) /= char(9)) then istart = j exit end if @@ -2160,65 +1880,64 @@ subroutine u9rdcom(iin, iout, line, ierr) linetemp(:) = ' ' linetemp(:) = line(istart:) line(:) = linetemp(:) - deallocate(linetemp) + deallocate (linetemp) ! ! -- check for comment iscomment = .false. select case (line(1:1)) - case ('#') - iscomment = .true. - exit cleartabs - case ('!') - iscomment = .true. - exit cleartabs - case (tab) - line(1:1) = ' ' - cycle cleartabs - case default - if (line(1:2).eq.comment) iscomment = .true. - if (len_trim(line) < 1) iscomment = .true. - exit cleartabs + case ('#') + iscomment = .true. + exit cleartabs + case ('!') + iscomment = .true. + exit cleartabs + case (tab) + line(1:1) = ' ' + cycle cleartabs + case default + if (line(1:2) == comment) iscomment = .true. + if (len_trim(line) < 1) iscomment = .true. + exit cleartabs end select end do cleartabs ! - if (.not.iscomment) then + if (.not. iscomment) then exit pcomments else if (iout > 0) then !find the last non-blank character. - l=len(line) + l = len(line) do i = l, 1, -1 - if(line(i:i).ne.' ') then + if (line(i:i) /= ' ') then exit end if end do - !print the line up to the last non-blank character. - write(iout,'(1x,a)') line(1:i) + ! -- print the line up to the last non-blank character. + write (iout, '(1x,a)') line(1:i) end if end if end do pcomments + ! + ! -- Return return end subroutine u9rdcom + !> @brief Read an unlimited length line from unit number lun into a deferred- + !! length character string (line). + !! + !! Tack on a single space to the end so that routines like URWORD continue to + !! function as before. + !< subroutine get_line(lun, line, iostat) -! ****************************************************************************** -! Read an unlimited length line from unit number lun into a deferred-length -! character string (line). Tack on a single space to the end so that -! routines like URWORD continue to function as before. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- dummy variables + ! -- dummy integer(I4B), intent(in) :: lun character(len=:), intent(out), allocatable :: line integer(I4B), intent(out) :: iostat - ! -- local variables + ! -- local integer(I4B), parameter :: buffer_len = MAXCHARLEN character(len=buffer_len) :: buffer character(len=:), allocatable :: linetemp integer(I4B) :: size_read, linesize -! ------------------------------------------------------------------------------ ! ! -- initialize line = '' @@ -2226,36 +1945,33 @@ subroutine get_line(lun, line, iostat) ! ! -- process do - read ( lun, '(A)', & - iostat = iostat, & - advance = 'no', & - size = size_read ) buffer + read (lun, '(A)', iostat=iostat, advance='no', size=size_read) buffer if (is_iostat_eor(iostat)) then linesize = len(line) - deallocate(linetemp) - allocate(character(len=linesize) :: linetemp) + deallocate (linetemp) + allocate (character(len=linesize) :: linetemp) linetemp(:) = line(:) - deallocate(line) - allocate(character(len=linesize + size_read + 1) :: line) + deallocate (line) + allocate (character(len=linesize + size_read + 1) :: line) line(:) = linetemp(:) - line(linesize+1:) = buffer(:size_read) + line(linesize + 1:) = buffer(:size_read) linesize = len(line) line(linesize:linesize) = ' ' iostat = 0 exit else if (iostat == 0) then linesize = len(line) - deallocate(linetemp) - allocate(character(len=linesize) :: linetemp) + deallocate (linetemp) + allocate (character(len=linesize) :: linetemp) linetemp(:) = line(:) - deallocate(line) - allocate(character(len=linesize + size_read) :: line) + deallocate (line) + allocate (character(len=linesize + size_read) :: line) line(:) = linetemp(:) - line(linesize+1:) = buffer(:size_read) + line(linesize + 1:) = buffer(:size_read) else exit end if end do - end subroutine get_line + end subroutine get_line -END MODULE InputOutputModule +end module InputOutputModule diff --git a/src/Utilities/Iunit.f90 b/src/Utilities/Iunit.f90 index 0f109a0fe47..b1a7e949f2b 100644 --- a/src/Utilities/Iunit.f90 +++ b/src/Utilities/Iunit.f90 @@ -1,12 +1,14 @@ -! -- Module to manage unit numbers. Allows for multiple unit numbers -! -- assigned to a single package type, as shown below. -! -- row(i) cunit(i) iunit(i)%nval iunit(i)%iunit iunit(i)%ipos -! -- 1 BCF6 1 (1000) (1) -! -- 2 WEL 3 (1001,1003,1005) (2,5,7) -! -- 3 GHB 1 (1002) (4) -! -- 4 EVT 2 (1004,1006) (6,10) -! -- 5 RIV 0 () () -! -- ... +!> @brief +!! -- Module to manage unit numbers. Allows for multiple unit numbers +!! -- assigned to a single package type, as shown below. +!! -- row(i) cunit(i) iunit(i)%nval iunit(i)%iunit iunit(i)%ipos +!! -- 1 BCF6 1 (1000) (1) +!! -- 2 WEL 3 (1001,1003,1005) (2,5,7) +!! -- 3 GHB 1 (1002) (4) +!! -- 4 EVT 2 (1004,1006) (6,10) +!! -- 5 RIV 0 () () +!! -- ... +!< module IunitModule @@ -35,21 +37,16 @@ module IunitModule contains + !> @brief Allocate the cunit and iunit entries of this object, and copy cunit + !! into the object + !< subroutine init(this, niunit, cunit) -! ****************************************************************************** -! init -- allocate the cunit and iunit entries of this object, and copy -! cunit into the object. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(IunitType), intent(inout) :: this integer(I4B), intent(in) :: niunit character(len=*), dimension(niunit), intent(in) :: cunit ! -- local integer(I4B) :: i -! ------------------------------------------------------------------------------ ! allocate (this%cunit(niunit)) allocate (this%iunit(niunit)) @@ -62,15 +59,11 @@ subroutine init(this, niunit, cunit) return end subroutine init + !> @brief Add an ftyp and unit number + !! + !! Find the row for the ftyp and store another iunit value. + !< subroutine addfile(this, ftyp, iunit, ipos, namefilename) -! ****************************************************************************** -! addfile -- add an ftyp and unit number. Find the row for the ftyp and -! store another iunit value. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(IunitType), intent(inout) :: this character(len=*), intent(in) :: ftyp @@ -81,7 +74,6 @@ subroutine addfile(this, ftyp, iunit, ipos, namefilename) character(len=LINELENGTH) :: errmsg integer(I4B), allocatable, dimension(:) :: itemp integer(I4B) :: i, irow -! ------------------------------------------------------------------------------ ! ! -- Find the row containing ftyp irow = 0 @@ -104,7 +96,7 @@ subroutine addfile(this, ftyp, iunit, ipos, namefilename) this%iunit(irow)%nval = 1 else ! - ! -- increase size of iunit + ! -- Increase size of iunit allocate (itemp(this%iunit(irow)%nval)) itemp(:) = this%iunit(irow)%iunit(:) deallocate (this%iunit(irow)%iunit) @@ -112,13 +104,13 @@ subroutine addfile(this, ftyp, iunit, ipos, namefilename) allocate (this%iunit(irow)%iunit(this%iunit(irow)%nval)) this%iunit(irow)%iunit(1:this%iunit(irow)%nval - 1) = itemp(:) ! - ! -- increase size of ipos + ! -- Increase size of ipos itemp(:) = this%iunit(irow)%ipos(:) deallocate (this%iunit(irow)%ipos) allocate (this%iunit(irow)%ipos(this%iunit(irow)%nval)) this%iunit(irow)%ipos(1:this%iunit(irow)%nval - 1) = itemp(:) ! - ! -- cleanup temp + ! -- Cleanup temp deallocate (itemp) end if this%iunit(irow)%iunit(this%iunit(irow)%nval) = iunit @@ -128,20 +120,18 @@ subroutine addfile(this, ftyp, iunit, ipos, namefilename) return end subroutine + !> @brief Get the last unit number for type ftyp or return 0 for iunit. + !! + !! If iremove is 1, then remove this unit number. Similar to a list.pop(). + !< subroutine getunitnumber(this, ftyp, iunit, iremove) -! ****************************************************************************** -! Get the last unit number for type ftyp or return 0 for iunit. If iremove -! is 1, then remove this unit number. Similar to a list.pop(). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(IunitType), intent(inout) :: this character(len=*), intent(in) :: ftyp integer(I4B), intent(inout) :: iunit integer(I4B), intent(in) :: iremove + ! -- local integer(I4B) :: i, irow, nval -! ------------------------------------------------------------------------------ ! ! -- Find the row irow = 0 @@ -152,7 +142,7 @@ subroutine getunitnumber(this, ftyp, iunit, iremove) end if end do ! - ! -- Find the unit number. + ! -- Find the unit number iunit = 0 if (irow > 0) then nval = this%iunit(irow)%nval diff --git a/src/Utilities/List.f90 b/src/Utilities/List.f90 index 1273359f0ce..70ac71dd502 100644 --- a/src/Utilities/List.f90 +++ b/src/Utilities/List.f90 @@ -1,12 +1,12 @@ module ListModule - ! -- ListType implements a generic list. use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop use ConstantsModule, only: LINELENGTH - use GenericUtilitiesModule, only: sim_message, stop_with_error implicit none private - public :: ListType, ListNodeType, isEqualIface, arePointersEqual + public :: ListType, ListNodeType, isEqualIface + !> @brief A generic heterogeneous doubly-linked list. type :: ListType ! -- Public members type(ListNodeType), pointer, public :: firstNode => null() @@ -65,8 +65,7 @@ function isEqualIface(obj1, obj2) result(isEqual) contains - ! -- Public type-bound procedures for ListType - + !> @brief Append the given item to the list subroutine Add(this, objptr) ! -- dummy variables class(ListType), intent(inout) :: this @@ -84,17 +83,10 @@ subroutine Add(this, objptr) this%lastNode => this%lastNode%nextNode end if this%nodeCount = this%nodeCount + 1 - return end subroutine Add + !> @brief Deallocate all items in list subroutine Clear(this, destroy) - ! ************************************************************************** - ! clear_list (finalizer) - ! Deallocate all items in linked list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy variables class(ListType) :: this logical, intent(in), optional :: destroy @@ -130,32 +122,21 @@ subroutine Clear(this, destroy) end do ! call this%Reset() - ! - return + end subroutine Clear + !> @brief Return number of nodes in list function Count(this) - ! ************************************************************************** - ! Count - ! Return number of nodes in linked list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- - ! -- return integer(I4B) :: Count - ! -- dummy variables class(ListType) :: this - ! Count = this%nodeCount - ! - return end function Count + !> @brief Determine whether the list contains the given object. function ContainsObject(this, obj, isEqual) result(hasObj) class(ListType), intent(inout) :: this class(*), pointer :: obj - procedure(isEqualIface), pointer, intent(in) :: isEqual + procedure(isEqualIface), pointer, intent(in), optional :: isEqual logical :: hasObj ! local type(ListNodeType), pointer :: current => null() @@ -163,33 +144,26 @@ function ContainsObject(this, obj, isEqual) result(hasObj) hasObj = .false. current => this%firstNode do while (associated(current)) - if (isEqual(current%Value, obj)) then - hasObj = .true. - return + if (present(isEqual)) then + if (isEqual(current%Value, obj)) then + hasObj = .true. + return + end if + else + if (associated(current%Value, obj)) then + hasObj = .true. + return + end if end if ! -- Advance to the next node current => current%nextNode end do - ! this means there is no match - return end function - function arePointersEqual(obj1, obj2) result(areIdentical) - class(*), pointer :: obj1, obj2 - logical :: areIdentical - areIdentical = associated(obj1, obj2) - end function arePointersEqual - + !> @brief Deallocate fromNode and all previous nodes, and reassign firstNode. subroutine DeallocateBackward(this, fromNode) - ! ************************************************************************** - ! DeallocateBackward - ! Deallocate fromNode and all previous nodes in list; reassign firstNode. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), target, intent(inout) :: this type(ListNodeType), pointer, intent(inout) :: fromNode @@ -215,10 +189,10 @@ subroutine DeallocateBackward(this, fromNode) end do fromNode => null() end if - ! - return + end subroutine DeallocateBackward + !> @brief Get the index of the given item in the list. function GetIndex(this, obj) result(idx) class(ListType), target, intent(inout) :: this class(*), pointer :: obj @@ -238,33 +212,29 @@ function GetIndex(this, obj) result(idx) end function GetIndex + !> @brief Get the next item in the list function GetNextItem(this) result(resultobj) class(ListType), target, intent(inout) :: this - ! result class(*), pointer :: resultobj - ! call this%Next() resultobj => this%get_current_item() - return end function GetNextItem + !> @brief Get the previous item in the list function GetPreviousItem(this) result(resultobj) class(ListType), target, intent(inout) :: this - ! result class(*), pointer :: resultobj - ! call this%Previous() resultobj => this%get_current_item() - return end function GetPreviousItem + !> @brief Insert the given item after the given index. subroutine InsertAfter(this, objptr, indx) ! -- dummy class(ListType), intent(inout) :: this class(*), pointer, intent(inout) :: objptr integer(I4B), intent(in) :: indx ! -- local - character(len=LINELENGTH) :: line integer(I4B) :: numnodes type(ListNodeType), pointer :: precedingNode => null() type(ListNodeType), pointer :: followingNode => null() @@ -285,17 +255,14 @@ subroutine InsertAfter(this, objptr, indx) followingNode%prevNode => newNode this%nodeCount = this%nodeCount + 1 else - write (line, '(a)') 'Programming error in ListType%insert_after' - call sim_message(line) - call stop_with_error(1) + call pstop(1, 'Programming error in ListType%insert_after') end if end if - ! - return + end subroutine InsertAfter + !> @brief Insert the given item before the given node. subroutine InsertBefore(this, objptr, targetNode) - ! Insert an object into the list in front of a target node ! -- dummy class(ListType), intent(inout) :: this class(*), pointer, intent(inout) :: objptr @@ -303,9 +270,8 @@ subroutine InsertBefore(this, objptr, targetNode) ! -- local type(ListNodeType), pointer :: newNode => null() ! - if (.not. associated(targetNode)) then - stop 'Programming error, likely in call to ListType%InsertBefore' - end if + if (.not. associated(targetNode)) & + call pstop(1, 'Programming error in ListType%InsertBefore') ! ! Allocate a new list node and point its Value member to the object allocate (newNode) @@ -324,13 +290,13 @@ subroutine InsertBefore(this, objptr, targetNode) end if targetNode%prevNode => newNode this%nodeCount = this%nodeCount + 1 - ! - return + end subroutine InsertBefore + !> @brief Move the list's current node pointer and index one node forwards. subroutine Next(this) class(ListType), target, intent(inout) :: this - ! + if (this%currentNodeIndex == 0) then if (associated(this%firstNode)) then this%currentNode => this%firstNode @@ -348,29 +314,27 @@ subroutine Next(this) this%currentNodeIndex = 0 end if end if - return end subroutine Next + !> @brief Move the list's current node pointer and index one node backwards. subroutine Previous(this) class(ListType), target, intent(inout) :: this - ! if (this%currentNodeIndex <= 1) then call this%Reset() else this%currentNode => this%currentNode%prevNode this%currentNodeIndex = this%currentNodeIndex - 1 end if - return end subroutine Previous + !> @brief Reset the list's current node pointer and index. subroutine Reset(this) class(ListType), target, intent(inout) :: this - ! this%currentNode => null() this%currentNodeIndex = 0 - return end subroutine Reset + !> @brief Remove the node at the given index, optionally destroying its value. subroutine remove_node_by_index(this, i, destroyValue) ! -- dummy class(ListType), intent(inout) :: this @@ -384,10 +348,10 @@ subroutine remove_node_by_index(this, i, destroyValue) if (associated(node)) then call this%remove_this_node(node, destroyValue) end if - ! - return + end subroutine remove_node_by_index + !> @brief Remove the given node, optionally destroying its value. subroutine remove_this_node(this, node, destroyValue) ! -- dummy class(ListType), intent(inout) :: this @@ -432,12 +396,12 @@ subroutine remove_this_node(this, node, destroyValue) end if call this%Reset() end if - ! - return + end subroutine remove_this_node ! -- Private type-bound procedures for ListType + !> @brief Get a pointer to the item at the current node. function get_current_item(this) result(resultobj) class(ListType), target, intent(inout) :: this ! result @@ -447,17 +411,10 @@ function get_current_item(this) result(resultobj) if (associated(this%currentNode)) then resultobj => this%currentNode%Value end if - return end function get_current_item + !> @brief Get a pointer to the item at the given index. function get_item_by_index(this, indx) result(resultobj) - ! ************************************************************************** - ! get_item_by_index (implements GetItem) - ! Return object stored in ListNodeType%Value by index in list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), intent(inout) :: this integer(I4B), intent(in) :: indx @@ -511,17 +468,10 @@ function get_item_by_index(this, indx) result(resultobj) return end if end do - return end function get_item_by_index + !> @brief Get the node at the given index function get_node_by_index(this, indx) result(resultnode) - ! ************************************************************************** - ! get_item_by_index (implements GetItem) - ! Return object stored in ListNodeType%Value by index in list - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(ListType), intent(inout) :: this integer(I4B), intent(in) :: indx @@ -572,36 +522,22 @@ function get_node_by_index(this, indx) result(resultnode) return end if end do - return end function get_node_by_index ! -- Type-bound procedures for ListNodeType + !> @brief Return a pointer to this node's value. function GetItem(this) result(valueObject) - ! ************************************************************************ - ! Perform a pointer assignment of valueObject to the contents of - ! this%Value - ! ************************************************************************ - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------ class(ListNodeType), intent(inout) :: this class(*), pointer :: valueObject - ! valueObject => this%Value - return end function GetItem + !> @brief Nullify (optionally deallocating) this node's value. subroutine DeallocValue(this, destroy) - ! ************************************************************************ - ! Deallocate whatever is stored in the Value component of this node. - ! ************************************************************************ - ! - ! SPECIFICATIONS: - ! ------------------------------------------------------------------------ class(ListNodeType), intent(inout) :: this logical, intent(in), optional :: destroy - ! + if (associated(this%Value)) then if (present(destroy)) then if (destroy) then @@ -610,7 +546,6 @@ subroutine DeallocValue(this, destroy) end if nullify (this%Value) end if - return end subroutine DeallocValue end module ListModule diff --git a/src/Utilities/ListReader.f90 b/src/Utilities/ListReader.f90 index 99177280d38..db38583f1b5 100644 --- a/src/Utilities/ListReader.f90 +++ b/src/Utilities/ListReader.f90 @@ -6,6 +6,8 @@ module ListReaderModule LENAUXNAME, LENLISTLABEL, DONE use SimVariablesModule, only: errmsg use SimModule, only: store_error, count_errors, store_error_unit + use LongLineReaderModule, only: LongLineReaderType + use GeomUtilModule, only: get_ijk, get_jk, get_node implicit none private @@ -41,6 +43,7 @@ module ListReaderModule integer(I4B), dimension(:), allocatable :: idxtxtauxcol ! col locations of text in auxvar character(len=LENTIMESERIESNAME), dimension(:), allocatable :: txtrlist ! text found in rlist character(len=LENTIMESERIESNAME), dimension(:), allocatable :: txtauxvar ! text found in auxvar + type(LongLineReaderType), pointer :: line_reader => null() contains procedure :: read_list procedure :: write_list @@ -53,8 +56,9 @@ module ListReaderModule contains - subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & - rlist, auxvar, auxname, boundname, label) + subroutine read_list(this, line_reader, in, iout, nlist, inamedbound, & + mshape, nodelist, rlist, auxvar, auxname, boundname, & + label) ! ****************************************************************************** ! init -- Initialize the reader ! ****************************************************************************** @@ -65,6 +69,7 @@ subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & use ConstantsModule, only: LENBOUNDNAME ! -- dummy class(ListReaderType) :: this + type(LongLineReaderType), intent(inout), target :: line_reader integer(I4B), intent(in) :: in integer(I4B), intent(in) :: iout integer(I4B), intent(inout) :: nlist @@ -95,6 +100,7 @@ subroutine read_list(this, in, iout, nlist, inamedbound, mshape, nodelist, & this%auxvar => auxvar this%auxname => auxname this%boundname => boundname + this%line_reader => line_reader ! ! -- Allocate arrays for storing text and text locations if (.not. allocated(this%idxtxtrow)) allocate (this%idxtxtrow(0)) @@ -125,7 +131,7 @@ subroutine read_control_record(this) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: u9rdcom, urword + use InputOutputModule, only: urword ! -- dummy class(ListReaderType) :: this ! -- local @@ -142,7 +148,7 @@ subroutine read_control_record(this) this%ibinary = 0 ! ! -- Read to the first non-commented line - call u9rdcom(this%in, this%iout, this%line, this%ierr) + call this%line_reader%rdcom(this%in, this%iout, this%line, this%ierr) this%lloc = 1 call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, & this%iout, this%in) @@ -167,7 +173,7 @@ subroutine set_openclose(this) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ ! -- modules - use InputOutputModule, only: u9rdcom, urword, openfile + use InputOutputModule, only: urword, openfile use OpenSpecModule, only: form, access use ConstantsModule, only: LINELENGTH ! -- dummy @@ -237,8 +243,9 @@ subroutine set_openclose(this) ! ! -- Read the first line from inlist to be consistent with how the list is ! read when it is included in the package input file - if (this%ibinary /= 1) call u9rdcom(this%inlist, this%iout, this%line, & - this%ierr) + if (this%ibinary /= 1) & + call this%line_reader%rdcom(this%inlist, this%iout, this%line, & + this%ierr) ! ! -- return return @@ -282,7 +289,6 @@ subroutine read_binary(this) ! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LINELENGTH, LENBIGLINE - use InputOutputModule, only: get_node ! -- dummy class(ListReaderType) :: this ! -- local @@ -314,14 +320,14 @@ subroutine read_binary(this) ! ! -- read layer, row, col, or cell number read (this%inlist, iostat=this%ierr) cellid - - ! -- ensure cellid is valid, store an error otherwise - call check_cellid(ii, cellid, this%mshape, this%ndim) - + ! ! -- If not end of record, then store nodenumber, else ! calculate lstend and nlist, and exit readloop select case (this%ierr) case (0) + ! + ! -- ensure cellid is valid, store an error otherwise + call check_cellid(ii, cellid, this%mshape, this%ndim) ! ! -- Check range if (ii > mxlist) then @@ -394,7 +400,7 @@ subroutine read_ascii(this) ! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, LINELENGTH, DZERO - use InputOutputModule, only: u9rdcom, urword, get_node + use InputOutputModule, only: urword use ArrayHandlersModule, only: ExpandArray use TdisModule, only: kper ! -- dummy @@ -427,7 +433,8 @@ subroutine read_ascii(this) readloop: do ! ! -- First line was already read, so don't read again - if (ii /= 1) call u9rdcom(this%inlist, 0, this%line, this%ierr) + if (ii /= 1) & + call this%line_reader%rdcom(this%inlist, 0, this%line, this%ierr) ! ! -- If this is an unknown-length list, then check for END. ! If found, then backspace, set nlist, and exit readloop. @@ -436,10 +443,10 @@ subroutine read_ascii(this) call urword(this%line, this%lloc, this%istart, this%istop, 1, idum, r, & this%iout, this%inlist) if (this%line(this%istart:this%istop) == 'END' .or. this%ierr < 0) then - ! If ierr < 0, backspace was already performed in u9rdcom, so only - ! need to backspace if END was found. + ! If END was found then call line_reader backspace + ! emulator so that caller can proceed with reading END. if (this%ierr == 0) then - backspace (this%inlist) + call this%line_reader%bkspc(this%inlist) end if this%nlist = ii - 1 exit readloop @@ -629,7 +636,7 @@ subroutine write_list(this) ! -- modules use ConstantsModule, only: LINELENGTH, LENBOUNDNAME, & TABLEFT, TABCENTER - use InputOutputModule, only: ulstlb, get_ijk + use InputOutputModule, only: ulstlb use TableModule, only: TableType, table_cr ! -- dummy class(ListReaderType) :: this diff --git a/src/Utilities/LongLineReader.f90 b/src/Utilities/LongLineReader.f90 new file mode 100644 index 00000000000..bce57afd45d --- /dev/null +++ b/src/Utilities/LongLineReader.f90 @@ -0,0 +1,117 @@ +!> @brief This module contains the LongLineReaderType +!! +!! The LongLineReader is a utility for reading text lines +!! from mf6 input files. It calls u9rdcom (which calls +!! get_line) to read the first non-commented line of an +!! input file. The LongLineReader can emulate the Fortran +!! backspace command by calling the bkspc method, which stores +!! the current line in last_line, and will return last_line +!! upon the next call to rdcom. The LongLineReader was +!! implemented to replace all Fortran backspace calls, due +!! to a bug in ifort and ifx that prevented the backspace +!! command from working properly with non-advancing IO. +!! +!< +module LongLineReaderModule + + use, intrinsic :: iso_fortran_env, only: IOSTAT_END + use KindModule, only: I4B + use SimModule, only: store_error + use InputOutputModule, only: u9rdcom + + implicit none + + private + public :: LongLineReaderType + + !> @brief LongLineReaderType + !! + !! Object for reading input from mf6 input files + !! + !< + type :: LongLineReaderType + + character(len=:), allocatable :: line + character(len=:), allocatable :: last_line + integer(I4B) :: nbackspace = 0 + integer(I4B) :: iostat = 0 + integer(I4B) :: last_unit = 0 + + contains + + procedure :: bkspc + procedure :: rdcom + + end type LongLineReaderType + +contains + + !> @brief Return the first non-comment line + !! + !! Skip through any comments and return the first + !! non-commented line. If an end of file was + !! encountered previously, then return a blank line. + !! If a backspace was called prior to this call, + !! then do not read a new line and return last_line + !! instead. + !! + !< + subroutine rdcom(this, iu, iout, line, ierr) + class(LongLineReaderType) :: this + integer(I4B), intent(in) :: iu + integer(I4B), intent(in) :: iout + character(len=:), intent(inout), allocatable :: line + integer(I4B), intent(inout) :: ierr + + ierr = 0 + + ! If using this reader to read from a new file + ! then reset state + if (iu /= this%last_unit) then + this%nbackspace = 0 + this%iostat = 0 + end if + + if (this%nbackspace == 1) then + ! If backspace was called, then return last line + if (allocated(line)) deallocate (line) + allocate (character(len=len(this%last_line) + 1) :: line) + line(:) = this%last_line(:) + this%nbackspace = 0 + else + ! if end of file was reached previously, then return a + ! blank line and return ierr as IOSTAT_END + if (this%iostat == IOSTAT_END) then + line = ' ' + ierr = IOSTAT_END + else + call u9rdcom(iu, iout, line, ierr) + end if + this%last_line = line + this%iostat = ierr + end if + this%last_unit = iu + return + end subroutine rdcom + + !> @brief Emulate a Fortan backspace + !! + !! Emulate a fortran backspace call by storing + !! the current line in long_line + !! + !< + subroutine bkspc(this, iin) + class(LongLineReaderType) :: this + integer(I4B), intent(in) :: iin + if (this%nbackspace > 0) then + call store_error( & + "Programming error in LongLineReaderType%bkspc(). Backspace & + & called more than once for an open file.", & + terminate=.true.) + else + this%nbackspace = 1 + end if + return + end subroutine bkspc + +end module LongLineReaderModule diff --git a/src/Utilities/MathUtil.f90 b/src/Utilities/MathUtil.f90 new file mode 100644 index 00000000000..f53c1d3d21c --- /dev/null +++ b/src/Utilities/MathUtil.f90 @@ -0,0 +1,437 @@ +module MathUtilModule + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use ConstantsModule, only: MAXCHARLEN, LENHUGELINE, & + DZERO, DPREC, DSAME, & + LINELENGTH, LENHUGELINE, VSUMMARY + + implicit none + private + public :: f1d, is_close, mod_offset, zeroch, zeroin, zerotest + + interface mod_offset + module procedure :: mod_offset_int, mod_offset_dbl + end interface mod_offset + + interface + function f1d(x) result(fx) + import DP + real(DP), intent(in) :: x + real(DP) :: fx + end function + end interface + +contains + + !> @brief Check if a real value is approximately equal to another. + !! + !! By default the determination is symmetric in a and b, as in + !! Python's math.isclose, with relative difference scaled by a + !! factor of the larger absolute value of a and b. The formula + !! is: abs(a - b) <= max(rtol * max(abs(a), abs(b)), atol). + !! + !! If symmetric is set to false the test is asymmetric in a and + !! b, with b taken to be the reference value, and the alternate + !! formula (abs(a - b) <= (atol + rtol * abs(b))) is used. This + !! is the approach taken by numpy.allclose. + !! + !! Defaults for rtol and atol are DSAME and DZERO, respectively. + !! If a or b are near 0 (especially if either is 0), an absolute + !! tolerance suitable for the particular case should be provided. + !! For a justification of a zero absolute tolerance default see: + !! https://peps.python.org/pep-0485/#absolute-tolerance-default + !< + pure logical function is_close(a, b, rtol, atol, symmetric) + ! dummy + real(DP), intent(in) :: a !< first real + real(DP), intent(in) :: b !< second real (reference value if asymmetric) + real(DP), intent(in), optional :: rtol !< relative tolerance (default=DSAME) + real(DP), intent(in), optional :: atol !< absolute tolerance (default=DZERO) + logical(LGP), intent(in), optional :: symmetric !< toggle (a)symmetric comparison + ! local + real(DP) :: lrtol, latol + logical(LGP) :: lsymmetric + + ! check for exact equality + if (a == b) then + is_close = .true. + return + end if + + ! process optional arguments + if (.not. present(rtol)) then + lrtol = DSAME + else + lrtol = rtol + end if + if (.not. present(atol)) then + latol = DZERO + else + latol = atol + end if + if (.not. present(symmetric)) then + lsymmetric = .true. + else + lsymmetric = symmetric + end if + + if (lsymmetric) then + ! "weak" symmetric test, https://peps.python.org/pep-0485/#which-symmetric-test + is_close = abs(a - b) <= max(lrtol * max(abs(a), abs(b)), latol) + else + ! asymmetric, https://numpy.org/doc/stable/reference/generated/numpy.isclose.html + is_close = (abs(a - b) <= (latol + lrtol * abs(b))) + end if + end function is_close + + !> @brief Modulo with offset for integer values. + pure function mod_offset_int(a, n, d) result(mo) + ! -- dummy + integer(I4B), intent(in) :: a !< dividend + integer(I4B), intent(in) :: n !< divisor + integer(I4B), intent(in), optional :: d !< offset + integer(I4B) :: mo + ! -- local + integer(I4B) :: ld + + if (present(d)) then + ld = d + else + ld = 0 + end if + mo = a - n * floor(real(a - ld) / n) + end function mod_offset_int + + !> @brief Modulo with offset for double precision values. + pure function mod_offset_dbl(a, n, d) result(mo) + ! -- dummy + real(DP), intent(in) :: a !< dividend + real(DP), intent(in) :: n !< divisor + real(DP), intent(in), optional :: d !< offset + real(DP) :: mo + ! -- local + real(DP) :: ld + + if (present(d)) then + ld = d + else + ld = 0 + end if + mo = a - n * floor((a - ld) / n) + end function mod_offset_dbl + + !> @brief Compute zeros on an interval using Chadrupatla's method + !! + !! A zero of the function f{x} is computed in the interval (x0, x1) + !! given tolerance epsa using Chandrupatla's method. FORTRAN code based + !! generally on pseudocode in Scherer, POJ (2013) "Computational Physics: + !! Simulation of Classical and Quantum Systems," 2nd ed., Springer, New York. + !! + !< + function zeroch(x0, x1, f, epsa) result(z) + ! -- dummy + real(DP) :: x0, x1 + procedure(f1d), pointer, intent(in) :: f + real(DP) :: epsa + real(DP) :: z + ! -- local + real(DP) :: epsm + real(DP) :: a, b, c, t + real(DP) :: aminusb, cminusb + real(DP) :: fa, fb, fc, fm, ft + real(DP) :: faminusfb, fcminusfb + real(DP) :: phi, philo, phihi + real(DP) :: racb, rcab, rbca + real(DP) :: tol, tl, tlc + real(DP) :: xi, xm, xt + + epsm = epsilon(x0) + b = x0 + a = x1 + c = x1 + aminusb = a - b + fb = f(b) + fa = f(a) + fc = f(c) + t = 5d-1 + + do while (.true.) + ! xt = a + t*(b - a) + xt = a - t * aminusb + ft = f(xt) + if (sign(ft, fa) == ft) then + c = a + fc = fa + a = xt + fa = ft + else + c = b + b = a + a = xt + fc = fb + fb = fa + fa = ft + end if + aminusb = a - b + cminusb = c - b + faminusfb = fa - fb + fcminusfb = fc - fb + xm = a + fm = fa + if (dabs(fb) < dabs(fa)) then + xm = b + fm = fb + end if + tol = 2d0 * epsm * dabs(xm) + epsa + ! tl = tol/dabs(b - c) + tl = tol / dabs(cminusb) + if ((tl > 5d-1) .or. (fm == 0d0)) then + z = xm + return + end if + ! xi = (a - b)/(c - b) + xi = aminusb / cminusb + ! phi = (fa - fb)/(fc - fb) + phi = faminusfb / fcminusfb + philo = 1d0 - dsqrt(1d0 - xi) + phihi = dsqrt(xi) + if ((phi > philo) .and. (phi < phihi)) then + ! rab = fa/(fb - fa) + ! rab = -fa/faminusfb + ! rcb = fc/(fb - fc) + ! rcb = -fc/fcminusfb + ! rac = fa/(fc - fa) + ! rbc = fb/(fc - fb) + ! rbc = fb/fcminusfb + ! t = rab*rcb + rac*rbc*(c - a)/(b - a) + ! t = rab*rcb - rac*rbc*(c - a)/aminusb + racb = fa / fcminusfb + rcab = fc / faminusfb + rbca = fb / (fc - fa) + t = racb * (rcab - rbca * (c - a) / aminusb) + if (t < tl) then + t = tl + else + tlc = 1d0 - tl + if (t > tlc) then + t = tlc + end if + end if + else + t = 5d-1 + end if + ! if (t < tl) t = tl + ! if (t > 1d0 - tl) t = 1d0 - tl + end do + end function + + !> @brief Compute a zero of the function f(x) in the interval (x0, x1). + !! + !! A zero of the function f(x) is computed in the interval ax,bx. + !! + !! Input: + !! + !! ax left endpoint of initial interval + !! bx right endpoint of initial interval + !! f function subprogram which evaluates f(x) for any x in + !! the interval ax,bx + !! tol desired length of the interval of uncertainty of the + !! final result (.ge.0.) + !! + !! Output: + !! + !! zeroin abscissa approximating a zero of f in the interval ax,bx + !! + !! it is assumed that f(ax) and f(bx) have opposite signs + !! this is checked, and an error message is printed if this is not + !! satisfied. zeroin returns a zero x in the given interval + !! ax,bx to within a tolerance 4*macheps*abs(x)+tol, where macheps is + !! the relative machine precision defined as the smallest representable + !! number such that 1.+macheps .gt. 1. + !! this function subprogram is a slightly modified translation of + !! the algol 60 procedure zero given in richard brent, algorithms for + !! minimization without derivatives, prentice-hall, inc. (1973). + !< + function zeroin(ax, bx, f, tol) result(z) + ! -- dummy + real(DP) :: ax, bx + procedure(f1d), pointer, intent(in) :: f + real(DP) :: tol + real(DP) :: z + ! -- local + real(DP) :: eps + real(DP) :: a, b, c, d, e, s, p, q + real(DP) :: fa, fb, fc, r, tol1, xm + logical(LGP) :: rs + + eps = epsilon(ax) + tol1 = eps + 1.0d0 + + a = ax + b = bx + fa = f(a) + fb = f(b) + + ! check that f(ax) and f(bx) have different signs + if (.not. ((fa .eq. 0.0d0 .or. fb .eq. 0.0d0) .or. & + (fa * (fb / dabs(fb)) .le. 0.0d0))) & + call pstop(1, 'f(ax) and f(bx) do not have different signs,') + + rs = .true. ! var reset + do while (.true.) + if (rs) then + c = a + fc = fa + d = b - a + e = d + end if + + if (.not. (dabs(fc) .ge. dabs(fb))) then + a = b + b = c + c = a + fa = fb + fb = fc + fc = fa + end if + + tol1 = 2.0d0 * eps * dabs(b) + 0.5d0 * tol + xm = 0.5d0 * (c - b) + if ((dabs(xm) .le. tol1) .or. (fb .eq. 0.0d0)) then + z = b + return + end if + + ! see if a bisection is forced + if ((dabs(e) .ge. tol1) .and. (dabs(fa) .gt. dabs(fb))) then + s = fb / fa + if (a .ne. c) then + ! inverse quadratic interpolation + q = fa / fc + r = fb / fc + p = s * (2.0d0 * xm * q * (q - r) - (b - a) * (r - 1.0d0)) + q = (q - 1.0d0) * (r - 1.0d0) * (s - 1.0d0) + else + ! linear interpolation + p = 2.0d0 * xm * s + q = 1.0d0 - s + end if + + if (p .le. 0.0d0) then + p = -p + else + q = -q + end if + s = e + e = d + if (((2.0d0 * p) .ge. (3.0d0 * xm * q - dabs(tol1 * q))) .or. & + (p .ge. dabs(0.5d0 * s * q))) then + d = xm + e = d + else + d = p / q + end if + else + d = xm + e = d + end if + + a = b + fa = fb + + if (dabs(d) .le. tol1) then + if (xm .le. 0.0d0) then + b = b - tol1 + else + b = b + tol1 + end if + else + b = b + d + end if + + fb = f(b) + rs = (fb * (fc / dabs(fc))) .gt. 0.0d0 + end do + end function zeroin + + !> @brief Compute a zero of the function f(x) in the interval (x0, x1) + function zerotest(x0, x1, f, epsa) result(z) + ! -- dummy + real(DP) :: x0, x1 + procedure(f1d), pointer, intent(in) :: f + real(DP) :: epsa + real(DP) :: z + ! -- local + real(DP) :: epsm + real(DP) :: ema, emb + real(DP) :: f0 + real(DP) :: tol + real(DP) :: xa, xb, xl + real(DP) :: ya, yb, yl + logical(LGP) :: retainedxa, retainedxb + + epsm = epsilon(x0) + f0 = f(x0) + if (f0 .eq. 0d0) then + z = x0 + return + else if (f0 .lt. 0d0) then + ya = x0 + yb = x1 + xa = f0 + xb = f(yb) + else + ya = x1 + yb = x0 + xa = f(ya) + xb = f0 + end if + ema = 1d0 + emb = 1d0 + retainedxa = .false. + retainedxb = .false. + + do while (.true.) + ! yl = ya - xa*(yb - ya)/(xb - xa) + yl = (ya * xb * emb - yb * xa * ema) / (xb * emb - xa * ema) + tol = 4d0 * epsm * dabs(yl) + epsa + if (dabs(yb - ya) .le. tol) then + z = yl + return + else + xl = f(yl) + if (xl .eq. 0d0) then + z = yl + return + else if (xl .gt. 0d0) then + if (retainedxa) then + ! ema = 1d0 - xl/xb + ! if (ema <= 0d0) ema = 5d-1 + ema = 5d-1 ! kluge illinois + else + ema = 1d0 + end if + emb = 1d0 + yb = yl + xb = xl + retainedxa = .true. + retainedxb = .false. + else + if (retainedxb) then + ! emb = 1d0 - xl/xa + ! if (emb <= 0d0) emb = 5d-1 + emb = 5d-1 ! kluge illinois + else + emb = 1d0 + end if + ema = 1d0 + ya = yl + xa = xl + retainedxa = .false. + retainedxb = .true. + end if + end if + end do + end function + +end module MathUtilModule diff --git a/src/Utilities/Memory/MemoryHelper.f90 b/src/Utilities/Memory/MemoryHelper.f90 index 17b96a89947..7f0e3760a20 100644 --- a/src/Utilities/Memory/MemoryHelper.f90 +++ b/src/Utilities/Memory/MemoryHelper.f90 @@ -101,14 +101,16 @@ subroutine split_mem_path(mem_path, component, subcomponent) character(len=*), intent(in) :: mem_path !< path to the memory object character(len=LENCOMPONENTNAME), intent(out) :: component !< name of the component (solution, model, exchange) character(len=LENCOMPONENTNAME), intent(out) :: subcomponent !< name of the subcomponent (package) - ! local + character(len=LENMEMPATH) :: local_mem_path integer(I4B) :: idx - idx = index(mem_path, memPathSeparator, back=.true.) + call strip_context_mem_path(mem_path, local_mem_path) + + idx = index(local_mem_path, memPathSeparator, back=.true.) ! if the separator is found at the end of the string, ! the path is invalid: - if (idx == len(mem_path)) then + if (idx == len_trim(local_mem_path)) then write (errmsg, '(*(G0))') & 'Fatal error in Memory Manager, cannot split invalid memory path: ', & mem_path @@ -119,21 +121,64 @@ subroutine split_mem_path(mem_path, component, subcomponent) if (idx > 0) then ! when found: - component = mem_path(:idx - 1) - subcomponent = mem_path(idx + 1:) + component = local_mem_path(:idx - 1) + subcomponent = local_mem_path(idx + 1:) else ! when not found, there apparently is no subcomponent: - component = mem_path + component = local_mem_path(:LENCOMPONENTNAME) subcomponent = '' end if - ! remove context specifier if prepended to component - idx = index(component, memPathSeparator, back=.true.) - if (idx > 0 .and. component(1:2) == '__') then - component = component(idx + 1:) + end subroutine split_mem_path + + !> @brief Return the context from the memory path + !! + !! NB: when there is no context in the memory path, a + !! empty character string is returned. + !< + function get_mem_path_context(mem_path) result(res) + character(len=*), intent(in) :: mem_path !< path to the memory object + character(len=LENMEMPATH) :: res !< memory path context + ! local + integer(I4B) :: idx + + ! initialize the memory path context + res = ' ' + + if (mem_path(1:2) == '__') then + idx = index(mem_path, memPathSeparator) + if (idx > 0) then + res = mem_path(:idx) + end if end if - end subroutine split_mem_path + return + + end function get_mem_path_context + + !> @brief Remove the context from the memory path + !! + !! NB: when there is no context in the memory path, the + !! original memory path is returned. + !< + subroutine strip_context_mem_path(mem_path, mem_path_no_context) + character(len=*), intent(in) :: mem_path !< path to the memory object + character(len=LENMEMPATH), intent(inout) :: mem_path_no_context !< path to the memory object without the context + ! local + integer(I4B) :: idx + character(len=LENMEMPATH) :: context + + ! initialize the local mem_path + mem_path_no_context = mem_path + + context = get_mem_path_context(mem_path) + + if (len_trim(context) > 0) then + idx = len_trim(context) + mem_path_no_context = mem_path(idx + 1:) + end if + + end subroutine strip_context_mem_path !> @brief Generic routine to check the length of (parts of) the memory address !! diff --git a/src/Utilities/Memory/MemoryManager.f90 b/src/Utilities/Memory/MemoryManager.f90 index 3f636210151..da17dabe6f4 100644 --- a/src/Utilities/Memory/MemoryManager.f90 +++ b/src/Utilities/Memory/MemoryManager.f90 @@ -4,15 +4,17 @@ module MemoryManagerModule use ConstantsModule, only: DZERO, DONE, & DEM3, DEM6, DEM9, DEP3, DEP6, DEP9, & LENMEMPATH, LENMEMSEPARATOR, LENVARNAME, & - LENCOMPONENTNAME, LINELENGTH, LENMEMTYPE, & - LENMEMADDRESS, TABSTRING, TABUCSTRING, & + LENMEMADDRESS, LENCOMPONENTNAME, & + LENMEMTYPE, LINELENGTH, & + TABSTRING, TABUCSTRING, & TABINTEGER, TABREAL, TABCENTER, TABLEFT, & TABRIGHT use SimVariablesModule, only: errmsg use SimModule, only: store_error, count_errors use MemoryTypeModule, only: MemoryType use MemoryListModule, only: MemoryListType - use MemoryHelperModule, only: mem_check_length, split_mem_path + use MemoryHelperModule, only: mem_check_length, split_mem_path, & + strip_context_mem_path, get_mem_path_context use TableModule, only: TableType, table_cr use CharacterStringModule, only: CharacterStringType @@ -67,8 +69,10 @@ module MemoryManagerModule interface mem_checkin module procedure & checkin_int1d, & + checkin_int2d, & checkin_dbl1d, & - checkin_dbl2d + checkin_dbl2d, & + checkin_charstr1d end interface mem_checkin interface mem_reallocate @@ -997,6 +1001,49 @@ subroutine checkin_int1d(aint, name, mem_path, name2, mem_path2) return end subroutine checkin_int1d + !> @brief Check in an existing 2d integer array with a new address (name + path) + !< + subroutine checkin_int2d(aint2d, name, mem_path, name2, mem_path2) + integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint2d !< the existing 2d array + character(len=*), intent(in) :: name !< new variable name + character(len=*), intent(in) :: mem_path !< new path where variable is stored + character(len=*), intent(in) :: name2 !< existing variable name + character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored + ! -- local + type(MemoryType), pointer :: mt + integer(I4B) :: ncol, nrow, isize + ! -- code + ! + ! -- check the variable name length + call mem_check_length(name, LENVARNAME, "variable") + ! + ! -- set isize + ncol = size(aint2d, dim=1) + nrow = size(aint2d, dim=2) + isize = ncol * nrow + ! + ! -- allocate memory type + allocate (mt) + ! + ! -- set memory type + mt%aint2d => aint2d + mt%isize = isize + mt%name = name + mt%path = mem_path + write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow + ! + ! -- set master information + mt%master = .false. + mt%mastername = name2 + mt%masterPath = mem_path2 + ! + ! -- add memory type to the memory list + call memorylist%add(mt) + ! + ! -- return + return + end subroutine checkin_int2d + !> @brief Check in an existing 1d double precision array with a new address (name + path) !< subroutine checkin_dbl1d(adbl, name, mem_path, name2, mem_path2) @@ -1082,6 +1129,50 @@ subroutine checkin_dbl2d(adbl2d, name, mem_path, name2, mem_path2) return end subroutine checkin_dbl2d + !> @brief Check in an existing 1d CharacterStringType array with a new address (name + path) + !< + subroutine checkin_charstr1d(acharstr1d, ilen, name, mem_path, name2, mem_path2) + type(CharacterStringType), dimension(:), & + pointer, contiguous, intent(inout) :: acharstr1d !< the existing array + integer(I4B), intent(in) :: ilen + character(len=*), intent(in) :: name !< new variable name + character(len=*), intent(in) :: mem_path !< new path where variable is stored + character(len=*), intent(in) :: name2 !< existing variable name + character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored + ! --local + type(MemoryType), pointer :: mt + integer(I4B) :: isize + ! -- code + ! + ! -- check variable name length + call mem_check_length(name, LENVARNAME, "variable") + ! + ! -- set isize + isize = size(acharstr1d) + ! + ! -- allocate memory type + allocate (mt) + ! + ! -- set memory type + mt%acharstr1d => acharstr1d + mt%element_size = ilen + mt%isize = isize + mt%name = name + mt%path = mem_path + write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, isize + ! + ! -- set master information + mt%master = .false. + mt%mastername = name2 + mt%masterPath = mem_path2 + ! + ! -- add memory type to the memory list + call memorylist%add(mt) + ! + ! -- return + return + end subroutine checkin_charstr1d + !> @brief Reallocate a 1-dimensional defined length string array !< subroutine reallocate_str1d(astr, ilen, nrow, name, mem_path) @@ -2658,7 +2749,7 @@ subroutine mem_summary_total(iout, bytes) ! ! -- set table terms nterms = 2 - nrows = 5 + nrows = 6 ! ! -- set up table title title = 'MEMORY MANAGER TOTAL STORAGE BY DATA TYPE, IN '//trim(cunits) @@ -2703,6 +2794,11 @@ subroutine mem_summary_total(iout, bytes) call memtab%add_term('Total') call memtab%add_term(smb) ! + ! -- Virtual memory + smb = calc_virtual_mem() * fact + call memtab%add_term('Virtual') + call memtab%add_term(smb) + ! ! -- deallocate table call mem_cleanup_table() ! @@ -2734,7 +2830,12 @@ subroutine mem_write_usage(iout) integer(I4B), intent(in) :: iout !< unit number for mfsim.lst ! -- local class(MemoryType), pointer :: mt - character(len=LENMEMPATH), allocatable, dimension(:) :: cunique + character(len=LENMEMADDRESS), allocatable, dimension(:) :: cunique + ! character(len=LENMEMPATH) :: mem_path + character(len=LENMEMPATH) :: context + character(len=LENCOMPONENTNAME) :: component + character(len=LENCOMPONENTNAME) :: subcomponent + character(len=LENMEMADDRESS) :: context_component character(LEN=10) :: cunits integer(I4B) :: ipos integer(I4B) :: icomp @@ -2778,7 +2879,10 @@ subroutine mem_write_usage(iout) ilen = len_trim(cunique(icomp)) do ipos = 1, memorylist%count() mt => memorylist%Get(ipos) - if (cunique(icomp) /= mt%path(1:ilen)) cycle + call split_mem_path(mt%path, component, subcomponent) + context = get_mem_path_context(mt%path) + context_component = trim(context)//component + if (cunique(icomp) /= context_component(1:ilen)) cycle if (.not. mt%master) cycle if (mt%memtype(1:6) == 'STRING') then nchars = nchars + mt%isize * mt%element_size @@ -2833,6 +2937,24 @@ subroutine mem_print_detailed(iout) end subroutine mem_print_detailed + !> @brief Sum up virtual memory, i.e. memory + !< that is owned by other processes + function calc_virtual_mem() result(vmem_size) + real(DP) :: vmem_size + ! local + integer(I4B) :: i + type(MemoryType), pointer :: mt + + vmem_size = DZERO + do i = 1, memorylist%count() + mt => memorylist%Get(i) + if (index(mt%path, "__P") == 1) then + vmem_size = mt%element_size * mt%isize + vmem_size + end if + end do + + end function calc_virtual_mem + !> @brief Deallocate memory in the memory manager !< subroutine mem_da() @@ -2892,11 +3014,14 @@ subroutine mem_unique_origins(cunique) ! -- modules use ArrayHandlersModule, only: ExpandArray, ifind ! -- dummy - character(len=LENMEMPATH), allocatable, dimension(:), intent(inout) :: cunique !< array with unique first components + character(len=LENMEMADDRESS), allocatable, dimension(:), intent(inout) :: & + cunique !< array with unique first components ! -- local class(MemoryType), pointer :: mt + character(len=LENMEMPATH) :: context character(len=LENCOMPONENTNAME) :: component character(len=LENCOMPONENTNAME) :: subcomponent + character(len=LENMEMADDRESS) :: context_component integer(I4B) :: ipos integer(I4B) :: ipa ! -- code @@ -2908,10 +3033,12 @@ subroutine mem_unique_origins(cunique) do ipos = 1, memorylist%count() mt => memorylist%Get(ipos) call split_mem_path(mt%path, component, subcomponent) - ipa = ifind(cunique, component) + context = get_mem_path_context(mt%path) + context_component = trim(context)//component + ipa = ifind(cunique, context_component) if (ipa < 1) then call ExpandArray(cunique, 1) - cunique(size(cunique)) = component + cunique(size(cunique)) = context_component end if end do ! diff --git a/src/Utilities/Memory/MemoryManagerExt.f90 b/src/Utilities/Memory/MemoryManagerExt.f90 index d169449466b..ded5862e4f5 100644 --- a/src/Utilities/Memory/MemoryManagerExt.f90 +++ b/src/Utilities/Memory/MemoryManagerExt.f90 @@ -16,7 +16,8 @@ module MemoryManagerExtModule mem_set_value_int1d, mem_set_value_int1d_mapped, & mem_set_value_int2d, mem_set_value_int3d, mem_set_value_dbl, & mem_set_value_dbl1d, mem_set_value_dbl1d_mapped, & - mem_set_value_dbl2d, mem_set_value_dbl3d, mem_set_value_str + mem_set_value_dbl2d, mem_set_value_dbl3d, mem_set_value_str, & + mem_set_value_charstr1d end interface mem_set_value contains @@ -41,8 +42,6 @@ subroutine memorylist_remove(component, subcomponent, context) mt => memorylist%Get(ipos) if (mt%path == memory_path .and. mt%mt_associated()) then call mt%mt_deallocate() - deallocate (mt) - call memorylist%remove(ipos, .false.) removed = .true. exit end if @@ -61,8 +60,12 @@ subroutine mem_set_value_logical(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'LOGICAL') then - p_mem = mt%logicalsclr + if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (mt%intsclr == 0) then + p_mem = .false. + else + p_mem = .true. + end if end if end subroutine mem_set_value_logical @@ -366,4 +369,23 @@ subroutine mem_set_value_str(p_mem, varname, memory_path, found) end if end subroutine mem_set_value_str + subroutine mem_set_value_charstr1d(p_mem, varname, memory_path, found) + use CharacterStringModule, only: CharacterStringType + type(CharacterStringType), dimension(:), & + pointer, contiguous, intent(inout) :: p_mem !< pointer to charstr 1d array + character(len=*), intent(in) :: varname !< variable name + character(len=*), intent(in) :: memory_path !< path where variable is stored + logical(LGP), intent(inout) :: found + type(MemoryType), pointer :: mt + logical(LGP) :: checkfail = .false. + integer(I4B) :: n + + call get_from_memorylist(varname, memory_path, mt, found, checkfail) + if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then + do n = 1, size(mt%acharstr1d) + p_mem(n) = mt%acharstr1d(n) + end do + end if + end subroutine mem_set_value_charstr1d + end module MemoryManagerExtModule diff --git a/src/Utilities/Message.f90 b/src/Utilities/Message.f90 index c4f40740dcb..1e97db078fb 100644 --- a/src/Utilities/Message.f90 +++ b/src/Utilities/Message.f90 @@ -1,266 +1,481 @@ -!> @brief This module contains message methods -!! -!! This module contains generic message methods that are used to -!! create warning and error messages and notes. This module also has methods -!! for counting messages. The module does not have any dependencies on -!! models, exchanges, or solutions in a simulation. -!! -!< +!> @brief Store and issue logging messages to output units. module MessageModule use KindModule, only: LGP, I4B, DP use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DONE, & - VSUMMARY - use GenericUtilitiesModule, only: sim_message, write_message - use SimVariablesModule, only: istdout + VSUMMARY, LENHUGELINE use ArrayHandlersModule, only: ExpandArray + use SimVariablesModule, only: istdout implicit none + public :: MessagesType + public :: write_message + public :: write_message_counter + public :: write_message_centered - public :: MessageType - - type :: MessageType - - character(len=LINELENGTH) :: title !< title of the message - character(len=LINELENGTH) :: name !< message name - integer(I4B) :: nmessage = 0 !< number of messages stored - integer(I4B) :: max_message = 1000 !< default maximum number of messages that can be stored - integer(I4B) :: max_exceeded = 0 !< flag indicating if the maximum number of messages has exceed the maximum number - integer(I4B) :: inc_message = 100 !< amount to increment message array by when calling ExpandArray - character(len=MAXCHARLEN), allocatable, dimension(:) :: message !< message array - + !> @brief Container for related messages. + !! + !! A maximum capacity can be configured. Message storage + !! is dynamically resized up to the configured capacity. + !< + type :: MessagesType + integer(I4B) :: num_messages = 0 !< number of messages currently stored + integer(I4B) :: max_messages = 1000 !< default max message storage capacity + integer(I4B) :: max_exceeded = 0 !< number of messages in excess of maximum + integer(I4B) :: exp_messages = 100 !< number of slots to expand message array + character(len=MAXCHARLEN), allocatable, dimension(:) :: messages !< message array contains - - procedure :: init_message - procedure :: count_message - procedure :: set_max_message - procedure :: store_message - procedure :: print_message - procedure :: deallocate_message - - end type MessageType + procedure :: init + procedure :: count + procedure :: set_max + procedure :: store + procedure :: write_all + procedure :: deallocate + end type MessagesType contains - !> @brief Always initialize the message object - !! - !! Subroutine that initializes the message object. Allocation of message - !! array occurs on-the-fly. - !! - !< - subroutine init_message(this) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! - ! -- initialize message variables - this%nmessage = 0 - this%max_message = 1000 + !> @brief Initialize message storage. + subroutine init(this) + class(MessagesType) :: this !< MessageType object + + this%num_messages = 0 + this%max_messages = 1000 this%max_exceeded = 0 - this%inc_message = 100 - ! - ! -- return - return - end subroutine init_message - - !> @brief Return number of messages - !! - !! Function to return the number of messages that have been stored. - !! - !! @return ncount number of messages stored - !! - !< - function count_message(this) result(nmessage) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! -- return variable + this%exp_messages = 100 + end subroutine init + + !> @brief Return the number of messages currently stored. + function count(this) result(nmessage) + class(MessagesType) :: this !< MessageType object integer(I4B) :: nmessage - ! - ! -- set nmessage - if (allocated(this%message)) then - nmessage = this%nmessage + + if (allocated(this%messages)) then + nmessage = this%num_messages else nmessage = 0 end if - ! - ! -- return - return - end function count_message - - !> @brief Set the maximum number of messages stored - !! - !! Subroutine to set the maximum number of messages that will be stored - !! in a simulation. - !! - !< - subroutine set_max_message(this, imax) - ! -- dummy variables - class(MessageType) :: this !< MessageType object + end function count + + !> @brief Set the maximum number of messages. + subroutine set_max(this, imax) + class(MessagesType) :: this !< MessageType object integer(I4B), intent(in) :: imax !< maximum number of messages that will be stored - ! - ! -- set max_message - this%max_message = imax - ! - ! -- return - return - end subroutine set_max_message - - !> @brief Store message - !! - !! Subroutine to store a message for printing at the end of - !! the simulation. - !! + + this%max_messages = imax + end subroutine set_max + + !> @brief Add a message to storage. + !! + !! An optional string may be provided to filter out duplicate messages. + !! If any stored messages contain the string the message is not stored. !< - subroutine store_message(this, msg, substring) + subroutine store(this, msg, substring) ! -- dummy variables - class(MessageType) :: this !< MessageType object + class(MessagesType) :: this !< MessageType object character(len=*), intent(in) :: msg !< message - character(len=*), intent(in), optional :: substring !< optional string that can be used - !! to prevent storing duplicate messages + character(len=*), intent(in), optional :: substring !< duplicate pattern ! -- local variables logical(LGP) :: inc_array - logical(LGP) :: increment_message - integer(I4B) :: i - integer(I4B) :: idx - ! - ! -- determine if messages should be expanded - inc_array = .TRUE. - if (allocated(this%message)) then - i = this%nmessage - if (i < size(this%message)) then - inc_array = .FALSE. + integer(I4B) :: i, n + + ! -- resize message array if needed + inc_array = .true. + if (allocated(this%messages)) then + if (this%num_messages < size(this%messages)) then + inc_array = .false. end if end if - ! - ! -- resize message if (inc_array) then - call ExpandArray(this%message, increment=this%inc_message) - this%inc_message = int(this%inc_message * 1.1) + call ExpandArray(this%messages, increment=this%exp_messages) + this%exp_messages = int(this%exp_messages * 1.1) end if - ! - ! -- Determine if the substring exists in the passed message. - ! If substring is in passed message, do not add the duplicate - ! passed message. - increment_message = .TRUE. + + ! -- don't store duplicate messages if (present(substring)) then - do i = 1, this%nmessage - idx = index(this%message(i), substring) - if (idx > 0) then - increment_message = .FALSE. - exit - end if + do i = 1, this%num_messages + if (index(this%messages(i), substring) > 0) return end do end if - ! - ! -- store this message and calculate nmessage - if (increment_message) then - i = this%nmessage + 1 - if (i <= this%max_message) then - this%nmessage = i - this%message(i) = msg - else - this%max_exceeded = this%max_exceeded + 1 - end if + + ! -- store message and update count unless + ! at capacity, then update excess count + n = this%num_messages + 1 + if (n <= this%max_messages) then + this%num_messages = n + this%messages(n) = msg + else + this%max_exceeded = this%max_exceeded + 1 end if - ! - ! -- return - return - end subroutine store_message - - !> @brief Print messages - !! - !! Subroutine to print stored messages. - !! + end subroutine store + + !> @brief Write all stored messages to standard output. + !! + !! An optional title to precede the messages may be provided. + !! The title is printed on a separate line. An arbitrary kind + !! may be specified, e.g. 'note', 'warning' or 'error. A file + !! unit can also be specified to write in addition to stdout. !< - subroutine print_message(this, title, name, iunit, level) + subroutine write_all(this, title, kind, iunit) ! -- dummy variables - class(MessageType) :: this !< MessageType object - character(len=*), intent(in) :: title !< message title - character(len=*), intent(in) :: name !< message name - integer(I4B), intent(in), optional :: iunit !< optional file unit to save messages to - integer(I4B), intent(in), optional :: level !< optional level of messages to print + class(MessagesType) :: this !< MessageType object + character(len=*), intent(in), optional :: title !< message title + character(len=*), intent(in), optional :: kind !< message kind + integer(I4B), intent(in), optional :: iunit !< file unit ! -- local + character(len=LINELENGTH) :: ltitle + character(len=LINELENGTH) :: lkind character(len=LINELENGTH) :: errmsg character(len=LINELENGTH) :: cerr integer(I4B) :: iu - integer(I4B) :: ilevel integer(I4B) :: i integer(I4B) :: isize integer(I4B) :: iwidth ! -- formats character(len=*), parameter :: stdfmt = "(/,A,/)" - ! + ! -- process optional variables + if (present(title)) then + ltitle = title + else + ltitle = '' + end if + if (present(kind)) then + lkind = kind + else + lkind = '' + end if if (present(iunit)) then iu = iunit else iu = 0 end if - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - ! - ! -- write the title and all message entries - if (allocated(this%message)) then - isize = this%nmessage + + ! -- write messages, if any + if (allocated(this%messages)) then + isize = this%num_messages if (isize > 0) then - ! ! -- calculate the maximum width of the prepended string ! for the counter write (cerr, '(i0)') isize iwidth = len_trim(cerr) + 1 - ! + ! -- write title for message - if (iu > 0) then - call sim_message(title, iunit=iu, fmt=stdfmt, level=ilevel) + if (trim(ltitle) /= '') then + if (iu > 0) & + call write_message(iunit=iu, text=ltitle, fmt=stdfmt) + call write_message(text=ltitle, fmt=stdfmt) end if - call sim_message(title, fmt=stdfmt, level=ilevel) - ! + ! -- write each message do i = 1, isize - call write_message(this%message(i), icount=i, iwidth=iwidth, & - level=ilevel) - if (iu > 0) then - call write_message(this%message(i), icount=i, iwidth=iwidth, & - iunit=iu, level=ilevel) - end if + if (iu > 0) & + call write_message_counter( & + iunit=iu, & + text=this%messages(i), & + icount=i, & + iwidth=iwidth) + call write_message_counter( & + text=this%messages(i), & + icount=i, & + iwidth=iwidth) end do - ! + ! -- write the number of additional messages if (this%max_exceeded > 0) then write (errmsg, '(i0,3(1x,a))') & - this%max_exceeded, 'additional', trim(name), & + this%max_exceeded, 'additional', trim(kind), & 'detected but not printed.' - call sim_message(trim(errmsg), fmt='(/,1x,a)', level=ilevel) - if (iu > 0) then - call sim_message(trim(errmsg), iunit=iu, fmt='(/,1x,a)', & - level=ilevel) - end if + if (iu > 0) & + call write_message(iunit=iu, text=trim(errmsg), fmt='(/,1x,a)') + call write_message(text=trim(errmsg), fmt='(/,1x,a)') end if end if end if - ! - ! -- return - return - end subroutine print_message + end subroutine write_all + + !> @ brief Deallocate message storage. + subroutine deallocate (this) + class(MessagesType) :: this + if (allocated(this%messages)) deallocate (this%messages) + end subroutine deallocate - !> @ brief Deallocate message + !> @brief Write a message to an output unit. !! - !! Subroutine that deallocate the array of strings if it was allocated + !! Use `advance` to toggle advancing output. Use `skipbefore/after` to + !! configure the number of whitespace lines before/after the message. + !< + subroutine write_message(text, iunit, fmt, & + skipbefore, skipafter, advance) + ! -- dummy + character(len=*), intent(in) :: text !< message to write + integer(I4B), intent(in), optional :: iunit !< output unit to write the message to + character(len=*), intent(in), optional :: fmt !< format to write the message (default='(a)') + integer(I4B), intent(in), optional :: skipbefore !< number of empty lines before message (default=0) + integer(I4B), intent(in), optional :: skipafter !< number of empty lines after message (default=0) + logical(LGP), intent(in), optional :: advance !< whether to use advancing output (default is .true.) + ! -- local + character(len=3) :: cadvance + integer(I4B) :: i + integer(I4B) :: ilen + integer(I4B) :: iu + character(len=LENHUGELINE) :: simfmt + character(len=*), parameter :: stdfmt = '(a)' + character(len=*), parameter :: emptyfmt = '()' + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- get message length + ilen = len_trim(text) + + ! -- process optional arguments + if (present(fmt)) then + simfmt = fmt + else + if (ilen > 0) then + simfmt = stdfmt + else + simfmt = emptyfmt + end if + end if + if (present(advance)) then + if (advance) then + cadvance = 'YES' + else + cadvance = 'NO' + end if + else + cadvance = 'YES' + end if + + ! -- write empty line before message, if enabled + if (present(skipbefore)) then + do i = 1, skipbefore + write (iu, *) + end do + end if + + ! -- write message if it isn't empty + if (ilen > 0) then + write (iu, trim(simfmt), advance=cadvance) text(1:ilen) + else + write (iu, trim(simfmt), advance=cadvance) + end if + + ! -- write empty line after message, if enabled + if (present(skipafter)) then + do i = 1, skipafter + write (iu, *) + end do + end if + end subroutine write_message + + !> @brief Write a message with configurable indentation and numbering. !! + !! The message may exceed 78 characters in length. Messages longer than + !! 78 characters are written across multiple lines. After icount lines, + !! subsequent lines are indented and numbered. Use skipbefore/after to + !! configure the number of empty lines before/after the message. !< - subroutine deallocate_message(this) - ! -- dummy variables - class(MessageType) :: this !< MessageType object - ! - ! -- deallocate the message - if (allocated(this%message)) then - deallocate (this%message) + subroutine write_message_counter(text, iunit, icount, iwidth, & + skipbefore, skipafter) + ! -- dummy + character(len=*), intent(in) :: text !< message to be written + integer(I4B), intent(in), optional :: iunit !< the unit number to which the message is written + integer(I4B), intent(in), optional :: icount !< counter to prepended to the message + integer(I4B), intent(in), optional :: iwidth !< maximum width of the prepended counter + integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) + integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) + ! -- local + integer(I4B), parameter :: len_line = 78 + character(len=LENHUGELINE) :: amessage + character(len=len_line) :: line + character(len=16) :: cfmt + character(len=10) :: counter + character(len=5) :: fmt_first + character(len=20) :: fmt_cont + logical(LGP) :: include_counter + integer(I4B) :: isb + integer(I4B) :: isa + integer(I4B) :: jend + integer(I4B) :: len_str1 + integer(I4B) :: len_str2 + integer(I4B) :: len_message + integer(I4B) :: i + integer(I4B) :: j + integer(I4B) :: iu + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- abort if message is empty + if (len_trim(text) < 1) return + + ! -- initialize local variables + amessage = text + counter = '' + fmt_first = '(A)' + fmt_cont = '(A)' + len_str1 = 0 + len_str2 = len_line + include_counter = .false. + j = 0 + + ! -- process optional arguments + if (present(skipbefore)) then + isb = skipbefore + else + isb = 0 + end if + if (present(skipafter)) then + isa = skipafter + else + isa = 0 + end if + + ! -- create the counter to prepend to the start of the message, + ! formats, and variables used to create strings + if (present(iwidth) .and. present(icount)) then + include_counter = .true. + + ! -- write counter + write (cfmt, '(A,I0,A)') '(1x,i', iwidth, ',".",1x)' + write (counter, cfmt) icount + + ! -- calculate the length of the first and second string on a line + len_str1 = len(trim(counter)) + 1 + len_str2 = len_line - len_str1 + + ! -- write format for the continuation lines + write (fmt_cont, '(a,i0,a)') & + '(', len(trim(counter)) + 1, 'x,a)' + end if + + ! -- calculate the length of the message + len_message = len_trim(amessage) + + ! -- parse the message into multiple lines +5 continue + jend = j + len_str2 + if (jend >= len_message) go to 100 + do i = jend, j + 1, -1 + if (amessage(i:i) .eq. ' ') then + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:i) + else + line = amessage(j + 1:i) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb) + else + line = adjustl(amessage(j + 1:i)) + call write_message(text=line, iunit=iu, & + fmt=fmt_cont) + end if + j = i + go to 5 + end if + end do + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:jend) + else + line = amessage(j + 1:jend) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb) + else + line = amessage(j + 1:jend) + call write_message(text=line, iunit=iu, & + fmt=fmt_cont) + end if + j = jend + go to 5 + + ! -- last piece of amessage to write to a line +100 continue + jend = len_message + if (j == 0) then + if (include_counter) then + line = counter(1:len_str1)//amessage(j + 1:jend) + else + line = amessage(j + 1:jend) + end if + call write_message(text=line, iunit=iu, & + fmt=fmt_first, & + skipbefore=isb, skipafter=isa) + else + line = amessage(j + 1:jend) + call write_message(text=line, iunit=iu, fmt=fmt_cont, & + skipafter=isa) end if - ! - ! -- return - return - end subroutine deallocate_message + end subroutine write_message_counter + + !> @brief Write horizontally centered text, left-padding as needed. + subroutine write_message_centered(text, linelen, iunit) + ! -- dummy + character(len=*), intent(in) :: text !< message to write to iunit + integer(I4B), intent(in) :: linelen !< length of line to center text in + integer(I4B), intent(in), optional :: iunit !< output unit to write text + ! -- local + character(len=linelen) :: line + character(len=linelen) :: blank + integer(I4B) :: iu + integer(I4B) :: len_message + integer(I4B) :: jend + integer(I4B) :: ipad + integer(I4B) :: i + integer(I4B) :: j + + if (present(iunit)) then + iu = iunit + else + iu = istdout + end if + + ! -- initialize local variables + blank = '' + len_message = len_trim(adjustl(text)) + j = 0 + + ! -- parse the amessage into multiple lines + outer: do while (.true.) + jend = j + linelen + + ! last line + if (jend >= len_message) then + jend = len_message + line = text(j + 1:jend) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + exit outer + end if + + do i = jend, j + 1, -1 + if (text(i:i) .eq. ' ') then + line = text(j + 1:i) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + j = i + cycle outer + end if + end do + + line = text(j + 1:jend) + ipad = ((linelen - len_trim(line)) / 2) + call write_message(text=blank(1:ipad)//line, iunit=iunit) + j = jend + end do outer + end subroutine write_message_centered end module MessageModule diff --git a/src/Utilities/OutputControl/OutputControl.f90 b/src/Utilities/OutputControl/OutputControl.f90 index 8e3f72874b6..2cd2914c6c3 100644 --- a/src/Utilities/OutputControl/OutputControl.f90 +++ b/src/Utilities/OutputControl/OutputControl.f90 @@ -1,7 +1,7 @@ !> @brief This module contains the OutputControlModule !! !! This module defines the OutputControlType. This type -!! is overriden by GWF and GWT to create an Output Control +!! is overridden by GWF and GWT to create an Output Control !! package for the model. !! !< diff --git a/src/Utilities/PackageBudget.f90 b/src/Utilities/PackageBudget.f90 index 93f1f5b2c6b..c6485cd904b 100644 --- a/src/Utilities/PackageBudget.f90 +++ b/src/Utilities/PackageBudget.f90 @@ -119,10 +119,20 @@ end subroutine set_auxname !! GWF Package members stored in BndType. !! !< - subroutine set_pointers(this, flowvarname, mem_path_target) + subroutine set_pointers(this, flowvarname, mem_path_target, input_mempath) + use ConstantsModule, only: LENVARNAME class(PackageBudgetType) :: this !< PackageBudgetType object character(len=*), intent(in) :: flowvarname !< name of variable storing flow (SIMVALS, SIMTOMVR) character(len=*), intent(in) :: mem_path_target !< path where target variable is stored + character(len=*), intent(in) :: input_mempath + character(len=LENVARNAME) :: auxvarname + ! + ! -- set memory manager aux varname + if (input_mempath /= '') then + auxvarname = 'AUXVAR_IDM' + else + auxvarname = 'AUXVAR' + end if ! ! -- Reassign pointers to variables in the flow model call mem_reassignptr(this%nbound, 'NBOUND', this%memoryPath, & @@ -132,7 +142,8 @@ subroutine set_pointers(this, flowvarname, mem_path_target) call mem_reassignptr(this%flow, 'FLOW', this%memoryPath, & flowvarname, mem_path_target) call mem_reassignptr(this%auxvar, 'AUXVAR', this%memoryPath, & - 'AUXVAR', mem_path_target) + auxvarname, mem_path_target) + ! return end subroutine set_pointers diff --git a/src/Utilities/Sim.f90 b/src/Utilities/Sim.f90 index 298f0c544a5..14d5a0103fa 100644 --- a/src/Utilities/Sim.f90 +++ b/src/Utilities/Sim.f90 @@ -10,6 +10,7 @@ module SimModule use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop use DefinedMacros, only: get_os use ConstantsModule, only: MAXCHARLEN, LINELENGTH, & DONE, & @@ -19,8 +20,7 @@ module SimModule use SimVariablesModule, only: istdout, iout, isim_level, ireturnerr, & iforcestop, iunext, & warnmsg - use GenericUtilitiesModule, only: sim_message, stop_with_error - use MessageModule, only: MessageType + use MessageModule, only: MessagesType, write_message implicit none @@ -41,89 +41,52 @@ module SimModule public :: store_error_filename public :: MaxErrors - type(MessageType) :: sim_errors - type(MessageType) :: sim_uniterrors - type(MessageType) :: sim_warnings - type(MessageType) :: sim_notes + type(MessagesType) :: sim_errors + type(MessagesType) :: sim_uniterrors + type(MessagesType) :: sim_warnings + type(MessagesType) :: sim_notes contains !> @brief Return number of errors - !! - !! Function to return the number of errors messages that have been stored. - !! - !! @return ncount number of error messages stored - !! + !! + !! Function to return the number of errors messages that have been stored. + !! + !! @return ncount number of error messages stored + !! !< function count_errors() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_errors%count_message() - ! - ! -- return - return + ncount = sim_errors%count() end function count_errors !> @brief Return number of warnings - !! - !! Function to return the number of warning messages that have been stored. - !! - !! @return ncount number of warning messages stored - !! + !! + !! Function to return the number of warning messages that have been stored. + !! + !! @return ncount number of warning messages stored + !! !< function count_warnings() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_warnings%count_message() - ! - ! -- return - return + ncount = sim_warnings%count() end function count_warnings - !> @brief Return number of notes - !! - !! Function to return the number of notes that have been stored. - !! - !! @return ncount number of notes stored - !! + !> @brief Return the number of notes stored. !< function count_notes() result(ncount) - ! -- return variable integer(I4B) :: ncount - ! - ! -- set ncount - ncount = sim_notes%count_message() - ! - ! -- return - return + ncount = sim_notes%count() end function count_notes - !> @brief Set the maximum number of errors stored - !! - !! Subroutine to set the maximum number of error messages that will be stored - !! in a simulation. - !! + !> @brief Set the maximum number of errors to be stored. !< subroutine MaxErrors(imax) - ! -- dummy variables integer(I4B), intent(in) :: imax !< maximum number of error messages that will be stored - ! - ! -- set the maximum number of error messages that will be saved - call sim_errors%set_max_message(imax) - ! - ! -- return - return + call sim_errors%set_max(imax) end subroutine MaxErrors - !> @brief Store error message - !! - !! Subroutine to store a error message for printing at the end of - !! the simulation. - !! + !> @brief Store an error message. !< subroutine store_error(msg, terminate) ! -- dummy variable @@ -140,24 +103,22 @@ subroutine store_error(msg, terminate) end if ! ! -- store error - call sim_errors%store_message(msg) + call sim_errors%store(msg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error !> @brief Get the file name - !! - !! Subroutine to get the file name from the unit number for a open file. - !! If the INQUIRE function returns the full path (for example, the INTEL - !! compiler) then the returned file name (fname) is limited to the filename - !! without the path. - !! + !! + !! Subroutine to get the file name from the unit number for a open file. + !! If the INQUIRE function returns the full path (for example, the INTEL + !! compiler) then the returned file name (fname) is limited to the filename + !! without the path. + !! !< subroutine get_filename(iunit, fname) ! -- dummy variables @@ -193,17 +154,15 @@ subroutine get_filename(iunit, fname) ilen = len_trim(fname) write (fname, '(a)') fname(ipos + 1:ilen)//' ' end if - ! - ! -- return - return + end subroutine get_filename !> @brief Store the file unit number - !! - !! Subroutine to convert the unit number for a open file to a file name - !! and indicate that there is an error reading from the file. By default, - !! the simulation is terminated when this subroutine is called. - !! + !! + !! Subroutine to convert the unit number for a open file to a file name + !! and indicate that there is an error reading from the file. By default, + !! the simulation is terminated when this subroutine is called. + !! !< subroutine store_error_unit(iunit, terminate) ! -- dummy variables @@ -225,22 +184,20 @@ subroutine store_error_unit(iunit, terminate) inquire (unit=iunit, name=fname) write (errmsg, '(3a)') & "Error occurred while reading file '", trim(adjustl(fname)), "'" - call sim_uniterrors%store_message(errmsg) + call sim_uniterrors%store(errmsg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error_unit !> @brief Store the erroring file name - !! - !! Subroutine to store the file name issuing an error. By default, - !! the simulation is terminated when this subroutine is called - !! + !! + !! Subroutine to store the file name issuing an error. By default, + !! the simulation is terminated when this subroutine is called + !! !< subroutine store_error_filename(filename, terminate) ! -- dummy variables @@ -260,22 +217,20 @@ subroutine store_error_filename(filename, terminate) ! -- store error unit write (errmsg, '(3a)') & "ERROR OCCURRED WHILE READING FILE '", trim(adjustl(filename)), "'" - call sim_uniterrors%store_message(errmsg) + call sim_uniterrors%store(errmsg) ! ! -- terminate the simulation if (lterminate) then call ustop() end if - ! - ! -- return - return + end subroutine store_error_filename !> @brief Store warning message - !! - !! Subroutine to store a warning message for printing at the end of - !! the simulation. - !! + !! + !! Subroutine to store a warning message for printing at the end of + !! the simulation. + !! !< subroutine store_warning(msg, substring) ! -- dummy variables @@ -285,9 +240,9 @@ subroutine store_warning(msg, substring) ! ! -- store warning if (present(substring)) then - call sim_warnings%store_message(msg, substring) + call sim_warnings%store(msg, substring) else - call sim_warnings%store_message(msg) + call sim_warnings%store(msg) end if ! ! -- return @@ -295,10 +250,10 @@ subroutine store_warning(msg, substring) end subroutine store_warning !> @brief Store deprecation warning message - !! - !! Subroutine to store a warning message for deprecated variables - !! and printing at the end of simulation. - !! + !! + !! Subroutine to store a warning message for deprecated variables + !! and printing at the end of simulation. + !! !< subroutine deprecation_warning(cblock, cvar, cver, endmsg, iunit) ! -- modules @@ -330,16 +285,14 @@ subroutine deprecation_warning(cblock, cvar, cver, endmsg, iunit) end if ! ! -- store warning - call sim_warnings%store_message(message) - ! - ! -- return - return + call sim_warnings%store(message) + end subroutine deprecation_warning !> @brief Store note - !! - !! Subroutine to store a note for printing at the end of the simulation. - !! + !! + !! Subroutine to store a note for printing at the end of the simulation. + !! !< subroutine store_note(note) ! -- modules @@ -348,17 +301,15 @@ subroutine store_note(note) character(len=*), intent(in) :: note !< note ! ! -- store note - call sim_notes%store_message(note) - ! - ! -- return - return + call sim_notes%store(note) + end subroutine store_note !> @brief Stop the simulation. - !! - !! Subroutine to stop the simulations with option to print message - !! before stopping with the active error code. - !! + !! + !! Subroutine to stop the simulations with option to print message + !! before stopping with the active error code. + !! !< subroutine ustop(stopmess, ioutlocal) ! -- dummy variables @@ -370,16 +321,16 @@ subroutine ustop(stopmess, ioutlocal) ! -- print the final message call print_final_message(stopmess, ioutlocal) ! - ! -- return appropriate error codes when terminating the program - call stop_with_error(ireturnerr) + ! -- terminate with the appropriate error code + call pstop(ireturnerr) end subroutine ustop !> @brief Print the final messages - !! - !! Subroutine to print the notes, warnings, errors and the final message (if passed). - !! The subroutine also closes all open files. - !! + !! + !! Subroutine to print the notes, warnings, errors and the final message (if passed). + !! The subroutine also closes all open files. + !! !< subroutine print_final_message(stopmess, ioutlocal) ! -- dummy variables @@ -392,19 +343,21 @@ subroutine print_final_message(stopmess, ioutlocal) character(len=*), parameter :: msg = 'Stopping due to error(s)' ! ! -- print the accumulated messages - call sim_notes%print_message('NOTES:', 'note(s)', & - iunit=iout, level=VALL) - call sim_warnings%print_message('WARNING REPORT:', 'warning(s)', & - iunit=iout, level=VALL) - call sim_errors%print_message('ERROR REPORT:', 'error(s)', iunit=iout) - call sim_uniterrors%print_message('UNIT ERROR REPORT:', & - 'file unit error(s)', iunit=iout) + if (isim_level >= VALL) then + call sim_notes%write_all('NOTES:', 'note(s)', & + iunit=iout) + call sim_warnings%write_all('WARNING REPORT:', 'warning(s)', & + iunit=iout) + end if + call sim_errors%write_all('ERROR REPORT:', 'error(s)', iunit=iout) + call sim_uniterrors%write_all('UNIT ERROR REPORT:', & + 'file unit error(s)', iunit=iout) ! ! -- write a stop message, if one is passed if (present(stopmess)) then if (stopmess .ne. ' ') then - call sim_message(stopmess, fmt=fmt, iunit=iout) - call sim_message(stopmess, fmt=fmt) + call write_message(stopmess, fmt=fmt, iunit=iout) + call write_message(stopmess, fmt=fmt) if (present(ioutlocal)) then if (ioutlocal > 0 .and. ioutlocal /= iout) then write (ioutlocal, fmt) trim(stopmess) @@ -418,7 +371,7 @@ subroutine print_final_message(stopmess, ioutlocal) flush (istdout) ! ! -- determine if an error condition has occurred - if (sim_errors%count_message() > 0) then + if (sim_errors%count() > 0) then ireturnerr = 2 if (present(ioutlocal)) then if (ioutlocal > 0 .and. ioutlocal /= iout) write (ioutlocal, fmt) msg @@ -427,34 +380,26 @@ subroutine print_final_message(stopmess, ioutlocal) ! ! -- close all open files call sim_closefiles() - ! - ! -- return - return + end subroutine print_final_message !> @brief Reset the simulation convergence flag - !! - !! Subroutine to reset the simulation convergence flag. - !! + !! + !! Subroutine to reset the simulation convergence flag. + !! !< subroutine converge_reset() - ! -- modules use SimVariablesModule, only: isimcnvg - ! - ! -- reset simulation convergence flag isimcnvg = 1 - ! - ! -- return - return end subroutine converge_reset !> @brief Simulation convergence check - !! - !! Subroutine to check simulation convergence. If the continue option is - !! set the simulation convergence flag is set to True if the simulation - !! did not actually converge for a time step and the non-convergence counter - !! is incremented. - !! + !! + !! Subroutine to check simulation convergence. If the continue option is + !! set the simulation convergence flag is set to True if the simulation + !! did not actually converge for a time step and the non-convergence counter + !! is incremented. + !! !< subroutine converge_check(hasConverged) ! -- modules @@ -484,19 +429,17 @@ subroutine converge_check(hasConverged) ! ! -- save simulation failure message if (isimcnvg == 0) then - call sim_message('', fmt=fmtfail, iunit=iout) + call write_message('', fmt=fmtfail, iunit=iout) hasConverged = .false. end if - ! - ! -- return - return + end subroutine converge_check !> @brief Print the header and initializes messaging - !! - !! Subroutine that prints the initial message and initializes the notes, - !! warning messages, unit errors, and error messages. - !! + !! + !! Subroutine that prints the initial message and initializes the notes, + !! warning messages, unit errors, and error messages. + !! !< subroutine initial_message() ! -- modules @@ -504,27 +447,27 @@ subroutine initial_message() use SimVariablesModule, only: simulation_mode ! ! -- initialize message lists - call sim_errors%init_message() - call sim_uniterrors%init_message() - call sim_warnings%init_message() - call sim_notes%init_message() + call sim_errors%init() + call sim_uniterrors%init() + call sim_warnings%init() + call sim_notes%init() ! ! -- Write banner to screen (unit stdout) call write_listfile_header(istdout, write_kind_info=.false., & write_sys_command=.false.) ! if (simulation_mode == 'PARALLEL') then - call sim_message('(MODFLOW runs in '//trim(simulation_mode)//' mode)', & - skipafter=1) + call write_message('(MODFLOW runs in '//trim(simulation_mode)//' mode)', & + skipafter=1) end if ! end subroutine initial_message !> @brief Create final message - !! - !! Subroutine that creates the appropriate final message and - !! terminates the program with an error message, if necessary. - !! + !! + !! Subroutine that creates the appropriate final message and + !! terminates the program with an error message, if necessary. + !! !< subroutine final_message() ! -- modules @@ -538,9 +481,9 @@ subroutine final_message() if (numnoconverge > 0) then write (warnmsg, fmtnocnvg) numnoconverge if (isimcontinue == 0) then - call sim_errors%store_message(warnmsg) + call sim_errors%store(warnmsg) else - call sim_warnings%store_message(warnmsg) + call sim_warnings%store(warnmsg) end if end if ! @@ -562,26 +505,24 @@ subroutine final_message() end if ! ! -- destroy messages - call sim_errors%deallocate_message() - call sim_uniterrors%deallocate_message() - call sim_warnings%deallocate_message() - call sim_notes%deallocate_message() + call sim_errors%deallocate() + call sim_uniterrors%deallocate() + call sim_warnings%deallocate() + call sim_notes%deallocate() ! ! -- return or halt if (iforcestop == 1) then - call stop_with_error(ireturnerr) + call pstop(ireturnerr) end if end subroutine final_message !> @brief Close all open files - !! - !! Subroutine that closes all open files at the end of the simulation. - !! + !! + !! Subroutine that closes all open files at the end of the simulation. + !! !< subroutine sim_closefiles() - ! -- modules - ! -- dummy ! -- local variables integer(I4B) :: i logical :: opened @@ -607,9 +548,7 @@ subroutine sim_closefiles() ! -- close file unit i close (i) end do - ! - ! -- return - return + end subroutine sim_closefiles end module SimModule diff --git a/src/Utilities/SimStages.f90 b/src/Utilities/SimStages.f90 index 8094b71b5dc..9168f05b9a8 100644 --- a/src/Utilities/SimStages.f90 +++ b/src/Utilities/SimStages.f90 @@ -16,9 +16,11 @@ module SimStagesModule integer(I4B), public, parameter :: STG_BFR_EXG_AC = 7 !< before exchange add connections (per solution) integer(I4B), public, parameter :: STG_BFR_CON_AR = 8 !< before connection allocate read integer(I4B), public, parameter :: STG_AFT_CON_AR = 9 !< afterr connection allocate read - integer(I4B), public, parameter :: STG_BFR_EXG_AD = 10 !< before exchange advance (per solution) - integer(I4B), public, parameter :: STG_BFR_EXG_CF = 11 !< before exchange calculate (per solution) - integer(I4B), public, parameter :: STG_BFR_EXG_FC = 12 !< before exchange formulate (per solution) + integer(I4B), public, parameter :: STG_BFR_EXG_RP = 10 !< before exchange read prepare + integer(I4B), public, parameter :: STG_AFT_CON_RP = 11 !< after connection read prepare + integer(I4B), public, parameter :: STG_BFR_EXG_AD = 12 !< before exchange advance (per solution) + integer(I4B), public, parameter :: STG_BFR_EXG_CF = 13 !< before exchange calculate (per solution) + integer(I4B), public, parameter :: STG_BFR_EXG_FC = 14 !< before exchange formulate (per solution) contains @@ -38,6 +40,8 @@ function STG_TO_STR(stage) result(stg_str) else if (stage == STG_BFR_EXG_AC) then; stg_str = "STG_BFR_EXG_AC" else if (stage == STG_BFR_CON_AR) then; stg_str = "STG_BFR_CON_AR" else if (stage == STG_AFT_CON_AR) then; stg_str = "STG_AFT_CON_AR" + else if (stage == STG_BFR_EXG_RP) then; stg_str = "STG_BFR_EXG_RP" + else if (stage == STG_AFT_CON_RP) then; stg_str = "STG_AFT_CON_RP" else if (stage == STG_BFR_EXG_AD) then; stg_str = "STG_BFR_EXG_AD" else if (stage == STG_BFR_EXG_CF) then; stg_str = "STG_BFR_EXG_CF" else if (stage == STG_BFR_EXG_FC) then; stg_str = "STG_BFR_EXG_FC" diff --git a/src/Utilities/SmoothingFunctions.f90 b/src/Utilities/SmoothingFunctions.f90 index c821e14c67d..657457b79de 100644 --- a/src/Utilities/SmoothingFunctions.f90 +++ b/src/Utilities/SmoothingFunctions.f90 @@ -6,14 +6,12 @@ module SmoothingModule contains + !> @ brief SCurve + !! + !! Computes the S curve for smooth derivatives between x=0 and x=1 + !! from mfusg smooth subroutine in gwf2wel7u1.f + !< subroutine sSCurve(x, range, dydx, y) -! ****************************************************************************** -! COMPUTES THE S CURVE FOR SMOOTH DERIVATIVES BETWEEN X=0 AND X=1 -! FROM mfusg smooth SUBROUTINE in gwf2wel7u1.f -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(in) :: x real(DP), intent(in) :: range real(DP), intent(inout) :: dydx @@ -21,9 +19,8 @@ subroutine sSCurve(x, range, dydx, y) !--local variables real(DP) :: s real(DP) :: xs -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! s = range if (s < DPREC) s = DPREC xs = x / s @@ -41,14 +38,12 @@ subroutine sSCurve(x, range, dydx, y) return end subroutine sSCurve + !> @ brief sCubicLinear + !! + !! Computes the s curve where dy/dx = 0 at x=0; and dy/dx = 1 at x=1. + !! Smooths from zero to a slope of 1. + !< subroutine sCubicLinear(x, range, dydx, y) -! ****************************************************************************** -! COMPUTES THE S CURVE WHERE DY/DX = 0 at X=0; AND DY/DX = 1 AT X=1. -! Smooths from zero to a slope of 1. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(in) :: x real(DP), intent(in) :: range real(DP), intent(inout) :: dydx @@ -56,9 +51,8 @@ subroutine sCubicLinear(x, range, dydx, y) !--local variables real(DP) :: s real(DP) :: xs -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! s = range if (s < DPREC) s = DPREC xs = x / s @@ -76,13 +70,11 @@ subroutine sCubicLinear(x, range, dydx, y) return end subroutine sCubicLinear + !> @ brief sCubic + !! + !! Nonlinear smoothing function returns value between 0-1; cubic function + !< subroutine sCubic(x, range, dydx, y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; cubic function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(inout) :: x real(DP), intent(inout) :: range real(DP), intent(inout) :: dydx @@ -90,9 +82,8 @@ subroutine sCubic(x, range, dydx, y) !--local variables real(DP) :: s, aa, bb real(DP) :: cof1, cof2, cof3 -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! dydx = DZERO y = DZERO if (range < DPREC) range = DPREC @@ -115,22 +106,19 @@ subroutine sCubic(x, range, dydx, y) return end subroutine sCubic + !> @ brief sLinear + !! + !! Linear smoothing function returns value between 0-1 + !< subroutine sLinear(x, range, dydx, y) -! ****************************************************************************** -! Linear smoothing function returns value between 0-1 -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(inout) :: x real(DP), intent(inout) :: range real(DP), intent(inout) :: dydx real(DP), intent(inout) :: y !--local variables real(DP) :: s -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! dydx = DZERO y = DZERO if (range < DPREC) range = DPREC @@ -145,22 +133,19 @@ subroutine sLinear(x, range, dydx, y) return end subroutine sLinear + !> @ brief sQuadratic + !! + !! Nonlinear quadratic smoothing function returns value between 0-1 + !< subroutine sQuadratic(x, range, dydx, y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; quadratic function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(inout) :: x real(DP), intent(inout) :: range real(DP), intent(inout) :: dydx real(DP), intent(inout) :: y !--local variables real(DP) :: s -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! dydx = DZERO y = DZERO if (range < DPREC) range = DPREC @@ -175,13 +160,11 @@ subroutine sQuadratic(x, range, dydx, y) return end subroutine sQuadratic + !> @ brief sChSmooth + !! + !! Function to smooth channel variables during channel drying + !< subroutine sChSmooth(d, smooth, dwdh) -! ****************************************************************************** -! Function to smooth channel variables during channel drying -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ real(DP), intent(in) :: d real(DP), intent(inout) :: smooth real(DP), intent(inout) :: dwdh @@ -194,9 +177,8 @@ subroutine sChSmooth(d, smooth, dwdh) real(DP) :: b real(DP) :: x real(DP) :: y -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! smooth = DZERO s = DEM5 x = d @@ -222,14 +204,11 @@ subroutine sChSmooth(d, smooth, dwdh) return end subroutine sChSmooth + !> @ brief sLinearSaturation + !! + !! Linear saturation function returns value between 0-1 + !< function sLinearSaturation(top, bot, x) result(y) -! ****************************************************************************** -! Linear smoothing function returns value between 0-1; -! Linear saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -238,9 +217,8 @@ function sLinearSaturation(top, bot, x) result(y) real(DP), intent(in) :: x ! -- local real(DP) :: b -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! b = top - bot if (x < bot) then y = DZERO @@ -252,14 +230,11 @@ function sLinearSaturation(top, bot, x) result(y) return end function sLinearSaturation + !> @ brief sCubicSaturation + !! + !! Nonlinear cubic saturation function returns value between 0-1 + !< function sCubicSaturation(top, bot, x, eps) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; -! Quadratic saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -274,9 +249,8 @@ function sCubicSaturation(top, bot, x, eps) result(y) real(DP) :: s real(DP) :: cof1 real(DP) :: cof2 -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! if (present(eps)) then teps = eps else @@ -302,14 +276,11 @@ function sCubicSaturation(top, bot, x, eps) result(y) return end function sCubicSaturation + !> @ brief sQuadraticSaturation + !! + !! Nonlinear quadratic saturation function returns value between 0-1 + !< function sQuadraticSaturation(top, bot, x, eps, bmin) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; -! Quadratic saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -325,9 +296,8 @@ function sQuadraticSaturation(top, bot, x, eps, bmin) result(y) real(DP) :: br real(DP) :: bri real(DP) :: av -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! if (present(eps)) then teps = eps else @@ -372,14 +342,11 @@ function sQuadraticSaturation(top, bot, x, eps, bmin) result(y) return end function sQuadraticSaturation + !> @ brief sQuadraticSaturation + !! + !! van Genuchten saturation function returns value between 0-1 + !< function svanGenuchtenSaturation(top, bot, x, alpha, beta, sr) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; -! van Genuchten saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -394,9 +361,8 @@ function svanGenuchtenSaturation(top, bot, x, alpha, beta, sr) result(y) real(DP) :: pc real(DP) :: gamma real(DP) :: seff -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! b = top - bot pc = (DHALF * b) - x if (pc <= DZERO) then @@ -411,14 +377,11 @@ function svanGenuchtenSaturation(top, bot, x, alpha, beta, sr) result(y) return end function svanGenuchtenSaturation + !> @ brief Derivative of the quadratic saturation function + !! + !! Derivative of nonlinear smoothing function returns value between 0-1; + !< function sQuadraticSaturationDerivative(top, bot, x, eps, bmin) result(y) -! ****************************************************************************** -! Derivative of nonlinear smoothing function returns value between 0-1; -! Derivative of the quadratic saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -434,9 +397,8 @@ function sQuadraticSaturationDerivative(top, bot, x, eps, bmin) result(y) real(DP) :: br real(DP) :: bri real(DP) :: av -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! if (present(eps)) then teps = eps else @@ -474,14 +436,11 @@ function sQuadraticSaturationDerivative(top, bot, x, eps, bmin) result(y) return end function sQuadraticSaturationDerivative + !> @ brief sQSaturation + !! + !! Nonlinear smoothing function returns value between 0-1 + !< function sQSaturation(top, bot, x, c1, c2) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; -! Cubic saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -496,9 +455,7 @@ function sQSaturation(top, bot, x, c1, c2) result(y) real(DP) :: s real(DP) :: cof1 real(DP) :: cof2 -! ------------------------------------------------------------------------------ -! code -! + ! -- code ! ! -- process optional variables if (present(c1)) then @@ -536,14 +493,11 @@ function sQSaturation(top, bot, x, c1, c2) result(y) return end function sQSaturation + !> @ brief sQSaturationDerivative + !! + !! Nonlinear smoothing function returns value between 0-1 + !< function sQSaturationDerivative(top, bot, x, c1, c2) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns value between 0-1; -! Cubic saturation function -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -558,9 +512,8 @@ function sQSaturationDerivative(top, bot, x, c1, c2) result(y) real(DP) :: s real(DP) :: cof1 real(DP) :: cof2 -! ------------------------------------------------------------------------------ -! code -! + ! -- code + ! ! ! -- process optional variables if (present(c1)) then @@ -599,15 +552,13 @@ function sQSaturationDerivative(top, bot, x, c1, c2) result(y) return end function sQSaturationDerivative + !> @ brief sSlope + !! + !! Nonlinear smoothing function returns a smoothed value of y that has the value + !! yi at xi and yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for + !! x-values greater than xi, where dx = x - xi. + !< function sSlope(x, xi, yi, sm, sp, ta) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns a smoothed value of y that has the value -! yi at xi and yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for -! x-values greater than xi, where dx = x - xi. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -625,7 +576,6 @@ function sSlope(x, xi, yi, sm, sp, ta) result(y) real(DP) :: xp real(DP) :: ym real(DP) :: yp -! ------------------------------------------------------------------------------ ! ! -- set smoothing variable a if (present(ta)) then @@ -651,15 +601,13 @@ function sSlope(x, xi, yi, sm, sp, ta) result(y) return end function sSlope + !> @ brief sSlopeDerivative + !! + !! Derivative of nonlinear smoothing function that has the value yi at xi and + !! yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for x-values + !! greater than xi, where dx = x - xi. + !< function sSlopeDerivative(x, xi, sm, sp, ta) result(y) -! ****************************************************************************** -! Derivative of nonlinear smoothing function that has the value yi at xi and -! yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for x-values -! greater than xi, where dx = x - xi. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -674,7 +622,6 @@ function sSlopeDerivative(x, xi, sm, sp, ta) result(y) real(DP) :: dx real(DP) :: mu real(DP) :: rho -! ------------------------------------------------------------------------------ ! ! -- set smoothing variable a if (present(ta)) then @@ -698,16 +645,14 @@ function sSlopeDerivative(x, xi, sm, sp, ta) result(y) return end function sSlopeDerivative + !> @ brief sQuadratic0sp + !! + !! Nonlinear smoothing function returns a smoothed value of y that uses a + !! quadratic to smooth x over range of xi - epsilon to xi + epsilon. + !! Simplification of sQuadraticSlope with sm = 0, sp = 1, and yi = 0. + !! From Panday et al. (2013) - eq. 35 - https://dx.doi.org/10.5066/F7R20ZFJ + !< function sQuadratic0sp(x, xi, tomega) result(y) -! ****************************************************************************** -! Nonlinear smoothing function returns a smoothed value of y that uses a -! quadratic to smooth x over range of xi - epsilon to xi + epsilon. -! Simplification of sQuadraticSlope with sm = 0, sp = 1, and yi = 0. -! From Panday et al. (2013) - eq. 35 - https://dx.doi.org/10.5066/F7R20ZFJ -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -718,7 +663,6 @@ function sQuadratic0sp(x, xi, tomega) result(y) real(DP) :: omega real(DP) :: epsilon real(DP) :: dx -! ------------------------------------------------------------------------------ ! ! -- set smoothing interval if (present(tomega)) then @@ -746,16 +690,14 @@ function sQuadratic0sp(x, xi, tomega) result(y) return end function sQuadratic0sp + !> @ brief sQuadratic0spDerivative + !! + !! Derivative of nonlinear smoothing function returns a smoothed value of y + !! that uses a quadratic to smooth x over range of xi - epsilon to xi + epsilon. + !! Simplification of sQuadraticSlope with sm = 0, sp = 1, and yi = 0. + !! From Panday et al. (2013) - eq. 35 - https://dx.doi.org/10.5066/F7R20ZFJ + !< function sQuadratic0spDerivative(x, xi, tomega) result(y) -! ****************************************************************************** -! Derivative of nonlinear smoothing function returns a smoothed value of y -! that uses a quadratic to smooth x over range of xi - epsilon to xi + epsilon. -! Simplification of sQuadraticSlope with sm = 0, sp = 1, and yi = 0. -! From Panday et al. (2013) - eq. 35 - https://dx.doi.org/10.5066/F7R20ZFJ -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -766,7 +708,6 @@ function sQuadratic0spDerivative(x, xi, tomega) result(y) real(DP) :: omega real(DP) :: epsilon real(DP) :: dx -! ------------------------------------------------------------------------------ ! ! -- set smoothing interval if (present(tomega)) then @@ -794,15 +735,13 @@ function sQuadratic0spDerivative(x, xi, tomega) result(y) return end function sQuadratic0spDerivative + !> @ brief sQuadraticSlope + !! + !! Quadratic smoothing function returns a smoothed value of y that has the value + !! yi at xi and yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for + !! x-values greater than xi, where dx = x - xi. + !< function sQuadraticSlope(x, xi, yi, sm, sp, tomega) result(y) -! ****************************************************************************** -! Quadratic smoothing function returns a smoothed value of y that has the value -! yi at xi and yi + (sm * dx) for x-values less than xi and yi + (sp * dx) for -! x-values greater than xi, where dx = x - xi. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -817,7 +756,6 @@ function sQuadraticSlope(x, xi, yi, sm, sp, tomega) result(y) real(DP) :: epsilon real(DP) :: dx real(DP) :: c -! ------------------------------------------------------------------------------ ! ! -- set smoothing interval if (present(tomega)) then @@ -849,15 +787,13 @@ function sQuadraticSlope(x, xi, yi, sm, sp, tomega) result(y) return end function sQuadraticSlope + !> @ brief sQuadraticSlopeDerivative + !! + !! Derivative of quadratic smoothing function returns a smoothed value of y + !! that has the value yi at xi and yi + (sm * dx) for x-values less than xi and + !! yi + (sp * dx) for x-values greater than xi, where dx = x - xi. + !< function sQuadraticSlopeDerivative(x, xi, sm, sp, tomega) result(y) -! ****************************************************************************** -! Derivative of quadratic smoothing function returns a smoothed value of y -! that has the value yi at xi and yi + (sm * dx) for x-values less than xi and -! yi + (sp * dx) for x-values greater than xi, where dx = x - xi. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: y ! -- dummy variables @@ -871,7 +807,6 @@ function sQuadraticSlopeDerivative(x, xi, sm, sp, tomega) result(y) real(DP) :: epsilon real(DP) :: dx real(DP) :: c -! ------------------------------------------------------------------------------ ! ! -- set smoothing interval if (present(tomega)) then diff --git a/src/Utilities/TimeSeries/TimeArray.f90 b/src/Utilities/TimeSeries/TimeArray.f90 index 49b7ee99e4c..0463d278d47 100644 --- a/src/Utilities/TimeSeries/TimeArray.f90 +++ b/src/Utilities/TimeSeries/TimeArray.f90 @@ -1,6 +1,5 @@ module TimeArrayModule - use BaseDisModule, only: DisBaseType use KindModule, only: DP, I4B use ListModule, only: ListType use SimVariablesModule, only: errmsg @@ -16,7 +15,9 @@ module TimeArrayModule ! -- Public members real(DP), public :: taTime real(DP), dimension(:), pointer, contiguous, public :: taArray => null() + contains + ! -- Public procedures ! -- When gfortran adds support for finalization, the ! following declaration could be: final :: finalize @@ -25,46 +26,59 @@ module TimeArrayModule contains - subroutine ConstructTimeArray(newTa, dis) -! ****************************************************************************** -! ConstructTimeArray -- construct time array -! Allocate and assign members of a new TimeArrayType object. -! Allocate space for the array so that this subroutine can be -! called repeatedly with the same array (but with different contents). -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Construct time array + !! + !! Allocate and assign members of a new TimeArrayType object. Allocate space + !! for the array so that this subroutine can be called repeatedly with the + !! same array (but with different contents). + !< + subroutine ConstructTimeArray(newTa, modelname) + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy type(TimeArrayType), pointer, intent(out) :: newTa - class(DisBaseType), pointer, intent(in) :: dis + character(len=*), intent(in) :: modelname ! -- local + integer(I4B), dimension(:), contiguous, & + pointer :: mshape + character(len=LENMEMPATH) :: mempath integer(I4B) :: isize -! ------------------------------------------------------------------------------ + ! + ! -- initialize + nullify (mshape) + ! + ! -- create mempath + mempath = create_mem_path(component=modelname, subcomponent='DIS') + ! + ! -- set mshape pointer + call mem_setptr(mshape, 'MSHAPE', mempath) ! ! Get dimensions for supported discretization type - if (dis%supports_layers()) then - isize = dis%get_ncpl() + if (size(mshape) == 2) then + isize = mshape(2) + else if (size(mshape) == 3) then + isize = mshape(2) * mshape(3) else errmsg = 'Time array series is not supported for discretization type' call store_error(errmsg, terminate=.TRUE.) end if + ! allocate (newTa) allocate (newTa%taArray(isize)) + ! + ! -- Return return end subroutine ConstructTimeArray + !> @brief Cast an unlimited polymorphic object as TimeArrayType + !< function CastAsTimeArrayType(obj) result(res) -! ****************************************************************************** -! ConstructTimeArray -- Cast an unlimited polymorphic object as TimeArrayType -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return type(TimeArrayType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -73,64 +87,55 @@ function CastAsTimeArrayType(obj) result(res) type is (TimeArrayType) res => obj end select + ! + ! -- Return return end function CastAsTimeArrayType + !> @brief Add a time array to a to list + !< subroutine AddTimeArrayToList(list, timearray) -! ****************************************************************************** -! AddTimeArrayToList -- add ta to list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list type(TimeArrayType), pointer, intent(inout) :: timearray ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => timearray call list%Add(obj) ! + ! -- Return return end subroutine AddTimeArrayToList + !> @brief Retrieve a time array from a list + !< function GetTimeArrayFromList(list, indx) result(res) -! ****************************************************************************** -! GetTimeArrayFromList -- get ta from list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: indx + ! -- return type(TimeArrayType), pointer :: res ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => list%GetItem(indx) res => CastAsTimeArrayType(obj) ! + ! -- Return return end function GetTimeArrayFromList + !> @brief Deallocate memory + !< subroutine ta_da(this) -! ****************************************************************************** -! ta_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArrayType) :: this -! ------------------------------------------------------------------------------ ! deallocate (this%taArray) this%taArray => null() ! + ! -- Return return end subroutine ta_da diff --git a/src/Utilities/TimeSeries/TimeArraySeries.f90 b/src/Utilities/TimeSeries/TimeArraySeries.f90 index 34119ffa65a..7c8c4607bbc 100644 --- a/src/Utilities/TimeSeries/TimeArraySeries.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeries.f90 @@ -3,8 +3,8 @@ module TimeArraySeriesModule use ArrayReadersModule, only: ReadArray use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & - LENTIMESERIESNAME, DZERO, DONE - use GenericUtilitiesModule, only: is_same + LENTIMESERIESNAME, LENMODELNAME, DZERO, DONE + use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile use KindModule, only: DP, I4B use ListModule, only: ListType, ListNodeType @@ -13,7 +13,6 @@ module TimeArraySeriesModule use TimeArrayModule, only: TimeArrayType, ConstructTimeArray, & AddTimeArrayToList, CastAsTimeArrayType, & GetTimeArrayFromList - use BaseDisModule, only: DisBaseType use, intrinsic :: iso_fortran_env, only: IOSTAT_END implicit none @@ -32,9 +31,11 @@ module TimeArraySeriesModule character(len=LINELENGTH), private :: dataFile = '' logical, private :: autoDeallocate = .true. type(ListType), pointer, private :: list => null() - class(DisBaseType), pointer, private :: dis => null() + character(len=LENMODELNAME) :: modelname type(BlockParserType), private :: parser + contains + ! -- Public procedures procedure, public :: tas_init procedure, public :: GetAverageValues @@ -53,20 +54,15 @@ module TimeArraySeriesModule ! -- Constructor for TimeArraySeriesType + !> @brief Allocate a new TimeArraySeriesType object. + !< subroutine ConstructTimeArraySeries(newTas, filename) -! ****************************************************************************** -! ConstructTimeArraySeries -- Allocate a new TimeArraySeriesType object. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(TimeArraySeriesType), pointer, intent(out) :: newTas character(len=*), intent(in) :: filename ! -- local logical :: lex -! ------------------------------------------------------------------------------ - ! formats + ! -- formats 10 format('Error: Time-array-series file "', a, '" does not exist.') ! ! -- Allocate a new object of type TimeArraySeriesType @@ -81,22 +77,19 @@ subroutine ConstructTimeArraySeries(newTas, filename) end if newTas%datafile = filename ! + ! -- Return return end subroutine ConstructTimeArraySeries ! -- Public procedures - subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) -! ****************************************************************************** -! tas_init -- initialize the time array series -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Initialize the time array series + !< + subroutine tas_init(this, fname, modelname, iout, tasname, autoDeallocate) ! -- dummy class(TimeArraySeriesType), intent(inout) :: this character(len=*), intent(in) :: fname - class(DisBaseType), pointer, intent(inout) :: dis + character(len=*), intent(in) :: modelname integer(I4B), intent(in) :: iout character(len=*), intent(inout) :: tasname logical, optional, intent(in) :: autoDeallocate @@ -106,7 +99,6 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) integer(I4B) :: inunit character(len=40) :: keyword, keyvalue logical :: found, continueread, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- initialize some variables if (present(autoDeallocate)) this%autoDeallocate = autoDeallocate @@ -114,7 +106,7 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) allocate (this%list) ! ! -- assign members - this%dis => dis + this%modelname = modelname this%iout = iout ! ! -- open time-array series input file @@ -213,17 +205,14 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) call this%parser%StoreErrorUnit() end if ! + ! -- Return return end subroutine tas_init + !> @brief Populate an array time-weighted average value for a specified time + !! span + !< subroutine GetAverageValues(this, nvals, values, time0, time1) -! ****************************************************************************** -! GetAverageValues -- populate an array time-weighted average value for a -! specified time span. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this integer(I4B), intent(in) :: nvals @@ -233,7 +222,6 @@ subroutine GetAverageValues(this, nvals, values, time0, time1) ! -- local integer(I4B) :: i real(DP) :: timediff -! ------------------------------------------------------------------------------ ! timediff = time1 - time0 if (timediff > 0) then @@ -246,36 +234,29 @@ subroutine GetAverageValues(this, nvals, values, time0, time1) call this%get_values_at_time(nvals, values, time0) end if ! + ! -- Return return end subroutine GetAverageValues + !> @brief Return unit number + !< function GetInunit(this) -! ****************************************************************************** -! GetInunit -- return unit number -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: GetInunit ! -- dummy class(TimeArraySeriesType) :: this -! ------------------------------------------------------------------------------ ! GetInunit = this%inunit ! + ! -- Return return end function GetInunit ! -- Private procedures + !> @brief Get surrounding records + !< subroutine get_surrounding_records(this, time, taEarlier, taLater) -! ****************************************************************************** -! get_surrounding_records -- get_surrounding_records -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this real(DP), intent(in) :: time @@ -288,7 +269,6 @@ subroutine get_surrounding_records(this, time, taEarlier, taLater) type(ListNodeType), pointer :: node1 => null() type(TimeArrayType), pointer :: ta => null(), ta0 => null(), ta1 => null() class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! taEarlier => null() taLater => null() @@ -361,38 +341,49 @@ subroutine get_surrounding_records(this, time, taEarlier, taLater) if (time0 <= time) taEarlier => ta0 if (time1 >= time) taLater => ta1 ! + ! -- Return return end subroutine get_surrounding_records + !> @brief Read next time array from input file and append to list + !< logical function read_next_array(this) -! ****************************************************************************** -! read_next_array -- Read next time array from input file and append to list. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy class(TimeArraySeriesType), intent(inout) :: this ! -- local - integer(I4B) :: i, ierr, istart, istat, istop, lloc, nrow, ncol, nodesperlayer + integer(I4B) :: i, ierr, istart, istat, istop, lloc, nrow, ncol, & + nodesperlayer logical :: lopen, isFound type(TimeArrayType), pointer :: ta => null() -! ------------------------------------------------------------------------------ + character(len=LENMEMPATH) :: mempath + integer(I4B), dimension(:), contiguous, pointer :: mshape ! + ! -- initialize istart = 1 istat = 0 istop = 1 lloc = 1 + nullify (mshape) + ! + ! -- create mempath + mempath = create_mem_path(component=this%modelname, subcomponent='DIS') + ! + ! -- set mshape pointer + call mem_setptr(mshape, 'MSHAPE', mempath) + ! ! Get dimensions for supported discretization type - if (this%dis%supports_layers()) then - nodesperlayer = this%dis%get_ncpl() - if (size(this%dis%mshape) == 3) then - nrow = this%dis%mshape(2) - ncol = this%dis%mshape(3) - else - nrow = 1 - ncol = this%dis%mshape(2) - end if + if (size(mshape) == 2) then + nodesperlayer = mshape(2) + nrow = 1 + ncol = mshape(2) + else if (size(mshape) == 3) then + nodesperlayer = mshape(2) * mshape(3) + nrow = mshape(2) + ncol = mshape(3) else errmsg = 'Time array series is not supported for selected & &discretization type.' @@ -403,7 +394,7 @@ logical function read_next_array(this) read_next_array = .false. inquire (unit=this%inunit, opened=lopen) if (lopen) then - call ConstructTimeArray(ta, this%dis) + call ConstructTimeArray(ta, this%modelname) ! -- read a time and an array from the input file ! -- Get a TIME block and read the time call this%parser%GetBlock('TIME', isFound, ierr, & @@ -412,7 +403,7 @@ logical function read_next_array(this) ta%taTime = this%parser%GetDouble() ! -- Read the array call ReadArray(this%parser%iuactive, ta%taArray, this%Name, & - this%dis%ndim, ncol, nrow, 1, nodesperlayer, & + size(mshape), ncol, nrow, 1, nodesperlayer, & this%iout, 0, 0) ! ! -- multiply values by sfac @@ -428,19 +419,15 @@ logical function read_next_array(this) call this%parser%terminateblock() end if end if - return ! Normal return ! + ! -- Return return end function read_next_array + !> @brief Return an array of values for a specified time, same units as + !! time-series values + !< subroutine get_values_at_time(this, nvals, values, time) -! ****************************************************************************** -! get_values_at_time -- Return an array of values for a specified time, same -! units as time-series values. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this integer(I4B), intent(in) :: nvals @@ -452,10 +439,9 @@ subroutine get_values_at_time(this, nvals, values, time) valdiff type(TimeArrayType), pointer :: taEarlier => null() type(TimeArrayType), pointer :: taLater => null() - ! formats + ! -- formats 10 format('Error getting array at time ', g10.3, & ' for time-array series "', a, '"') -! ------------------------------------------------------------------------------ ! ierr = 0 call this%get_surrounding_records(time, taEarlier, taLater) @@ -488,7 +474,7 @@ subroutine get_values_at_time(this, nvals, values, time) ierr = 1 end if else - if (is_same(taEarlier%taTime, time)) then + if (is_close(taEarlier%taTime, time)) then values = taEarlier%taArray else ! -- Only earlier time is available, and it is not time of interest; @@ -502,7 +488,7 @@ subroutine get_values_at_time(this, nvals, values, time) end if else if (associated(taLater)) then - if (is_same(taLater%taTime, time)) then + if (is_close(taLater%taTime, time)) then values = taLater%taArray else ! -- only later time is available, and it is not time of interest @@ -521,17 +507,15 @@ subroutine get_values_at_time(this, nvals, values, time) call store_error_unit(this%inunit) end if ! + ! -- Return return end subroutine get_values_at_time + !> @brief Populates an array with integrated values for a specified time span + !! + !! Units: (ts-value-unit)*time + !< subroutine get_integrated_values(this, nvals, values, time0, time1) -! ****************************************************************************** -! get_integrated_values -- Populates an array with integrated values for a -! specified time span. Units: (ts-value-unit)*time -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this integer(I4B), intent(in) :: nvals @@ -551,7 +535,6 @@ subroutine get_integrated_values(this, nvals, values, time0, time1) 10 format('Error encountered while performing integration', & ' for time-array series "', a, '" for time interval: ', & g12.5, ' to ', g12.5) -! ------------------------------------------------------------------------------ ! values = DZERO value = DZERO @@ -657,17 +640,14 @@ subroutine get_integrated_values(this, nvals, values, time0, time1) end if end if ! + ! -- Return return end subroutine get_integrated_values + !> @brief Deallocate fromNode and all previous nodes in list; + !! reassign firstNode + !< subroutine DeallocateBackward(this, fromNode) -! ****************************************************************************** -! DeallocateBackward -- Deallocate fromNode and all previous nodes in list; -! reassign firstNode. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this type(ListNodeType), pointer, intent(inout) :: fromNode @@ -677,7 +657,6 @@ subroutine DeallocateBackward(this, fromNode) type(ListNodeType), pointer :: prev => null() type(TimeArrayType), pointer :: ta => null() class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! if (associated(fromNode)) then ! -- reassign firstNode @@ -701,17 +680,14 @@ subroutine DeallocateBackward(this, fromNode) fromNode => null() end if ! + ! -- Return return end subroutine DeallocateBackward + !> @brief Return pointer to ListNodeType object for the node representing + !! the latest preceding time in the time series + !< subroutine get_latest_preceding_node(this, time, tslNode) -! ****************************************************************************** -! get_latest_preceding_node -- Return pointer to ListNodeType object for the -! node representing the latest preceding time in the time series -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this real(DP), intent(in) :: time @@ -723,7 +699,6 @@ subroutine get_latest_preceding_node(this, time, tslNode) type(TimeArrayType), pointer :: ta => null() type(TimeArrayType), pointer :: ta0 => null() class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! tslNode => null() if (associated(this%list%firstNode)) then @@ -742,7 +717,7 @@ subroutine get_latest_preceding_node(this, time, tslNode) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() ta => CastAsTimeArrayType(obj) - if (ta%taTime < time .or. is_same(ta%taTime, time)) then + if (ta%taTime < time .or. is_close(ta%taTime, time)) then currNode => currNode%nextNode else exit @@ -777,22 +752,18 @@ subroutine get_latest_preceding_node(this, time, tslNode) ! if (time0 <= time) tslNode => node0 ! + ! -- Return return end subroutine get_latest_preceding_node + !> @brief Deallocate memory + !< subroutine tas_da(this) -! ****************************************************************************** -! tas_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesType), intent(inout) :: this ! -- local integer :: i, n type(TimeArrayType), pointer :: ta => null() -! ------------------------------------------------------------------------------ ! ! -- Deallocate contents of each time array in list n = this%list%Count() @@ -805,23 +776,19 @@ subroutine tas_da(this) call this%list%Clear(.true.) deallocate (this%list) ! + ! -- Return return end subroutine tas_da ! -- Procedures not type-bound + !> @brief Cast an unlimited polymorphic object as class(TimeArraySeriesType) + !< function CastAsTimeArraySeriesType(obj) result(res) -! ****************************************************************************** -! CastAsTimeArraySeriesType -- Cast an unlimited polymorphic object as -! class(TimeArraySeriesType) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return type(TimeArraySeriesType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -831,27 +798,25 @@ function CastAsTimeArraySeriesType(obj) result(res) res => obj end select ! + ! -- Return return end function CastAsTimeArraySeriesType + !> @brief Get time array from list + !< function GetTimeArraySeriesFromList(list, indx) result(res) -! ****************************************************************************** -! GetTimeArraySeriesFromList -- get time array from list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list integer, intent(in) :: indx + ! -- return type(TimeArraySeriesType), pointer :: res ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => list%GetItem(indx) res => CastAsTimeArraySeriesType(obj) ! + ! -- Return return end function GetTimeArraySeriesFromList diff --git a/src/Utilities/TimeSeries/TimeArraySeriesLink.f90 b/src/Utilities/TimeSeries/TimeArraySeriesLink.f90 index 4e1bb7d7a01..c697315dc3b 100644 --- a/src/Utilities/TimeSeries/TimeArraySeriesLink.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeriesLink.f90 @@ -27,39 +27,33 @@ module TimeArraySeriesLinkModule real(DP), dimension(:), pointer, public :: BndArray => null() real(DP), dimension(:), pointer, public :: RMultArray => null() type(TimeArraySeriesType), pointer, public :: TimeArraySeries => null() + contains + procedure, public :: da => tasl_da end type TimeArraySeriesLinkType contains + !> @brief Deallocate + !< subroutine tasl_da(this) -! ****************************************************************************** -! tasl_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesLinkType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! this%nodelist => null() this%bndarray => null() this%rmultarray => null() this%TimeArraySeries => null() ! + ! -- Return return end subroutine tasl_da + !> @brief Construct a time series of arrays that are linked + !< subroutine ConstructTimeArraySeriesLink(newTasLink, timeArraySeries, & pkgName, bndArray, iprpak, text) -! ****************************************************************************** -! ConstructTimeArraySeriesLink -- construct -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(TimeArraySeriesLinkType), pointer, intent(out) :: newTasLink type(TimeArraySeriesType), pointer, intent(in) :: timeArraySeries @@ -69,7 +63,6 @@ subroutine ConstructTimeArraySeriesLink(newTasLink, timeArraySeries, & character(len=*), intent(in) :: text ! -- local character(len=LENPACKAGENAME) :: pkgNameTemp -! ------------------------------------------------------------------------------ ! allocate (newTasLink) ! Store package name as all caps @@ -81,20 +74,17 @@ subroutine ConstructTimeArraySeriesLink(newTasLink, timeArraySeries, & newTasLink%Iprpak = iprpak newTasLink%Text = text ! + ! -- Return return end subroutine ConstructTimeArraySeriesLink + !> @brief Cast an unlimited polymorphic object as TimeArraySeriesLinkType + !< function CastAsTimeArraySeriesLinkType(obj) result(res) -! ****************************************************************************** -! CastAsTimeArraySeriesLinkType -- Cast an unlimited polymorphic object as -! TimeArraySeriesLinkType -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return type(TimeArraySeriesLinkType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -104,47 +94,42 @@ function CastAsTimeArraySeriesLinkType(obj) result(res) res => obj end select ! + ! -- Return return end function CastAsTimeArraySeriesLinkType + !> @brief Add time-array series to list + !< subroutine AddTimeArraySeriesLinkToList(list, tasLink) -! ****************************************************************************** -! AddTimeArraySeriesLinkToList -- add to list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list + ! -- return type(TimeArraySeriesLinkType), pointer, intent(inout) :: tasLink ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => tasLink call list%Add(obj) ! + ! -- Return return end subroutine AddTimeArraySeriesLinkToList + !> @brief Get time-array series from a list and return + !< function GetTimeArraySeriesLinkFromList(list, idx) result(res) -! ****************************************************************************** -! GetTimeArraySeriesLinkFromList -- get from list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx + ! -- return type(TimeArraySeriesLinkType), pointer :: res ! -- local class(*), pointer :: obj -! ------------------------------------------------------------------------------ ! obj => list%GetItem(idx) res => CastAsTimeArraySeriesLinkType(obj) ! + ! -- Return return end function GetTimeArraySeriesLinkFromList diff --git a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 index 46040ca4cde..847126d0a0e 100644 --- a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 @@ -3,7 +3,7 @@ module TimeArraySeriesManagerModule use KindModule, only: DP, I4B use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO, LENTIMESERIESNAME, LINELENGTH, & - LENHUGELINE + LENHUGELINE, LENMODELNAME use ListModule, only: ListType use SimModule, only: store_error, store_error_unit use TdisModule, only: delt, totimc, kper, kstp @@ -22,13 +22,16 @@ module TimeArraySeriesManagerModule type TimeArraySeriesManagerType ! -- Public members integer(I4B), public :: iout = 0 ! output unit num - class(DisBaseType), pointer, public :: dis => null() ! pointer to dis + class(DisBaseType), pointer :: dis => null() ! pointer to dis + character(len=LENMODELNAME) :: modelname ! -- Private members type(ListType), pointer, private :: boundTasLinks => null() ! list of TAS links character(len=LINELENGTH), allocatable, dimension(:) :: tasfiles ! list of TA file names type(TimeArraySeriesType), dimension(:), pointer, contiguous :: taslist ! array of TA pointers character(len=LENTIMESERIESNAME), allocatable, dimension(:) :: tasnames ! array of TA names + contains + ! -- Public procedures procedure, public :: tasmanager_df procedure, public :: ad => tasmgr_ad @@ -49,41 +52,37 @@ module TimeArraySeriesManagerModule ! -- Public procedures - subroutine tasmanager_cr(this, dis, iout) -! ****************************************************************************** -! tasmanager_cr -- create the tasmanager -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + !> @brief Create the time-array series manager + !< + subroutine tasmanager_cr(this, dis, modelname, iout) ! -- dummy type(TimeArraySeriesManagerType) :: this - class(DisBaseType), pointer :: dis + class(DisBaseType), pointer, optional :: dis + character(len=*), intent(in) :: modelname integer(I4B), intent(in) :: iout -! ------------------------------------------------------------------------------ ! + if (present(dis)) then + this%dis => dis + end if + ! + this%modelname = modelname this%iout = iout - this%dis => dis allocate (this%boundTasLinks) allocate (this%tasfiles(0)) ! + ! -- Return return end subroutine tasmanager_cr + !> @brief Define the time-array series manager + !< subroutine tasmanager_df(this) -! ****************************************************************************** -! tasmanager_df -- define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this ! -- local type(TimeArraySeriesType), pointer :: tasptr => null() integer(I4B) :: nfiles integer(I4B) :: i -! ------------------------------------------------------------------------------ ! ! -- determine how many tasfiles. This is the number of time array series ! so allocate arrays to store them @@ -94,21 +93,19 @@ subroutine tasmanager_df(this) ! -- Setup a time array series for each file specified do i = 1, nfiles tasptr => this%taslist(i) - call tasptr%tas_init(this%tasfiles(i), this%dis, & + call tasptr%tas_init(this%tasfiles(i), this%modelname, & this%iout, this%tasnames(i)) end do ! + ! -- Return return end subroutine tasmanager_df + !> @brief Time step (or subtime step) advance. + !! + !! Call this each time step or subtime step. + !< subroutine tasmgr_ad(this) -! ****************************************************************************** -! tasmgr_ad -- time step (or subtime step) advance. -! Call this each time step or subtime step. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this ! -- local @@ -116,13 +113,12 @@ subroutine tasmgr_ad(this) type(TimeArraySeriesType), pointer :: timearrayseries => null() integer(I4B) :: i, j, nlinks, nvals, isize1, isize2, inunit real(DP) :: begintime, endtime - ! formats + ! -- formats character(len=*), parameter :: fmt5 = & "(/,'Time-array-series controlled arrays in stress period ', & &i0, ', time step ', i0, ':')" 10 format('"', a, '" package: ', a, ' array obtained from time-array series "', & a, '"') -! ------------------------------------------------------------------------------ ! ! -- Initialize time variables begintime = totimc @@ -189,22 +185,18 @@ subroutine tasmgr_ad(this) end do end if ! + ! -- Return return end subroutine tasmgr_ad + !> @brief Deallocate + !< subroutine tasmgr_da(this) -! ****************************************************************************** -! tasmgr_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this ! -- local integer :: i, n type(TimeArraySeriesLinkType), pointer :: tasLink => null() -! ------------------------------------------------------------------------------ ! ! -- Deallocate contents of each TimeArraySeriesType object in list ! of time-array series links. @@ -232,16 +224,13 @@ subroutine tasmgr_da(this) this%dis => null() this%boundTasLinks => null() ! + ! -- Return return end subroutine tasmgr_da + !> @brief Add a time-array series file + !< subroutine add_tasfile(this, fname) -! ****************************************************************************** -! add_tasfile -- add a tas file -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ArrayHandlersModule, only: ExpandArray ! -- dummy @@ -249,32 +238,27 @@ subroutine add_tasfile(this, fname) character(len=*), intent(in) :: fname ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! call ExpandArray(this%tasfiles, 1) indx = size(this%tasfiles) this%tasfiles(indx) = fname ! + ! -- Return return end subroutine add_tasfile + !> @brief Zero out arrays that are represented with time series + !! + !! Delete all existing links from time array series to package arrays as they + !! will need to be created with a new BEGIN PERIOD block + !< subroutine Reset(this, pkgName) -! ****************************************************************************** -! Reset -- zero out arrays that are represented with time series. -! Delete all existing links from time array series to package arrays as they -! will need to be created with a new BEGIN PERIOD block. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(TimeArraySeriesManagerType) :: this character(len=*), intent(in) :: pkgName ! -- local integer(I4B) :: i, j, nlinks type(TimeArraySeriesLinkType), pointer :: taslink -! ------------------------------------------------------------------------------ ! ! -- Reassign all linked elements to zero nlinks = this%boundTasLinks%Count() @@ -300,17 +284,14 @@ subroutine Reset(this, pkgName) end do end if ! + ! -- Return return end subroutine Reset + !> @brief Make link from time-array series to package array + !< subroutine MakeTasLink(this, pkgName, bndArray, iprpak, & tasName, text, convertFlux, nodelist, inunit) -! ****************************************************************************** -! MakeTasLink -- Make link from TAS to package array -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this character(len=*), intent(in) :: pkgName @@ -326,7 +307,6 @@ subroutine MakeTasLink(this, pkgName, bndArray, iprpak, & character(LINELENGTH) :: ermsg type(TimeArraySeriesLinkType), pointer :: newTasLink type(TimeArraySeriesType), pointer :: tasptr => null() -! ------------------------------------------------------------------------------ ! ! -- Find the time array series nfiles = size(this%tasnames) @@ -355,22 +335,18 @@ subroutine MakeTasLink(this, pkgName, bndArray, iprpak, & ! -- Add link to list of links call this%tasmgr_add_link(newTasLink) ! + ! -- Return return end subroutine MakeTasLink + !> @brief Get link from the boundtaslinks list + !< function GetLink(this, indx) result(tasLink) -! ****************************************************************************** -! GetLink -- get link from the boundtaslinks list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this integer(I4B), intent(in) :: indx + ! -- return type(TimeArraySeriesLinkType), pointer :: tasLink - ! -- local -! ------------------------------------------------------------------------------ ! tasLink => null() ! @@ -378,21 +354,17 @@ function GetLink(this, indx) result(tasLink) tasLink => GetTimeArraySeriesLinkFromList(this%boundTasLinks, indx) end if ! + ! -- Return return end function GetLink + !> @brief Count number of links in the boundtaslinks list + !< function CountLinks(this) -! ****************************************************************************** -! CountLinks -- count number of links in the boundtaslinks list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: CountLinks ! -- dummy class(TimeArraySeriesManagerType) :: this -! ------------------------------------------------------------------------------ ! if (associated(this%boundtaslinks)) then CountLinks = this%boundTasLinks%Count() @@ -400,26 +372,30 @@ function CountLinks(this) CountLinks = 0 end if ! + ! -- Return return end function CountLinks ! -- Private procedures + !> @brief Convert the array from a flux to a flow rate by multiplying by the + !! cell area + !< subroutine tasmgr_convert_flux(this, tasLink) -! ****************************************************************************** -! tasmgr_convert_flux -- convert the array from a flux to a flow rate by -! multiplying by the cell area -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this type(TimeArraySeriesLinkType), pointer, intent(inout) :: tasLink ! -- local integer(I4B) :: i, n, noder real(DP) :: area -! ------------------------------------------------------------------------------ + ! + if (.not. (associated(this%dis) .and. & + associated(tasLink%nodelist))) then + errmsg = 'Programming error. Cannot convert flux. Verify that '& + &'a valid DIS instance and nodelist were provided.' + call store_error(errmsg) + call store_error_unit(tasLink%TimeArraySeries%GetInunit()) + end if ! n = size(tasLink%BndArray) do i = 1, n @@ -430,24 +406,21 @@ subroutine tasmgr_convert_flux(this, tasLink) end if end do ! + ! -- Return return end subroutine tasmgr_convert_flux + !> @brief Add a time arrays series link + !< subroutine tasmgr_add_link(this, tasLink) -! ****************************************************************************** -! tasmgr_add_link -- add a time arrays series link -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeArraySeriesManagerType) :: this type(TimeArraySeriesLinkType), pointer :: tasLink ! -- local -! ------------------------------------------------------------------------------ ! call AddTimeArraySeriesLinkToList(this%boundTasLinks, tasLink) ! + ! -- Return return end subroutine tasmgr_add_link diff --git a/src/Utilities/TimeSeries/TimeSeries.f90 b/src/Utilities/TimeSeries/TimeSeries.f90 index fa9af784796..b4a5d9d48f2 100644 --- a/src/Utilities/TimeSeries/TimeSeries.f90 +++ b/src/Utilities/TimeSeries/TimeSeries.f90 @@ -5,7 +5,7 @@ module TimeSeriesModule use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & LINEAREND, LENTIMESERIESNAME, LENHUGELINE, & DZERO, DONE, DNODATA - use GenericUtilitiesModule, only: is_same + use MathUtilModule, only: is_close use InputOutputModule, only: GetUnit, openfile, ParseLine, upcase use ListModule, only: ListType, ListNodeType use SimVariablesModule, only: errmsg @@ -31,7 +31,9 @@ module TimeSeriesModule logical, public :: autoDeallocate = .true. type(ListType), pointer, private :: list => null() class(TimeSeriesFileType), pointer, private :: tsfile => null() + contains + ! -- Public procedures procedure, public :: AddTimeSeriesRecord procedure, public :: Clear @@ -66,7 +68,9 @@ module TimeSeriesModule type(TimeSeriesType), dimension(:), & pointer, contiguous, public :: timeSeries => null() type(BlockParserType), pointer, public :: parser + contains + ! -- Public procedures procedure, public :: Count procedure, public :: Initializetsfile @@ -85,35 +89,26 @@ module TimeSeriesModule ! -- non-type-bound procedures + !> @brief Construct time series file + !< subroutine ConstructTimeSeriesFile(newTimeSeriesFile) -! ****************************************************************************** -! ConstructTimeSeriesFile -- construct ts tsfile -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(TimeSeriesFileType), pointer, intent(inout) :: newTimeSeriesFile -! ------------------------------------------------------------------------------ ! allocate (newTimeSeriesFile) allocate (newTimeSeriesFile%parser) + ! + ! -- Return return end subroutine ConstructTimeSeriesFile + !> @brief Cast an unlimited polymorphic object as class(TimeSeriesFileType) + !< function CastAsTimeSeriesFileType(obj) result(res) -! ****************************************************************************** -! CastAsTimeSeriesFileType -- Cast an unlimited polymorphic object as -! class(TimeSeriesFileType) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(*), pointer, intent(inout) :: obj ! -- return type(TimeSeriesFileType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -122,22 +117,18 @@ function CastAsTimeSeriesFileType(obj) result(res) type is (TimeSeriesFileType) res => obj end select + ! + ! -- Return return end function CastAsTimeSeriesFileType + !> @brief Cast an unlimited polymorphic object as class(TimeSeriesFileType) + !< function CastAsTimeSeriesFileClass(obj) result(res) -! ****************************************************************************** -! CastAsTimeSeriesFileClass -- Cast an unlimited polymorphic object as -! class(TimeSeriesFileType) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(*), pointer, intent(inout) :: obj ! -- return type(TimeSeriesFileType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (.not. associated(obj)) return @@ -146,43 +137,37 @@ function CastAsTimeSeriesFileClass(obj) result(res) class is (TimeSeriesFileType) res => obj end select + ! + ! -- Return return end function CastAsTimeSeriesFileClass + !> @brief Add time series file to list + !< subroutine AddTimeSeriesFileToList(list, tsfile) -! ****************************************************************************** -! AddTimeSeriesFileToList -- add to list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list class(TimeSeriesFileType), pointer, intent(inout) :: tsfile ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => tsfile call list%Add(obj) ! + ! -- Return return end subroutine AddTimeSeriesFileToList + !> @brief Get time series from list + !< function GetTimeSeriesFileFromList(list, idx) result(res) -! ****************************************************************************** -! GetTimeSeriesFileFromList -- get from list -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: idx + ! -- return type(TimeSeriesFileType), pointer :: res ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => list%GetItem(idx) res => CastAsTimeSeriesFileType(obj) @@ -191,24 +176,21 @@ function GetTimeSeriesFileFromList(list, idx) result(res) res => CastAsTimeSeriesFileClass(obj) end if ! + ! -- Return return end function GetTimeSeriesFileFromList + !> @brief Compare two time series; if they are identical, return true + !< function SameTimeSeries(ts1, ts2) result(same) -! ****************************************************************************** -! SameTimeSeries -- Compare two time series; if they are identical, return true. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(TimeSeriesType), intent(in) :: ts1 type(TimeSeriesType), intent(in) :: ts2 + ! -- return logical :: same ! -- local integer :: i, n1, n2 type(TimeSeriesRecordType), pointer :: tsr1, tsr2 -! ------------------------------------------------------------------------------ ! same = .false. n1 = ts1%list%Count() @@ -227,23 +209,21 @@ function SameTimeSeries(ts1, ts2) result(same) ! same = .true. ! + ! -- Return return end function SameTimeSeries ! Type-bound procedures of TimeSeriesType + !> @brief Get time series value + !! + !! If iMethod is STEPWISE or LINEAR: + !! Return a time-weighted average value for a specified time span. + !! If iMethod is LINEAREND: + !! Return value at time1. Time0 argument is ignored. + !! Units: (ts-value-unit) + !< function GetValue(this, time0, time1, extendToEndOfSimulation) -! ****************************************************************************** -! GetValue -- get ts value -! If iMethod is STEPWISE or LINEAR: -! Return a time-weighted average value for a specified time span. -! If iMethod is LINEAREND: -! Return value at time1. Time0 argument is ignored. -! Units: (ts-value-unit) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: GetValue ! -- dummy @@ -251,9 +231,8 @@ function GetValue(this, time0, time1, extendToEndOfSimulation) real(DP), intent(in) :: time0 real(DP), intent(in) :: time1 logical, intent(in), optional :: extendToEndOfSimulation - ! + ! -- local logical :: extend -! ------------------------------------------------------------------------------ ! if (present(extendToEndOfSimulation)) then extend = extendToEndOfSimulation @@ -268,17 +247,15 @@ function GetValue(this, time0, time1, extendToEndOfSimulation) GetValue = this%get_value_at_time(time1, extend) end select ! + ! -- Return return end function GetValue + !> @brief Initialize time series + !! + !! Open time-series file and read options and first time-series record. + !< subroutine initialize_time_series(this, tsfile, name, autoDeallocate) -! ****************************************************************************** -! initialize_time_series -- initialize time series -! Open time-series file and read options and first time-series record. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this class(TimeSeriesFileType), target :: tsfile @@ -286,7 +263,6 @@ subroutine initialize_time_series(this, tsfile, name, autoDeallocate) logical, intent(in), optional :: autoDeallocate ! -- local character(len=LENTIMESERIESNAME) :: tsNameTemp -! ------------------------------------------------------------------------------ ! ! -- Assign the time-series tsfile, name, and autoDeallocate this%tsfile => tsfile @@ -308,16 +284,13 @@ subroutine initialize_time_series(this, tsfile, name, autoDeallocate) call store_error(errmsg, terminate=.TRUE.) end if ! + ! -- Return return end subroutine initialize_time_series + !> @brief Get surrounding records + !< subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) -! ****************************************************************************** -! get_surrounding_records -- get surrounding records -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this real(DP), intent(in) :: time @@ -331,7 +304,6 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) type(TimeSeriesRecordType), pointer :: tsr => null(), tsrec0 => null() type(TimeSeriesRecordType), pointer :: tsrec1 => null() class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! tsrecEarlier => null() tsrecLater => null() @@ -347,7 +319,7 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .and. .not. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .and. .not. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -384,7 +356,7 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) obj => tsNode1%GetItem() tsrec1 => CastAsTimeSeriesRecordType(obj) time1 = tsrec1%tsrTime - do while (time1 < time .and. .not. is_same(time1, time)) + do while (time1 < time .and. .not. is_close(time1, time)) if (associated(tsNode1%nextNode)) then tsNode1 => tsNode1%nextNode obj => tsNode1%GetItem() @@ -401,21 +373,19 @@ subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater) ! end if ! - if (time0 < time .or. is_same(time0, time)) tsrecEarlier => tsrec0 - if (time1 > time .or. is_same(time1, time)) tsrecLater => tsrec1 + if (time0 < time .or. is_close(time0, time)) tsrecEarlier => tsrec0 + if (time1 > time .or. is_close(time1, time)) tsrecLater => tsrec1 ! + ! -- Return return end subroutine get_surrounding_records + !> @brief Get surrounding nodes + !! + !! This subroutine is for working with time series already entirely stored + !! in memory -- it does not read data from a file. + !< subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) -! ****************************************************************************** -! get_surrounding_nodes -- get surrounding nodes -! This subroutine is for working with time series already entirely stored -! in memory -- it does not read data from a file. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this real(DP), intent(in) :: time @@ -431,7 +401,6 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) type(TimeSeriesRecordType), pointer :: tsrecEarlier type(TimeSeriesRecordType), pointer :: tsrecLater class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! tsrecEarlier => null() tsrecLater => null() @@ -449,7 +418,7 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .and. .not. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .and. .not. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -485,7 +454,7 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) obj => tsNode1%GetItem() tsrec1 => CastAsTimeSeriesRecordType(obj) time1 = tsrec1%tsrTime - do while (time1 < time .and. .not. is_same(time1, time)) + do while (time1 < time .and. .not. is_close(time1, time)) if (associated(tsNode1%nextNode)) then tsNode1 => tsNode1%nextNode obj => tsNode1%GetItem() @@ -498,30 +467,26 @@ subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater) ! end if ! - if (time0 < time .or. is_same(time0, time)) then + if (time0 < time .or. is_close(time0, time)) then tsrecEarlier => tsrec0 nodeEarlier => tsNode0 end if - if (time1 > time .or. is_same(time1, time)) then + if (time1 > time .or. is_close(time1, time)) then tsrecLater => tsrec1 nodeLater => tsNode1 end if ! + ! -- Return return end subroutine get_surrounding_nodes + !> @brief Read next record + !! + !! Read next time-series record from input file + !< logical function read_next_record(this) -! ****************************************************************************** -! read_next_record -- read next record -! Read next time-series record from input file. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- If we have already encountered the end of the TIMESERIES block, do not try to read any further if (this%tsfile%finishedReading) then @@ -533,18 +498,16 @@ logical function read_next_record(this) if (.not. read_next_record) then this%tsfile%finishedReading = .true. end if - return ! + ! -- Return + return end function read_next_record + !> @brief Get value for a time + !! + !! Return a value for a specified time, same units as time-series values + !< function get_value_at_time(this, time, extendToEndOfSimulation) -! ****************************************************************************** -! get_value_at_time -- get value for a time -! Return a value for a specified time, same units as time-series values. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: get_value_at_time ! -- dummy @@ -559,7 +522,6 @@ function get_value_at_time(this, time, extendToEndOfSimulation) type(TimeSeriesRecordType), pointer :: tsrLater => null() ! -- formats 10 format('Error getting value at time ', g10.3, ' for time series "', a, '"') -! ------------------------------------------------------------------------------ ! ierr = 0 call this%get_surrounding_records(time, tsrEarlier, tsrLater) @@ -590,7 +552,7 @@ function get_value_at_time(this, time, extendToEndOfSimulation) ierr = 1 end if else - if (extendToEndOfSimulation .or. is_same(tsrEarlier%tsrTime, time)) then + if (extendToEndOfSimulation .or. is_close(tsrEarlier%tsrTime, time)) then get_value_at_time = tsrEarlier%tsrValue else ! -- Only earlier time is available, and it is not time of interest; @@ -604,7 +566,7 @@ function get_value_at_time(this, time, extendToEndOfSimulation) end if else if (associated(tsrLater)) then - if (is_same(tsrLater%tsrTime, time)) then + if (is_close(tsrLater%tsrTime, time)) then get_value_at_time = tsrLater%tsrValue else ! -- only later time is available, and it is not time of interest @@ -622,18 +584,16 @@ function get_value_at_time(this, time, extendToEndOfSimulation) call store_error(errmsg, terminate=.TRUE.) end if ! + ! -- Return return end function get_value_at_time + !> @brief Get integrated value + !! + !! Return an integrated value for a specified time span. + !! Units: (ts-value-unit)*time + !< function get_integrated_value(this, time0, time1, extendToEndOfSimulation) -! ****************************************************************************** -! get_integrated_value -- get integrated value -! Return an integrated value for a specified time span. -! Units: (ts-value-unit)*time -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: get_integrated_value ! -- dummy @@ -653,7 +613,6 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) ! -- formats 10 format('Error encountered while performing integration', & ' for time series "', a, '" for time interval: ', g12.5, ' to ', g12.5) -! ------------------------------------------------------------------------------ ! value = DZERO ldone = .false. @@ -665,7 +624,7 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) currObj => currNode%GetItem() currRecord => CastAsTimeSeriesRecordType(currObj) currTime = currRecord%tsrTime - if (is_same(currTime, time1)) then + if (is_close(currTime, time1)) then ! Current node time = time1 so should be ldone ldone = .true. elseif (currTime < time1) then @@ -698,12 +657,12 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) if (lprocess) then ! -- determine lower and upper limits of time span of interest ! within current interval - if (currTime > time0 .or. is_same(currTime, time0)) then + if (currTime > time0 .or. is_close(currTime, time0)) then t0 = currTime else t0 = time0 end if - if (nextTime < time1 .or. is_same(nextTime, time1)) then + if (nextTime < time1 .or. is_close(nextTime, time1)) then t1 = nextTime else t1 = time1 @@ -738,7 +697,7 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) ! -- Are we done yet? if (t1 > time1) then ldone = .true. - elseif (is_same(t1, time1)) then + elseif (is_close(t1, time1)) then ldone = .true. else ! -- We are not done yet @@ -763,18 +722,17 @@ function get_integrated_value(this, time0, time1, extendToEndOfSimulation) end if end if end if + ! + ! -- Return return end function get_integrated_value + !> @brief Get average value + !! + !! Return a time-weighted average value for a specified time span. + !! Units: (ts-value-unit) + !< function get_average_value(this, time0, time1, extendToEndOfSimulation) -! ****************************************************************************** -! get_average_value -- get average value -! Return a time-weighted average value for a specified time span. -! Units: (ts-value-unit) -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return real(DP) :: get_average_value ! -- dummy @@ -784,7 +742,6 @@ function get_average_value(this, time0, time1, extendToEndOfSimulation) logical, intent(in) :: extendToEndOfSimulation ! -- local real(DP) :: timediff, value, valueIntegrated -! ------------------------------------------------------------------------------ ! timediff = time1 - time0 if (timediff > 0) then @@ -801,18 +758,16 @@ function get_average_value(this, time0, time1, extendToEndOfSimulation) end if get_average_value = value ! + ! -- Return return end function get_average_value + !> @brief Get latest preceding node + !! + !! Return pointer to ListNodeType object for the node representing the + !! latest preceding time in the time series + !< subroutine get_latest_preceding_node(this, time, tslNode) -! ****************************************************************************** -! get_latest_preceding_node -- get latest preceding node -! Return pointer to ListNodeType object for the node -! representing the latest preceding time in the time series -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this real(DP), intent(in) :: time @@ -824,7 +779,6 @@ subroutine get_latest_preceding_node(this, time, tslNode) type(TimeSeriesRecordType), pointer :: tsr => null() type(TimeSeriesRecordType), pointer :: tsrec0 => null() class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! tslNode => null() if (associated(this%list%firstNode)) then @@ -842,7 +796,7 @@ subroutine get_latest_preceding_node(this, time, tslNode) if (associated(currNode%nextNode)) then obj => currNode%nextNode%GetItem() tsr => CastAsTimeSeriesRecordType(obj) - if (tsr%tsrTime < time .or. is_same(tsr%tsrTime, time)) then + if (tsr%tsrTime < time .or. is_close(tsr%tsrTime, time)) then currNode => currNode%nextNode else exit @@ -875,64 +829,52 @@ subroutine get_latest_preceding_node(this, time, tslNode) end do end if ! - if (time0 < time .or. is_same(time0, time)) tslNode => tsNode0 + if (time0 < time .or. is_close(time0, time)) tslNode => tsNode0 ! + ! -- Return return end subroutine get_latest_preceding_node + !> @brief Deallocate + !< subroutine ts_da(this) -! ****************************************************************************** -! ts_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! if (associated(this%list)) then call this%list%Clear(.true.) deallocate (this%list) end if ! + ! -- Return return end subroutine ts_da + !> @brief Add ts record + !< subroutine AddTimeSeriesRecord(this, tsr) -! ****************************************************************************** -! AddTimeSeriesRecord -- add ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this type(TimeSeriesRecordType), pointer, intent(inout) :: tsr ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => tsr call this%list%Add(obj) ! + ! -- Return return end subroutine AddTimeSeriesRecord + !> @brief Get current ts record + !< function GetCurrentTimeSeriesRecord(this) result(res) -! ****************************************************************************** -! GetCurrentTimeSeriesRecord -- get current ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this - ! result + ! -- result type(TimeSeriesRecordType), pointer :: res ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => null() res => null() @@ -941,23 +883,19 @@ function GetCurrentTimeSeriesRecord(this) result(res) res => CastAsTimeSeriesRecordType(obj) end if ! + ! -- Return return end function GetCurrentTimeSeriesRecord + !> @brief Get previous ts record + !< function GetPreviousTimeSeriesRecord(this) result(res) -! ****************************************************************************** -! GetPreviousTimeSeriesRecord -- get previous ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this - ! result + ! -- result type(TimeSeriesRecordType), pointer :: res ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => null() res => null() @@ -966,23 +904,19 @@ function GetPreviousTimeSeriesRecord(this) result(res) res => CastAsTimeSeriesRecordType(obj) end if ! + ! -- Return return end function GetPreviousTimeSeriesRecord + !> @brief Get next ts record + !< function GetNextTimeSeriesRecord(this) result(res) -! ****************************************************************************** -! GetNextTimeSeriesRecord -- get next ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this - ! result + ! -- result type(TimeSeriesRecordType), pointer :: res ! -- local class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! obj => null() res => null() @@ -991,32 +925,28 @@ function GetNextTimeSeriesRecord(this) result(res) res => CastAsTimeSeriesRecordType(obj) end if ! + ! -- Return return end function GetNextTimeSeriesRecord + !> @brief Get ts record + !< function GetTimeSeriesRecord(this, time, epsi) result(res) -! ****************************************************************************** -! GetTimeSeriesRecord -- get ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this double precision, intent(in) :: time double precision, intent(in) :: epsi - ! result + ! -- result type(TimeSeriesRecordType), pointer :: res ! -- local type(TimeSeriesRecordType), pointer :: tsr -! ------------------------------------------------------------------------------ ! call this%list%Reset() res => null() do tsr => this%GetNextTimeSeriesRecord() if (associated(tsr)) then - if (is_same(tsr%tsrTime, time)) then + if (is_close(tsr%tsrTime, time)) then res => tsr exit end if @@ -1026,32 +956,25 @@ function GetTimeSeriesRecord(this, time, epsi) result(res) end if end do ! + ! -- Return return end function GetTimeSeriesRecord + !> @brief Reset + !< subroutine Reset(this) -! ****************************************************************************** -! Reset -- reset -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType) :: this -! ------------------------------------------------------------------------------ ! call this%list%Reset() ! + ! -- Return return end subroutine Reset + !> @brief Insert a time series record + !< subroutine InsertTsr(this, tsr) -! ****************************************************************************** -! InsertTsr -- insert ts record -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this type(TimeSeriesRecordType), pointer, intent(inout) :: tsr @@ -1060,7 +983,6 @@ subroutine InsertTsr(this, tsr) type(TimeSeriesRecordType), pointer :: tsrEarlier, tsrLater type(ListNodeType), pointer :: nodeEarlier, nodeLater class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ ! badtime = -9.0d30 time0 = badtime @@ -1128,25 +1050,22 @@ subroutine InsertTsr(this, tsr) end if end if ! + ! -- Return return end subroutine InsertTsr + !> @brief Find latest time + !< function FindLatestTime(this, readToEnd) result(endtime) -! ****************************************************************************** -! FindLatestTime -- find latest time -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this logical, intent(in), optional :: readToEnd ! -- local integer :: nrecords - double precision :: endtime type(TimeSeriesRecordType), pointer :: tsr class(*), pointer :: obj => null() -! ------------------------------------------------------------------------------ + ! -- return + double precision :: endtime ! ! -- If the caller requested the very last time in the series (readToEnd is true), check that we have first read all records if (present(readToEnd)) then @@ -1161,78 +1080,65 @@ function FindLatestTime(this, readToEnd) result(endtime) tsr => CastAsTimeSeriesRecordType(obj) endtime = tsr%tsrTime ! + ! -- Return return end function FindLatestTime + !> @brief Clear the list of time series records + !< subroutine Clear(this, destroy) -! ****************************************************************************** -! Clear -- Clear the list of time series records -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesType), intent(inout) :: this logical, optional, intent(in) :: destroy -! ------------------------------------------------------------------------------ ! call this%list%Clear(destroy) ! + ! -- Return return end subroutine Clear ! Type-bound procedures of TimeSeriesFileType + !> @brief Count number of time series + !< function Count(this) -! ****************************************************************************** -! Count --count number of time series -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: Count ! -- dummy class(TimeSeriesFileType) :: this -! ------------------------------------------------------------------------------ ! if (associated(this%timeSeries)) then Count = size(this%timeSeries) else Count = 0 end if + ! + ! -- Return return end function Count + !> @brief Get time series + !< function GetTimeSeries(this, indx) result(res) -! ****************************************************************************** -! GetTimeSeries -- get ts -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesFileType) :: this integer(I4B), intent(in) :: indx - ! result + ! -- return type(TimeSeriesType), pointer :: res -! ------------------------------------------------------------------------------ ! res => null() if (indx > 0 .and. indx <= this%nTimeSeries) then res => this%timeSeries(indx) end if + ! + ! -- Return return end function GetTimeSeries + !> @brief Open time-series tsfile file and read options and first record, + !! which may contain data to define multiple time series. + !< subroutine Initializetsfile(this, filename, iout, autoDeallocate) -! ****************************************************************************** -! Initializetsfile -- Open time-series tsfile file and read options and first -! record, which may contain data to define multiple time series. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesFileType), target, intent(inout) :: this character(len=*), intent(in) :: filename @@ -1248,7 +1154,6 @@ subroutine Initializetsfile(this, filename, iout, autoDeallocate) character(len=40) :: keyword, keyvalue character(len=:), allocatable :: line character(len=LENTIMESERIESNAME), allocatable, dimension(:) :: words -! ------------------------------------------------------------------------------ ! ! -- Initialize some variables if (present(autoDeallocate)) autoDeallocateLocal = autoDeallocate @@ -1435,16 +1340,12 @@ subroutine Initializetsfile(this, filename, iout, autoDeallocate) call this%parser%StoreErrorUnit() end if ! + ! -- Return return end subroutine Initializetsfile + !> @brief Read time series file line logical function read_tsfile_line(this) -! ****************************************************************************** -! read_tsfile_line -- read tsfile line -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesFileType), intent(inout) :: this ! -- local @@ -1452,7 +1353,6 @@ logical function read_tsfile_line(this) integer(I4B) :: i logical :: endOfBlock type(TimeSeriesRecordType), pointer :: tsRecord => null() -! ------------------------------------------------------------------------------ ! read_tsfile_line = .false. ! @@ -1479,22 +1379,18 @@ logical function read_tsfile_line(this) end do tsloop read_tsfile_line = .true. ! + ! -- Return return end function read_tsfile_line + !> @brief Deallocate memory + !< subroutine tsf_da(this) -! ****************************************************************************** -! tsf_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesFileType), intent(inout) :: this ! -- local integer :: i, n type(TimeSeriesType), pointer :: ts => null() -! ------------------------------------------------------------------------------ ! n = this%Count() do i = 1, n @@ -1508,6 +1404,7 @@ subroutine tsf_da(this) deallocate (this%timeSeries) deallocate (this%parser) ! + ! -- Return return end subroutine tsf_da diff --git a/src/Utilities/TimeSeries/TimeSeriesFileList.f90 b/src/Utilities/TimeSeries/TimeSeriesFileList.f90 index f0dbd3a8f42..c7706af86cb 100644 --- a/src/Utilities/TimeSeries/TimeSeriesFileList.f90 +++ b/src/Utilities/TimeSeries/TimeSeriesFileList.f90 @@ -17,7 +17,9 @@ module TimeSeriesFileListModule ! -- Public members integer(I4B), public :: numtsfiles = 0 type(ListType), public :: tsfileList + contains + ! -- Public procedures procedure, public :: Add procedure, public :: Counttsfiles @@ -46,10 +48,11 @@ subroutine Add(this, filename, iout, tsfile) call ConstructTimeSeriesFile(tsf) tsfile => tsf call tsfile%Initializetsfile(filename, iout, .true.) - ! ! -- Add the time-series tsfile to the list call this%add_time_series_tsfile(tsfile) + ! + ! -- Return return end subroutine Add @@ -57,9 +60,10 @@ subroutine Clear(this) implicit none ! -- dummy class(TimeSeriesFileListType), intent(inout) :: this - ! -- local ! call this%tsfileList%Clear() + ! + ! -- Return return end subroutine Clear @@ -72,6 +76,8 @@ function Counttsfiles(this) ! Counttsfiles = this%tsfileList%Count() ! + ! + ! -- Return return end function Counttsfiles @@ -94,6 +100,7 @@ function CountTimeSeries(this) end if end do ! + ! -- Return return end function CountTimeSeries @@ -102,11 +109,12 @@ function Gettsfile(this, indx) result(res) ! -- dummy class(TimeSeriesFileListType) :: this integer(I4B), intent(in) :: indx - ! result + ! -- return type(TimeSeriesFileType), pointer :: res - ! -- local ! res => GetTimeSeriesFileFromList(this%tsfileList, indx) + ! + ! -- Return return end function Gettsfile @@ -117,10 +125,11 @@ subroutine add_time_series_tsfile(this, tsfile) ! -- dummy class(TimeSeriesFileListType), intent(inout) :: this class(TimeSeriesFileType), pointer, intent(inout) :: tsfile - ! -- local ! call AddTimeSeriesFileToList(this%tsfileList, tsfile) this%numtsfiles = this%numtsfiles + 1 + ! + ! -- Return return end subroutine add_time_series_tsfile @@ -139,6 +148,8 @@ subroutine tsfl_da(this) ! call this%tsfileList%Clear(.true.) ! + ! + ! -- Return return end subroutine tsfl_da diff --git a/src/Utilities/TimeSeries/TimeSeriesLink.f90 b/src/Utilities/TimeSeries/TimeSeriesLink.f90 index 6379be6daf6..16e5db971d4 100644 --- a/src/Utilities/TimeSeries/TimeSeriesLink.f90 +++ b/src/Utilities/TimeSeries/TimeSeriesLink.f90 @@ -37,6 +37,8 @@ module TimeSeriesLinkModule contains + !> @brief Construct time series link + !< subroutine ConstructTimeSeriesLink(newTsLink, timeSeries, pkgName, & auxOrBnd, bndElem, iRow, jCol, iprpak, & text) @@ -70,13 +72,17 @@ subroutine ConstructTimeSeriesLink(newTsLink, timeSeries, pkgName, & newTsLink%Text = text end if ! + ! -- Return return end subroutine ConstructTimeSeriesLink + !> @brief Cast an unlimited polymorphic object as TimeSeriesLinkType + !< function CastAsTimeSeriesLinkType(obj) result(res) - ! Cast an unlimited polymorphic object as TimeSeriesLinkType implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return type(TimeSeriesLinkType), pointer :: res ! res => null() @@ -88,14 +94,19 @@ function CastAsTimeSeriesLinkType(obj) result(res) class default continue end select + ! + ! -- Return return end function CastAsTimeSeriesLinkType + !> @brief Get time series link from a list + !< function GetTimeSeriesLinkFromList(list, indx) result(tsLink) implicit none ! -- dummy type(ListType), intent(inout) :: list integer(I4B), intent(in) :: indx + ! -- return type(TimeSeriesLinkType), pointer :: tsLink ! -- local class(*), pointer :: obj @@ -104,9 +115,12 @@ function GetTimeSeriesLinkFromList(list, indx) result(tsLink) obj => list%GetItem(indx) tsLink => CastAsTimeSeriesLinkType(obj) ! + ! -- Return return end function GetTimeSeriesLinkFromList + !> @brief Add time series link to a list + !< subroutine AddTimeSeriesLinkToList(list, tslink) implicit none ! -- dummy @@ -118,6 +132,7 @@ subroutine AddTimeSeriesLinkToList(list, tslink) obj => tslink call list%Add(obj) ! + ! -- Return return end subroutine AddTimeSeriesLinkToList diff --git a/src/Utilities/TimeSeries/TimeSeriesManager.f90 b/src/Utilities/TimeSeries/TimeSeriesManager.f90 index 157564a863f..412cae25ce3 100644 --- a/src/Utilities/TimeSeries/TimeSeriesManager.f90 +++ b/src/Utilities/TimeSeries/TimeSeriesManager.f90 @@ -38,7 +38,9 @@ module TimeSeriesManagerModule type(HashTableType), pointer, private :: BndTsHashTable => null() ! hash of ts to tsobj type(TimeSeriesContainerType), allocatable, dimension(:), & private :: TsContainers + contains + ! -- Public procedures procedure, public :: tsmanager_df procedure, public :: ad => tsmgr_ad @@ -55,20 +57,15 @@ module TimeSeriesManagerModule contains + !> @brief Create the tsmanager + !< subroutine tsmanager_cr(this, iout, removeTsLinksOnCompletion, & extendTsToEndOfSimulation) -! ****************************************************************************** -! tsmanager_cr -- create the tsmanager -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy type(TimeSeriesManagerType) :: this integer(I4B), intent(in) :: iout logical, intent(in), optional :: removeTsLinksOnCompletion logical, intent(in), optional :: extendTsToEndOfSimulation -! ------------------------------------------------------------------------------ ! this%iout = iout if (present(removeTsLinksOnCompletion)) then @@ -82,36 +79,27 @@ subroutine tsmanager_cr(this, iout, removeTsLinksOnCompletion, & allocate (this%tsfileList) allocate (this%tsfiles(1000)) ! + ! -- Return return end subroutine tsmanager_cr + !> @brief Define time series manager object + !< subroutine tsmanager_df(this) -! ****************************************************************************** -! tsmanager_df -- define -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(TimeSeriesManagerType) :: this -! ------------------------------------------------------------------------------ ! if (this%numtsfiles > 0) then call this%HashBndTimeSeries() end if ! - ! -- return + ! -- Return return end subroutine tsmanager_df + !> @brief Add a time series file to this manager + !< subroutine add_tsfile(this, fname, inunit) -! ****************************************************************************** -! add_tsfile -- add a time series file to this manager -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimModule, only: store_error, store_error_unit use ArrayHandlersModule, only: ExpandArray @@ -123,7 +111,6 @@ subroutine add_tsfile(this, fname, inunit) integer(I4B) :: isize integer(I4B) :: i class(TimeSeriesFileType), pointer :: tsfile => null() -! ------------------------------------------------------------------------------ ! ! -- Check for fname duplicates if (this%numtsfiles > 0) then @@ -146,17 +133,14 @@ subroutine add_tsfile(this, fname, inunit) ! -- call this%tsfileList%Add(fname, this%iout, tsfile) ! + ! -- Return return end subroutine add_tsfile + !> @brief Time step (or subtime step) advance. Call this each time step or + !! subtime step + !< subroutine tsmgr_ad(this) -! ****************************************************************************** -! tsmgr_ad -- time step (or subtime step) advance. Call this each time step or -! subtime step. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType) :: this ! -- local @@ -165,7 +149,7 @@ subroutine tsmgr_ad(this) integer(I4B) :: i, nlinks, nauxlinks real(DP) :: begintime, endtime, tsendtime character(len=LENPACKAGENAME + 2) :: pkgID - ! formats + ! -- formats character(len=*), parameter :: fmt5 = & "(/,'Time-series controlled values in stress period: ', i0, & &', time step ', i0, ':')" @@ -177,7 +161,6 @@ subroutine tsmgr_ad(this) ' value from time series "', a, '" = ', g12.5) 25 format(a, ' package: Boundary ', i0, ', ', a, & ' value from time series "', a, '" = ', g12.5, ' (', a, ')') -! ------------------------------------------------------------------------------ ! ! -- Initialize time variables begintime = totimc @@ -323,20 +306,16 @@ subroutine tsmgr_ad(this) end if end if ! + ! -- Return return end subroutine tsmgr_ad + !> @brief Deallocate memory + !< subroutine tsmgr_da(this) -! ****************************************************************************** -! tsmgr_da -- deallocate -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- Deallocate time-series links in boundTsLinks call this%boundTsLinks%Clear(.true.) @@ -357,24 +336,21 @@ subroutine tsmgr_da(this) ! deallocate (this%tsfiles) ! + ! -- Return return end subroutine tsmgr_da + !> @brief Call this when a new BEGIN PERIOD block is read for a new stress + !! period + !< subroutine Reset(this, pkgName) -! ****************************************************************************** -! reset -- Call this when a new BEGIN PERIOD block is read for a new stress -! period. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType) :: this character(len=*), intent(in) :: pkgName ! -- local integer(I4B) :: i, nlinks type(TimeSeriesLinkType), pointer :: tslink -! ------------------------------------------------------------------------------ + ! ! Zero out values for time-series controlled stresses. ! Also deallocate all tslinks too. ! Then when time series are @@ -412,17 +388,14 @@ subroutine Reset(this, pkgName) end if end do ! + ! -- Return return end subroutine Reset + !> @brief Make link + !< subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, & irow, jcol, iprpak, tsLink, text, bndName) -! ****************************************************************************** -! make_link -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType), intent(inout) :: this type(TimeSeriesType), pointer, intent(inout) :: timeSeries @@ -434,8 +407,6 @@ subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, & type(TimeSeriesLinkType), pointer, intent(inout) :: tsLink character(len=*), intent(in) :: text character(len=*), intent(in) :: bndName - ! -- local -! ------------------------------------------------------------------------------ ! tsLink => null() call ConstructTimeSeriesLink(tsLink, timeSeries, pkgName, & @@ -452,16 +423,13 @@ subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, & tsLink%BndName = bndName end if ! + ! -- Return return end subroutine make_link + !> @brief Get link + !< function GetLink(this, auxOrBnd, indx) result(tsLink) -! ****************************************************************************** -! GetLink -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType) :: this character(len=3), intent(in) :: auxOrBnd @@ -469,7 +437,6 @@ function GetLink(this, auxOrBnd, indx) result(tsLink) type(TimeSeriesLinkType), pointer :: tsLink ! -- local type(ListType), pointer :: list -! ------------------------------------------------------------------------------ ! list => null() tsLink => null() @@ -485,22 +452,18 @@ function GetLink(this, auxOrBnd, indx) result(tsLink) tsLink => GetTimeSeriesLinkFromList(list, indx) end if ! + ! -- Return return end function GetLink + !> @brief Count links + !< function CountLinks(this, auxOrBnd) -! ****************************************************************************** -! CountLinks -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- return integer(I4B) :: CountLinks ! -- dummy class(TimeSeriesManagerType) :: this character(len=3), intent(in) :: auxOrBnd -! ------------------------------------------------------------------------------ ! CountLinks = 0 if (auxOrBnd == 'BND') then @@ -509,16 +472,13 @@ function CountLinks(this, auxOrBnd) CountLinks = this%auxvarTsLinks%count() end if ! + ! -- Return return end function CountLinks + !> @brief Get time series + !< function get_time_series(this, name) result(res) -! ****************************************************************************** -! get_time_series -- -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType) :: this character(len=*), intent(in) :: name @@ -526,35 +486,29 @@ function get_time_series(this, name) result(res) type(TimeSeriesType), pointer :: res ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! Get index from hash table, get time series from TsContainers, ! and assign result to time series contained in link. res => null() - indx = this%BndTsHashTable%get_index(name) + indx = this%BndTsHashTable%get(name) if (indx > 0) then res => this%TsContainers(indx)%timeSeries end if ! + ! -- Return return end function get_time_series + !> @brief Store all boundary (stress) time series links in TsContainers + !! and construct hash table BndTsHashTable + !< subroutine HashBndTimeSeries(this) -! ****************************************************************************** -! HashBndTimeSeries -- -! Store all boundary (stress) time series links in -! TsContainers and construct hash table BndTsHashTable. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(TimeSeriesManagerType), intent(inout) :: this ! -- local integer(I4B) :: i, j, k, numtsfiles, numts character(len=LENTIMESERIESNAME) :: name type(TimeSeriesFileType), pointer :: tsfile => null() -! ------------------------------------------------------------------------------ ! ! Initialize the hash table call hash_table_cr(this%BndTsHashTable) @@ -575,25 +529,21 @@ subroutine HashBndTimeSeries(this) this%TsContainers(k)%timeSeries => tsfile%GetTimeSeries(j) if (associated(this%TsContainers(k)%timeSeries)) then name = this%TsContainers(k)%timeSeries%Name - call this%BndTsHashTable%add_entry(name, k) + call this%BndTsHashTable%add(name, k) end if end do end do ! + ! -- Return return end subroutine HashBndTimeSeries ! -- Non-type-bound procedures + !> @brief Call this subroutine if the time-series link is available or needed + !< subroutine read_value_or_time_series(textInput, ii, jj, bndElem, pkgName, & auxOrBnd, tsManager, iprpak, tsLink) -! ****************************************************************************** -! read_value_or_time_series -- -! Call this subroutine if the time-series link is available or needed. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy character(len=*), intent(in) :: textInput integer(I4B), intent(in) :: ii @@ -612,7 +562,6 @@ subroutine read_value_or_time_series(textInput, ii, jj, bndElem, pkgName, & character(len=LINELENGTH) :: errmsg character(len=LENTIMESERIESNAME) :: tsNameTemp logical :: found -! ------------------------------------------------------------------------------ ! read (textInput, *, iostat=istat) r if (istat == 0) then @@ -658,30 +607,28 @@ subroutine read_value_or_time_series(textInput, ii, jj, bndElem, pkgName, & call store_error(errmsg) end if end if + ! + ! -- Return + return end subroutine read_value_or_time_series + !> @brief Call this subroutine from advanced packages to define timeseries + !! link for a variable (varName). + !! + !! Arguments are as follows: + !! textInput : string that is either a float or a string name + !! ii : column number + !! jj : row number + !! bndElem : pointer to a position in an array in package pkgName + !! pkgName : package name + !! auxOrBnd : 'AUX' or 'BND' keyword + !! tsManager : timeseries manager object for package + !! iprpak : integer flag indicating if interpolated timeseries values + !! should be printed to package iout during TsManager%ad() + !! varName : variable name + !< subroutine read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, & auxOrBnd, tsManager, iprpak, varName) -! ****************************************************************************** -! read_value_or_time_series_adv -- Call this subroutine from advanced -! packages to define timeseries link for a variable (varName). -! -! -- Arguments are as follows: -! textInput : string that is either a float or a string name -! ii : column number -! jj : row number -! bndElem : pointer to a position in an array in package pkgName -! pkgName : package name -! auxOrBnd : 'AUX' or 'BND' keyword -! tsManager : timeseries manager object for package -! iprpak : integer flag indicating if interpolated timeseries values -! should be printed to package iout during TsManager%ad() -! varName : variable name -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy character(len=*), intent(in) :: textInput integer(I4B), intent(in) :: ii @@ -700,7 +647,6 @@ subroutine read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, & logical :: found type(TimeSeriesType), pointer :: timeseries => null() type(TimeSeriesLinkType), pointer :: tsLink => null() -! ------------------------------------------------------------------------------ ! ! -- attempt to read textInput as a real value read (textInput, *, iostat=istat) v @@ -751,28 +697,26 @@ subroutine read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, & call store_error(errmsg) end if end if + ! + ! -- Return return end subroutine read_value_or_time_series_adv -! + ! -- private subroutines + + !> @brief Remove an existing timeseries link if it is defined. + !! + !! Arguments are as follows: + !! tsManager : timeseries manager object for package + !! ii : column number + !! jj : row number + !! pkgName : package name + !! auxOrBnd : 'AUX' or 'BND' keyword + !! varName : variable name + !< function remove_existing_link(tsManager, ii, jj, & pkgName, auxOrBnd, varName) result(found) -! ****************************************************************************** -! remove_existing_link -- remove an existing timeseries link if it is defined. -! -! -- Arguments are as follows: -! tsManager : timeseries manager object for package -! ii : column number -! jj : row number -! pkgName : package name -! auxOrBnd : 'AUX' or 'BND' keyword -! varName : variable name -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return variable + ! -- return logical :: found ! -- dummy type(TimeSeriesManagerType), intent(inout) :: tsManager @@ -786,7 +730,6 @@ function remove_existing_link(tsManager, ii, jj, & integer(I4B) :: nlinks integer(I4B) :: removeLink type(TimeSeriesLinkType), pointer :: tslTemp => null() -! ------------------------------------------------------------------------------ ! ! -- determine if link exists nlinks = tsManager%CountLinks(auxOrBnd) @@ -818,25 +761,20 @@ function remove_existing_link(tsManager, ii, jj, & end if end if ! - ! -- return + ! -- Return return end function remove_existing_link + !> @brief Determine if a timeseries link with varName is defined. + !! + !! Arguments are as follows: + !! tsManager : timeseries manager object for package + !! pkgName : package name + !! varName : variable name + !! auxOrBnd : optional 'AUX' or 'BND' keyword + !< function var_timeseries(tsManager, pkgName, varName, auxOrBnd) result(tsexists) -! ****************************************************************************** -! var_timeseries -- determine if a timeseries link with varName is defined. -! -! -- Arguments are as follows: -! tsManager : timeseries manager object for package -! pkgName : package name -! varName : variable name -! auxOrBnd : optional 'AUX' or 'BND' keyword -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return variable + ! -- return logical :: tsexists ! -- dummy type(TimeSeriesManagerType), intent(inout) :: tsManager @@ -848,7 +786,6 @@ function var_timeseries(tsManager, pkgName, varName, auxOrBnd) result(tsexists) integer(I4B) :: i integer(I4B) :: nlinks type(TimeSeriesLinkType), pointer :: tslTemp => null() -! ------------------------------------------------------------------------------ ! ! -- process optional variables if (present(auxOrBnd)) then @@ -874,7 +811,7 @@ function var_timeseries(tsManager, pkgName, varName, auxOrBnd) result(tsexists) end if end do csearchlinks ! - ! -- return + ! -- Return return end function var_timeseries diff --git a/src/Utilities/TimeSeries/TimeSeriesRecord.f90 b/src/Utilities/TimeSeries/TimeSeriesRecord.f90 index 8bfb1bc735c..17f6f6d35ca 100644 --- a/src/Utilities/TimeSeries/TimeSeriesRecord.f90 +++ b/src/Utilities/TimeSeries/TimeSeriesRecord.f90 @@ -15,22 +15,29 @@ module TimeSeriesRecordModule contains + !> @brief Allocate and assign members of a new TimeSeriesRecordType object + !< subroutine ConstructTimeSeriesRecord(newTsRecord, time, value) - ! Allocate and assign members of a new TimeSeriesRecordType object implicit none + ! -- dummy type(TimeSeriesRecordType), pointer, intent(out) :: newTsRecord real(DP), intent(in) :: time, value ! allocate (newTsRecord) newTsRecord%tsrTime = time newTsRecord%tsrValue = value + ! + ! -- Return return end subroutine ConstructTimeSeriesRecord + !> @brief Cast an unlimited polymorphic object as TimeSeriesRecordType + !< function CastAsTimeSeriesRecordType(obj) result(res) - ! Cast an unlimited polymorphic object as TimeSeriesRecordType implicit none + ! -- dummy class(*), pointer, intent(inout) :: obj + ! -- return type(TimeSeriesRecordType), pointer :: res ! res => null() @@ -40,9 +47,13 @@ function CastAsTimeSeriesRecordType(obj) result(res) type is (TimeSeriesRecordType) res => obj end select + ! + ! -- Return return end function CastAsTimeSeriesRecordType + !> @brief Add time series record to list + !< subroutine AddTimeSeriesRecordToList(list, tsrecord) implicit none ! -- dummy @@ -54,6 +65,7 @@ subroutine AddTimeSeriesRecordToList(list, tsrecord) obj => tsrecord call list%Add(obj) ! + ! -- Return return end subroutine AddTimeSeriesRecordToList diff --git a/src/Utilities/Timer.f90 b/src/Utilities/Timer.f90 index bac77230997..55c92761d17 100644 --- a/src/Utilities/Timer.f90 +++ b/src/Utilities/Timer.f90 @@ -2,7 +2,7 @@ module TimerModule use KindModule, only: DP, I4B use ConstantsModule, only: LINELENGTH, DZERO - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message implicit none private public :: print_start_time @@ -32,7 +32,7 @@ subroutine print_start_time() ! -- Get current date and time, assign to IBDT, and write to screen call date_and_time(values=ibdt) write (line, fmtdt) (ibdt(i), i=1, 3), (ibdt(i), i=5, 7) - call sim_message(line, skipafter=1) + call write_message(line, skipafter=1) ! ! -- return return @@ -69,11 +69,11 @@ SUBROUTINE elapsed_time(iout, iprtim) ! ! -- write elapsed time to stdout write (line, fmtdt) (IEDT(I), I=1, 3), (IEDT(I), I=5, 7) - call sim_message(line, skipbefore=1) + call write_message(line, skipbefore=1) ! ! -- write elapsted time to iout IF (IPRTIM .GT. 0) THEN - call sim_message(line, iunit=iout, skipbefore=1) + call write_message(line, iunit=iout, skipbefore=1) END IF ! ! Calculate elapsed time in days and seconds @@ -145,7 +145,7 @@ SUBROUTINE elapsed_time(iout, iprtim) WRITE (line, 1040) NSECS, MSECS 1040 FORMAT(1X, 'Elapsed run time: ', I2, '.', I3.3, ' Seconds') END IF - call sim_message(line, skipafter=1) + call write_message(line, skipafter=1) ! ! Write times to file if requested IF (IPRTIM .GT. 0) THEN diff --git a/src/Utilities/comarg.f90 b/src/Utilities/comarg.f90 index d8379d8888c..eaab198aab5 100644 --- a/src/Utilities/comarg.f90 +++ b/src/Utilities/comarg.f90 @@ -9,8 +9,8 @@ module CommandArguments use SimVariablesModule, only: istdout, isim_level, & simfile, simlstfile, simstdout, & isim_mode, simulation_mode - use GenericUtilitiesModule, only: sim_message, write_message use SimModule, only: store_error, ustop + use MessageModule, only: write_message, write_message_counter use InputOutputModule, only: upcase, getunit ! implicit none @@ -144,25 +144,25 @@ subroutine GetCommandLineArguments() lstop = .TRUE. write (line, '(2a,2(1x,a))') & trim(adjustl(cexe)), ':', trim(adjustl(VERSION)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-DEV', '--DEVELOP') lstop = .TRUE. write (line, '(2a,g0)') & trim(adjustl(cexe)), ': develop version ', ltyp - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-C', '--COMPILER') lstop = .TRUE. call get_compiler(compiler) write (line, '(2a,1x,a)') & trim(adjustl(cexe)), ':', trim(adjustl(compiler)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-S', '--SILENT') write (line, '(2a,1x,a)') & trim(adjustl(cexe)), ':', 'all screen output sent to mfsim.stdout' - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-D', '--DISCLAIMER') lstop = .TRUE. - call sim_message('', fmt=FMTDISCLAIMER) + call write_message('', fmt=FMTDISCLAIMER) case ('-P', '--PARALLEL') simulation_mode = 'PARALLEL' case ('-LIC', '--LICENSE') @@ -171,7 +171,7 @@ subroutine GetCommandLineArguments() case ('-CO', '--COMPILER-OPT') lstop = .TRUE. call get_compile_options(coptions) - call write_message(coptions, skipbefore=1, skipafter=1) + call write_message_counter(coptions, skipbefore=1, skipafter=1) case ('-L', '--LEVEL') if (len_trim(clevel) < 1) then iarg = iarg + 1 @@ -195,7 +195,7 @@ subroutine GetCommandLineArguments() write (line, '(2a,2(1x,a))') & trim(adjustl(cexe)), ':', 'stdout output level', & trim(adjustl(clevel)) - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case ('-M', '--MODE') if (len_trim(cmode) < 1) then iarg = iarg + 1 @@ -217,7 +217,7 @@ subroutine GetCommandLineArguments() trim(adjustl(cmode))//'. Model input will be checked for all '// & 'stress periods but the matrix equations will not be '// & 'assembled or solved.' - call write_message(line, skipbefore=1, skipafter=1) + call write_message_counter(line, skipbefore=1, skipafter=1) case default lstop = .TRUE. call write_usage(trim(adjustl(header)), trim(adjustl(cexe))) @@ -246,7 +246,7 @@ subroutine GetCommandLineArguments() ! ! -- write blank line to stdout if (icountcmd > 0) then - call sim_message('') + call write_message('') end if ! ! -- return @@ -296,16 +296,16 @@ subroutine write_usage(header, cexe) &'[1] https://github.com/MODFLOW-USGS/modflow6/issues',/)" ! ! -- write command line usage information to the screen - call sim_message(header) + call write_message(header) write (line, '(a,1x,a,15x,a,2(1x,a),2a)') & 'usage:', cexe, 'run MODFLOW', trim(adjustl(MFVNAM)), & 'using "', trim(adjustl(simfile)), '"' - call sim_message(line) + call write_message(line) write (line, '(a,1x,a,1x,a,5x,a)') & ' or:', cexe, '[options]', & 'retrieve program information' - call sim_message(line) - call sim_message('', fmt=OPTIONSFMT) + call write_message(line) + call write_message('', fmt=OPTIONSFMT) ! ! -- return return diff --git a/src/Utilities/defmacro.F90 b/src/Utilities/defmacro.F90 index eef048079ec..c998b904bad 100644 --- a/src/Utilities/defmacro.F90 +++ b/src/Utilities/defmacro.F90 @@ -4,7 +4,7 @@ module DefinedMacros use ConstantsModule, only: OSUNDEF, OSLINUX, OSMAC, OSWIN implicit none private - public :: get_os, is_pro, using_petsc + public :: get_os, is_extended, using_petsc, using_netcdf contains !> @brief Get operating system @@ -48,33 +48,47 @@ function get_os() result(ios) return end function get_os - !> @brief Determine if this is the professional version + !> @brief Determine if this is the extended version !! !! Function to get a logical indicating if this is the - !! professional version of MODFLOW. + !! extended version of MODFLOW. !! - !! @return ispro pro version logical + !! @return isextended extended version logical !< - function is_pro() result(ispro) + function is_extended() result(isextended) + ! -- return variables + logical(LGP) :: isextended !< extended version logical ! -- local variables - logical(LGP) :: ispro !< pro version logical + logical(LGP) :: ispetsc + logical(LGP) :: isnetcdf + ! + ! -- initialize isextended + isextended = .FALSE. ! ! -- check if using petsc - ispro = using_petsc() + ispetsc = using_petsc() + ! + ! -- check if using netcf + isnetcdf = using_netcdf() + ! + ! + if (ispetsc .EQV. .TRUE. .OR. isnetcdf .EQV. .TRUE.) then + isextended = .TRUE. + end if ! ! return return - end function is_pro + end function is_extended !> @brief Determine if using petsc !! !! Function to get a logical indicating if petsc is !! being used. !! - !! @return petscavail petsc used logical + !! @return petscused petsc used logical !< function using_petsc() result(petscused) - ! -- local variables + ! -- return variable logical(LGP) :: petscused !< petsc used logical ! ! -- initialize petscavail @@ -89,4 +103,27 @@ function using_petsc() result(petscused) return end function using_petsc + !> @brief Determine if using netcdf + !! + !! Function to get a logical indicating if netcdf is + !! being used. + !! + !! @return netcdfused netcdf used logical + !< + function using_netcdf() result(netcdfused) + ! -- return variable + logical(LGP) :: netcdfused !< netcdf used logical + ! + ! -- initialize petscavail + netcdfused = .FALSE. + ! + ! -- set operating system variables +#ifdef __WITH_NETCDF__ + netcdfused = .TRUE. +#endif + ! + ! return + return + end function using_netcdf + end module DefinedMacros diff --git a/src/Utilities/genericutils.f90 b/src/Utilities/genericutils.f90 deleted file mode 100644 index 549e3476d17..00000000000 --- a/src/Utilities/genericutils.f90 +++ /dev/null @@ -1,413 +0,0 @@ -!> @brief This module contains generic utilties -!! -!! This module contains generic utilities that have -!! limited dependencies. -!! -!< -module GenericUtilitiesModule - use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: MAXCHARLEN, LENHUGELINE, & - DZERO, DPREC, DSAME, & - LINELENGTH, LENHUGELINE, VSUMMARY - use SimVariablesModule, only: istdout, isim_level - ! - implicit none - - private - - public :: sim_message - public :: write_message - public :: write_centered - public :: is_same - public :: stop_with_error - -contains - - !> @brief Write simulation message - !! - !! Subroutine to print message to user specified iunit or STDOUT based on level. - !! - !< - subroutine sim_message(message, iunit, fmt, level, & - skipbefore, skipafter, advance) - ! -- dummy variables - character(len=*), intent(in) :: message !< message to write to iunit - integer(I4B), intent(in), optional :: iunit !< optional file unit to write the message to (default=stdout) - character(len=*), intent(in), optional :: fmt !< optional format to write the message (default='(a)') - integer(I4B), intent(in), optional :: level !< optional level for the message (default=summary) - integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) - integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) - logical(LGP), intent(in), optional :: advance !< optional boolean indicating if advancing output (default is .TRUE.) - ! -- local variables - character(len=3) :: cadvance - integer(I4B) :: i - integer(I4B) :: ilen - integer(I4B) :: iu - integer(I4B) :: ilevel - character(len=LENHUGELINE) :: simfmt - character(len=*), parameter :: stdfmt = '(a)' - character(len=*), parameter :: emptyfmt = '()' - ! - ! -- initialize local variables - ilen = len_trim(message) - ! - ! -- process optional dummy variables - if (present(iunit)) then - iu = iunit - else - iu = istdout - end if - if (present(fmt)) then - simfmt = fmt - else - if (ilen > 0) then - simfmt = stdfmt - else - simfmt = emptyfmt - end if - end if - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - if (present(advance)) then - if (advance) then - cadvance = 'YES' - else - cadvance = 'NO' - end if - else - cadvance = 'YES' - end if - ! - ! -- write empty line before message - if (present(skipbefore)) then - do i = 1, skipbefore - write (iu, *) - end do - end if - ! - ! -- write message if the level of the message is less than - ! or equal the isim_level for the simulation - if (ilevel <= isim_level) then - if (ilen > 0) then - write (iu, trim(simfmt), advance=cadvance) message(1:ilen) - else - write (iu, trim(simfmt), advance=cadvance) - end if - end if - ! - ! -- write empty line after message - if (present(skipafter)) then - do i = 1, skipafter - write (iu, *) - end do - end if - ! - ! -- return - return - end subroutine sim_message - - !> @brief Write messages - !! - !! Subroutine that formats and writes a single message that - !! may exceeed 78 characters in length. Messages longer than - !! 78 characters are written across multiple lines. When a - !! counter is passed in subsequent lines are indented. - !! - !< - subroutine write_message(message, icount, iwidth, iunit, level, & - skipbefore, skipafter) - ! -- dummy variables - character(len=*), intent(in) :: message !< message to be written - integer(I4B), intent(in), optional :: icount !< counter to prepended to the message - integer(I4B), intent(in), optional :: iwidth !< maximum width of the prepended counter - integer(I4B), intent(in), optional :: iunit !< the unit number to which the message is written - integer(I4B), intent(in), optional :: level !< level of message (VSUMMARY, VALL, VDEBUG) - integer(I4B), intent(in), optional :: skipbefore !< optional number of empty lines before message (default=0) - integer(I4B), intent(in), optional :: skipafter !< optional number of empty lines after message (default=0) - ! -- local variables - integer(I4B), parameter :: len_line = 78 - character(len=LENHUGELINE) :: amessage - character(len=len_line) :: line - character(len=16) :: cfmt - character(len=10) :: counter - character(len=5) :: fmt_first - character(len=20) :: fmt_cont - logical(LGP) :: include_counter - integer(I4B) :: isb - integer(I4B) :: isa - integer(I4B) :: jend - integer(I4B) :: len_str1 - integer(I4B) :: len_str2 - integer(I4B) :: len_message - integer(I4B) :: junit - integer(I4B) :: ilevel - integer(I4B) :: i - integer(I4B) :: j - ! - ! -- return if no message is passed - if (len_trim(message) < 1) then - return - end if - ! - ! -- initialize local variables - amessage = message - counter = '' - fmt_first = '(A)' - fmt_cont = '(A)' - len_str1 = 0 - len_str2 = len_line - include_counter = .FALSE. - junit = istdout - j = 0 - ! - ! -- process optional dummy variables - ! -- set the unit number - if (present(iunit)) then - if (iunit > 0) then - junit = iunit - end if - end if - ! - ! -- set the message level - if (present(level)) then - ilevel = level - else - ilevel = VSUMMARY - end if - ! - ! -- set skip before - if (present(skipbefore)) then - isb = skipbefore - else - isb = 0 - end if - ! - ! -- set skip after - if (present(skipafter)) then - isa = skipafter - else - isa = 0 - end if - ! - ! -- create the counter to prepend to the start of the message, - ! formats, and variables used to create strings - if (present(iwidth) .and. present(icount)) then - include_counter = .TRUE. - ! -- write counter - write (cfmt, '(A,I0,A)') '(1x,i', iwidth, ',".",1x)' - write (counter, cfmt) icount - ! -- calculate the length of the first and second string on a line - len_str1 = len(trim(counter)) + 1 - len_str2 = len_line - len_str1 - ! -- write format for the continuation lines - write (fmt_cont, '(a,i0,a)') & - '(', len(trim(counter)) + 1, 'x,a)' - end if - ! - ! -- calculate the length of the message - len_message = len_trim(amessage) - ! - ! -- parse the amessage into multiple lines -5 continue - jend = j + len_str2 - if (jend >= len_message) go to 100 - do i = jend, j + 1, -1 - if (amessage(i:i) .eq. ' ') then - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:i) - else - line = amessage(j + 1:i) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb) - else - line = adjustl(amessage(j + 1:i)) - call sim_message(line, iunit=junit, & - fmt=fmt_cont, level=ilevel) - end if - j = i - go to 5 - end if - end do - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:jend) - else - line = amessage(j + 1:jend) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb) - else - line = amessage(j + 1:jend) - call sim_message(line, iunit=junit, & - fmt=fmt_cont, level=ilevel) - end if - j = jend - go to 5 - ! - ! -- last piece of amessage to write to a line -100 continue - jend = len_message - if (j == 0) then - if (include_counter) then - line = counter(1:len_str1)//amessage(j + 1:jend) - else - line = amessage(j + 1:jend) - end if - call sim_message(line, iunit=junit, & - fmt=fmt_first, level=ilevel, & - skipbefore=isb, skipafter=isa) - else - line = amessage(j + 1:jend) - call sim_message(line, iunit=junit, fmt=fmt_cont, & - level=ilevel, & - skipafter=isa) - end if - ! - ! -- return - return - end subroutine write_message - - !> @brief Write centered text - !! - !! Subroutine to write text to unit iunit centered in width defined by linelen. - !! Left-pad with blanks as needed. - !! - !< - subroutine write_centered(text, linelen, iunit) - ! -- dummy variables - character(len=*), intent(in) :: text !< message to write to iunit - integer(I4B), intent(in) :: linelen !< length of line to center text in - integer(I4B), intent(in), optional :: iunit !< optional file unit to write text (default=stdout) - ! -- local variables - character(len=linelen) :: line - character(len=linelen) :: blank - integer(I4B) :: iu - integer(I4B) :: len_message - integer(I4B) :: jend - integer(I4B) :: ipad - integer(I4B) :: i - integer(I4B) :: j - ! - ! -- process optional parameters - if (present(iunit)) then - iu = iunit - else - iu = istdout - end if - ! - ! -- process text - if (iu > 0) then - ! - ! -- initialize local variables - blank = '' - len_message = len_trim(adjustl(text)) - j = 0 - ! - ! -- parse the amessage into multiple lines -5 continue - jend = j + linelen - if (jend >= len_message) go to 100 - do i = jend, j + 1, -1 - if (text(i:i) .eq. ' ') then - line = text(j + 1:i) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - j = i - go to 5 - end if - end do - line = text(j + 1:jend) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - j = jend - go to 5 - ! - ! -- last piece of amessage to write to a line -100 continue - jend = len_message - line = text(j + 1:jend) - ipad = ((linelen - len_trim(line)) / 2) - call sim_message(blank(1:ipad)//line, iunit=iu) - end if - ! - ! -- return - return - end subroutine write_centered - - !> @brief Function to determine if two reals are the same - !! - !! Function to evaluate if the difference between a and b are less than eps - !! (i.e. a and b are the same). - !! - !< - function is_same(a, b, eps) result(lvalue) - ! -- return variable - logical(LGP) :: lvalue !< boolean indicating if a and b are the same - ! -- dummy variables - real(DP), intent(in) :: a !< first number to evaluate - real(DP), intent(in) :: b !< second number to evaluate - real(DP), intent(in), optional :: eps !< optional maximum difference between a abd b (default=DSAME) - ! -- local variables - real(DP) :: epsloc - real(DP) :: denom - real(DP) :: rdiff - ! - ! -- evaluate optioanl arguments - if (present(eps)) then - epsloc = eps - else - epsloc = DSAME - end if - lvalue = .FALSE. - if (a == b) then - lvalue = .TRUE. - else - if (abs(b) > abs(a)) then - denom = b - else - denom = a - if (abs(denom) == DZERO) then - denom = DPREC - end if - end if - rdiff = abs((a - b) / denom) - if (rdiff <= epsloc) then - lvalue = .TRUE. - end if - end if - ! - ! -- return - return - end function is_same - - !> @brief Subroutine to stop the program - !! - !! Subroutine to stop the program and issue the correct return code. - !! - !< - subroutine stop_with_error(ierr) - ! -- dummy variables - integer(I4B), intent(in), optional :: ierr !< optional error code to return (default=0) - ! -- local variables - integer(I4B) :: ireturn_err - ! - ! -- process optional dummy variables - if (present(ierr)) then - ireturn_err = ierr - else - ireturn_err = 0 - end if - - ! -- return the correct return code - call exit(ireturn_err) - - end subroutine stop_with_error - -end module GenericUtilitiesModule diff --git a/src/Utilities/version.f90 b/src/Utilities/version.f90 index e9c4a685450..011f2ec6917 100644 --- a/src/Utilities/version.f90 +++ b/src/Utilities/version.f90 @@ -7,17 +7,18 @@ module VersionModule ! -- module imports use KindModule - use DefinedMacros, only: is_pro, using_petsc + use DefinedMacros, only: is_extended, using_petsc, using_netcdf use ConstantsModule, only: LENBIGLINE, LENHUGELINE, DZERO use SimVariablesModule, only: istdout - use GenericUtilitiesModule, only: write_centered, write_message, sim_message + use MessageModule, only: write_message, write_message_centered, & + write_message_counter use CompilerVersion, only: get_compiler, get_compile_options implicit none public ! -- modflow 6 version - integer(I4B), parameter :: IDEVELOPMODE = 0 - character(len=*), parameter :: VERSIONNUMBER = '6.4.2' - character(len=*), parameter :: VERSIONTAG = ' 06/28/2023' + integer(I4B), parameter :: IDEVELOPMODE = 1 + character(len=*), parameter :: VERSIONNUMBER = '6.4.3' + character(len=*), parameter :: VERSIONTAG = ' 02/07/2024' character(len=40), parameter :: VERSION = VERSIONNUMBER//VERSIONTAG character(len=2), parameter :: MFVNAM = ' 6' character(len=*), parameter :: MFTITLE = & @@ -61,6 +62,16 @@ module VersionModule &' and the PETSc Development Team All rights reserved.',/,& &' (https://petsc.org/release/)',/& &)" + character(len=*), parameter :: NETCDFLICENSE = & + "(& + &'The following library is used in this USGS product:',//,& + &' NetCDF, network Common Data Form software library',/,& + &' Copyright (c) 1993-2014 University Corporation for Atmospheric',/,& + &' Research/Unidata. Redistribution and use in source and binary',/,& + &' forms, with or without modification, are permitted provided that',/,& + &' the conditions in the NetCDF copyright are met',/,& + &' (https://www.unidata.ucar.edu/software/netcdf/copyright.html)',/& + &)" ! -- disclaimer must be appropriate for version (release or release candidate) character(len=*), parameter :: FMTDISCLAIMER = & "(/,& @@ -101,33 +112,40 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & logical(LGP) :: wsc ! ! -- set pro string - if (is_pro()) then - write (cheader, '(3a)') 'MODFLOW', MFVNAM, ' PROFESSIONAL' + if (is_extended()) then + write (cheader, '(3a)') 'MODFLOW', MFVNAM, ' EXTENDED' else write (cheader, '(2a)') 'MODFLOW', MFVNAM end if ! ! -- Write title to iout - call write_centered(cheader, iheader_width, iunit=iout) - call write_centered(MFTITLE, iheader_width, iunit=iout) + call write_message_centered(text=cheader, linelen=iheader_width, & + iunit=iout) + call write_message_centered(text=MFTITLE, linelen=iheader_width, & + iunit=iout) ! ! -- Write model type to list file if (present(cmodel_type)) then - call write_centered(cmodel_type, iheader_width, iunit=iout) + call write_message_centered(text=cmodel_type, linelen=iheader_width, & + iunit=iout) end if ! ! -- Write version - call write_centered('VERSION '//VERSION, iheader_width, iunit=iout) + call write_message_centered(text='VERSION '//VERSION, & + linelen=iheader_width, iunit=iout) ! ! -- Write if develop mode if (IDEVELOPMODE == 1) then - call write_centered('***DEVELOP MODE***', iheader_width, iunit=iout) + call write_message_centered(text='***DEVELOP MODE***', & + linelen=iheader_width, iunit=iout) end if ! ! -- Write compiler version call get_compiler(compiler) - call write_centered(' ', iheader_width, iunit=iout) - call write_centered(trim(adjustl(compiler)), iheader_width, iunit=iout) + call write_message_centered(text=' ', linelen=iheader_width, & + iunit=iout) + call write_message_centered(text=trim(adjustl(compiler)), & + linelen=iheader_width, iunit=iout) ! ! -- Write disclaimer write (iout, FMTDISCLAIMER) @@ -140,7 +158,7 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & ! -- write compiler options if (iout /= istdout) then call get_compile_options(compiler_options) - call write_message(compiler_options, iunit=iout) + call write_message_counter(text=compiler_options, iunit=iout) end if ! ! -- Write the system command used to initiate simulation @@ -160,9 +178,7 @@ subroutine write_listfile_header(iout, cmodel_type, write_sys_command, & call write_kindinfo(iout) end if write (iout, *) - ! - ! -- return - return + end subroutine write_listfile_header !> @ brief Write program license @@ -178,7 +194,16 @@ subroutine write_license(iout) if (present(iout)) then write (iout, FMTLICENSE) else - call sim_message('', fmt=FMTLICENSE) + call write_message('', fmt=FMTLICENSE) + end if + ! + ! -- write NetCDF license + if (using_netcdf()) then + if (present(iout)) then + write (iout, NETCDFLICENSE) + else + call write_message('', fmt=NETCDFLICENSE) + end if end if ! ! -- write PETSc license @@ -186,12 +211,10 @@ subroutine write_license(iout) if (present(iout)) then write (iout, PETSCLICENSE) else - call sim_message('', fmt=PETSCLICENSE) + call write_message('', fmt=PETSCLICENSE) end if end if - ! - ! -- return - return + end subroutine write_license end module VersionModule diff --git a/src/meson.build b/src/meson.build index 5f57e065d7b..b25a391edb3 100644 --- a/src/meson.build +++ b/src/meson.build @@ -28,10 +28,14 @@ modflow_sources = files( 'Exchange' / 'BaseExchange.f90', 'Exchange' / 'DisConnExchange.f90', 'Exchange' / 'GhostNode.f90', + 'Exchange' / 'GwfExchangeMover.f90', 'Exchange' / 'GwfGwfExchange.f90', 'Exchange' / 'GwfGwtExchange.f90', 'Exchange' / 'GwtGwtExchange.f90', 'Exchange' / 'NumericalExchange.f90', + 'Exchange' / 'gwfgwfidm.f90', + 'Exchange' / 'gwfgwtidm.f90', + 'Exchange' / 'gwtgwtidm.f90', 'Model' / 'Connection' / 'ConnectionBuilder.f90', 'Model' / 'Connection' / 'CellWithNbrs.f90', 'Model' / 'Connection' / 'CsrUtils.f90', @@ -50,6 +54,7 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf3api8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3buy8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3chd8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3chd8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3csub8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3dis8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3dis8idm.f90', @@ -58,10 +63,15 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf3disv8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3disv8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3drn8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3drn8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3evt8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3evt8idm.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3evta8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3ghb8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3ghb8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3hfb8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3ic8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3ic8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3lak8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3maw8.f90', @@ -71,7 +81,10 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf3obs8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3oc8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3rch8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3rch8idm.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3rcha8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3riv8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3riv8idm.f90', 'Model' / 'GroundWaterFlow' / 'gwf3sfr8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3sto8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3tvbase8.f90', @@ -80,53 +93,61 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf3uzf8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3vsc8.f90', 'Model' / 'GroundWaterFlow' / 'gwf3wel8.f90', + 'Model' / 'GroundWaterFlow' / 'gwf3wel8idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1adv1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1apt1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1cnc1.f90', + 'Model' / 'GroundWaterTransport' / 'gwt1cnc1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1dis1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1disu1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1disv1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1dsp1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1dsp1idm.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1fmi1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1ic1.f90', + 'Model' / 'GroundWaterTransport' / 'gwt1ic1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1idm.f90', 'Model' / 'GroundWaterTransport' / 'gwt1ist1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1lkt1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1mst1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1mvt1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1mwt1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1obs1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1oc1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1sft1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1src1.f90', - 'Model' / 'GroundWaterTransport' / 'gwt1ssm1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1uzt1.f90', 'Model' / 'ModelUtilities' / 'BoundaryPackage.f90', + 'Model' / 'ModelUtilities' / 'BoundaryPackageExt.f90', 'Model' / 'ModelUtilities' / 'Connections.f90', 'Model' / 'ModelUtilities' / 'DiscretizationBase.f90', 'Model' / 'ModelUtilities' / 'DisvGeom.f90', + 'Model' / 'ModelUtilities' / 'FlowModelInterface.f90', 'Model' / 'ModelUtilities' / 'GwfBuyInputData.f90', 'Model' / 'ModelUtilities' / 'GwfMvrPeriodData.f90', 'Model' / 'ModelUtilities' / 'GwfNpfOptions.f90', 'Model' / 'ModelUtilities' / 'GwfStorageUtils.f90', 'Model' / 'ModelUtilities' / 'GwfVscInputData.f90', - 'Model' / 'ModelUtilities' / 'GwtAdvOptions.f90', 'Model' / 'ModelUtilities' / 'GwtDspOptions.f90', 'Model' / 'ModelUtilities' / 'GwtSpc.f90', + 'Model' / 'ModelUtilities' / 'ModelPackageInput.f90', 'Model' / 'ModelUtilities' / 'Mover.f90', 'Model' / 'ModelUtilities' / 'PackageMover.f90', 'Model' / 'ModelUtilities' / 'SfrCrossSectionManager.f90', 'Model' / 'ModelUtilities' / 'SfrCrossSectionUtils.f90', + 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', 'Model' / 'ModelUtilities' / 'UzfCellGroup.f90', 'Model' / 'ModelUtilities' / 'Xt3dAlgorithm.f90', 'Model' / 'ModelUtilities' / 'Xt3dInterface.f90', + 'Model' / 'TransportModel' / 'tsp1.f90', + 'Model' / 'TransportModel' / 'tsp1adv1.f90', + 'Model' / 'TransportModel' / 'tsp1apt1.f90', + 'Model' / 'TransportModel' / 'tsp1fmi1.f90', + 'Model' / 'TransportModel' / 'tsp1ic1.f90', + 'Model' / 'TransportModel' / 'tsp1obs1.f90', + 'Model' / 'TransportModel' / 'tsp1oc1.f90', + 'Model' / 'TransportModel' / 'tsp1mvt1.f90', + 'Model' / 'TransportModel' / 'tsp1ssm1.f90', 'Model' / 'BaseModel.f90', 'Model' / 'ExplicitModel.f90', 'Model' / 'NumericalModel.f90', 'Model' / 'NumericalPackage.f90', - 'Model' / 'TransportModel.f90', + 'Solution' / 'ConvergenceSummary.f90', + 'Solution' / 'LinearMethods' / 'ImsLinearSettings.f90', 'Solution' / 'LinearMethods' / 'ims8base.f90', 'Solution' / 'LinearMethods' / 'ims8linear.f90', 'Solution' / 'LinearMethods' / 'ims8reordering.f90', @@ -147,17 +168,25 @@ modflow_sources = files( 'Utilities' / 'ArrayRead' / 'Integer1dReader.f90', 'Utilities' / 'ArrayRead' / 'Integer2dReader.f90', 'Utilities' / 'ArrayRead' / 'LayeredArrayReader.f90', + 'Utilities' / 'Idm' / 'BoundInputContext.f90', 'Utilities' / 'Idm' / 'DefinitionSelect.f90', + 'Utilities' / 'Idm' / 'IdmLoad.f90', 'Utilities' / 'Idm' / 'IdmLogger.f90', - 'Utilities' / 'Idm' / 'IdmSimulation.f90', 'Utilities' / 'Idm' / 'InputDefinition.f90', + 'Utilities' / 'Idm' / 'InputLoadType.f90', 'Utilities' / 'Idm' / 'ModelPackageInputs.f90', 'Utilities' / 'Idm' / 'ModflowInput.f90', + 'Utilities' / 'Idm' / 'SourceCommon.f90', + 'Utilities' / 'Idm' / 'SourceLoad.F90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'AsciiInputLoadType.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'IdmMf6File.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'LoadMf6File.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'StressGridInput.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'StressListInput.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructArray.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructVector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmDfnSelector.f90', + 'Utilities' / 'Idm' / 'selector' / 'IdmExgDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmGwfDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmGwtDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmSimDfnSelector.f90', @@ -201,7 +230,9 @@ modflow_sources = files( 'Utilities' / 'compilerversion.F90', 'Utilities' / 'Constants.f90', 'Utilities' / 'defmacro.F90', - 'Utilities' / 'genericutils.f90', + 'Utilities' / 'DevFeature.f90', + 'Utilities' / 'ErrorUtil.f90', + 'Utilities' / 'GeomUtil.f90', 'Utilities' / 'HashTable.f90', 'Utilities' / 'HeadFileReader.f90', 'Utilities' / 'InputOutput.f90', @@ -209,6 +240,8 @@ modflow_sources = files( 'Utilities' / 'kind.f90', 'Utilities' / 'List.f90', 'Utilities' / 'ListReader.f90', + 'Utilities' / 'LongLineReader.f90', + 'Utilities' / 'MathUtil.f90', 'Utilities' / 'Message.f90', 'Utilities' / 'OpenSpec.f90', 'Utilities' / 'PackageBudget.f90', @@ -236,7 +269,8 @@ modflow_petsc_sources = files( 'Utilities' / 'Vector' / 'PetscVector.F90', 'Utilities' / 'Matrix' / 'PetscMatrix.F90', 'Solution' / 'PETSc' / 'PetscSolver.F90', - 'Solution' / 'PETSc' / 'PetscConvergence.F90' + 'Solution' / 'PETSc' / 'PetscConvergence.F90', + 'Solution' / 'PETSc' / 'PetscImsPreconditioner.F90' ) modflow_mpi_sources = files( diff --git a/src/mf6core.f90 b/src/mf6core.f90 index f173596e33f..814cfe1857d 100644 --- a/src/mf6core.f90 +++ b/src/mf6core.f90 @@ -130,6 +130,8 @@ subroutine Mf6Finalize() use ListsModule, only: lists_da use SimulationCreateModule, only: simulation_da use TdisModule, only: tdis_da + use IdmLoadModule, only: idm_da + use SimVariablesModule, only: iout ! -- local variables integer(I4B) :: im integer(I4B) :: ic @@ -141,6 +143,7 @@ subroutine Mf6Finalize() class(BaseExchangeType), pointer :: ep => null() class(SpatialModelConnectionType), pointer :: mc => null() ! + ! ! -- FINAL PROCESSING (FP) ! -- Final processing for each model do im = 1, basemodellist%Count() @@ -198,6 +201,8 @@ subroutine Mf6Finalize() call sgp%sgp_da() deallocate (sgp) end do + ! + call idm_da(iout) call simulation_da() call lists_da() ! @@ -229,8 +234,8 @@ end subroutine print_info subroutine create_lstfile() use ConstantsModule, only: LINELENGTH use SimVariablesModule, only: proc_id, nr_procs, simlstfile, iout - use InputOutputModule, only: getunit, openfile - use GenericUtilitiesModule, only: sim_message + use InputOutputModule, only: getunit, openfile, append_processor_id + use MessageModule, only: write_message use VersionModule, only: write_listfile_header character(len=LINELENGTH) :: line ! @@ -238,7 +243,7 @@ subroutine create_lstfile() iout = getunit() ! if (nr_procs > 1) then - write (simlstfile, '(a,i0,a)') 'mfsim.p', proc_id, '.lst' + call append_processor_id(simlstfile, proc_id) end if ! call openfile(iout, 0, simlstfile, 'LIST', filstat_opt='REPLACE') @@ -247,7 +252,7 @@ subroutine create_lstfile() write (line, '(2(1x,A))') 'Writing simulation list file:', & trim(adjustl(simlstfile)) ! - call sim_message(line) + call write_message(line) call write_listfile_header(iout) ! ! -- return @@ -263,7 +268,7 @@ subroutine static_input_load() ! -- modules use ConstantsModule, only: LENMEMPATH use SimVariablesModule, only: iout - use IdmSimulationModule, only: simnam_load, load_models + use IdmLoadModule, only: simnam_load, load_models, load_exchanges use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_setptr, mem_allocate use SimVariablesModule, only: idm_context, iparamlog @@ -285,9 +290,13 @@ subroutine static_input_load() ! -- initialize mask call create_load_mask(model_loadmask) ! - ! -- load selected models + ! -- load in scope models call load_models(model_loadmask, iout) ! + ! -- load in scope exchanges + call load_exchanges(model_loadmask, iout) + ! + ! -- cleanup deallocate (model_loadmask) ! ! -- return @@ -302,6 +311,8 @@ end subroutine static_input_load !! !< subroutine simulation_df() + ! -- modules + use IdmLoadModule, only: idm_df ! -- local variables integer(I4B) :: im integer(I4B) :: ic @@ -357,6 +368,9 @@ subroutine simulation_df() call sp%sln_df() end do + ! idm df + call idm_df() + end subroutine simulation_df !> @brief Simulation allocate and read @@ -423,9 +437,12 @@ end subroutine simulation_ar subroutine connections_cr() use ConnectionBuilderModule use SimVariablesModule, only: iout + use VersionModule, only: IDEVELOPMODE integer(I4B) :: isol type(ConnectionBuilderType) :: connectionBuilder class(BaseSolutionType), pointer :: sol => null() + integer(I4B) :: status + character(len=16) :: envvar write (iout, '(/a)') 'PROCESSING MODEL CONNECTIONS' @@ -435,6 +452,15 @@ subroutine connections_cr() return end if + if (IDEVELOPMODE == 1) then + call get_environment_variable('DEV_ALWAYS_USE_IFMOD', & + value=envvar, status=status) + if (status == 0 .and. envvar == '1') then + connectionBuilder%dev_always_ifmod = .true. + write (iout, '(/a)') "Development option: forcing interface model" + end if + end if + do isol = 1, basesolutionlist%Count() sol => GetBaseSolutionFromList(basesolutionlist, isol) call connectionBuilder%processSolution(sol) @@ -468,6 +494,7 @@ subroutine Mf6PrepareTimestep() use BaseSolutionModule, only: BaseSolutionType, GetBaseSolutionFromList use SimModule, only: converge_reset use SimVariablesModule, only: isim_mode + use IdmLoadModule, only: idm_rp ! -- local variables class(BaseModelType), pointer :: mp => null() class(BaseExchangeType), pointer :: ep => null() @@ -498,6 +525,9 @@ subroutine Mf6PrepareTimestep() line = trim(line)//'normal"' end select + ! -- load dynamic input + call idm_rp() + ! -- Read and prepare each model do im = 1, basemodellist%Count() mp => GetBaseModelFromList(basemodellist, im) @@ -505,6 +535,9 @@ subroutine Mf6PrepareTimestep() call mp%model_rp() end do ! + ! -- Synchronize + call run_ctrl%at_stage(STG_BFR_EXG_RP) + ! ! -- Read and prepare each exchange do ie = 1, baseexchangelist%Count() ep => GetBaseExchangeFromList(baseexchangelist, ie) @@ -517,6 +550,9 @@ subroutine Mf6PrepareTimestep() call mc%exg_rp() end do ! + ! -- Synchronize + call run_ctrl%at_stage(STG_AFT_CON_RP) + ! ! -- reset simulation convergence flag call converge_reset() ! @@ -563,6 +599,7 @@ subroutine Mf6DoTimestep() use ListsModule, only: solutiongrouplist use SimVariablesModule, only: iFailedStepRetry use SolutionGroupModule, only: SolutionGroupType, GetSolutionGroupFromList + use IdmLoadModule, only: idm_ad ! -- local variables class(SolutionGroupType), pointer :: sgp => null() integer(I4B) :: isg @@ -576,6 +613,9 @@ subroutine Mf6DoTimestep() iFailedStepRetry = 0 retryloop: do + ! -- idm advance + call idm_ad() + do isg = 1, solutiongrouplist%Count() sgp => GetSolutionGroupFromList(solutiongrouplist, isg) call sgp%sgp_ca() diff --git a/src/simnamidm.f90 b/src/simnamidm.f90 index 86c6f058f37..f2a53f30a12 100644 --- a/src/simnamidm.f90 +++ b/src/simnamidm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module SimNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -44,7 +45,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -60,7 +62,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -76,7 +79,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -92,7 +96,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -108,7 +113,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -124,7 +130,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -140,7 +147,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -156,7 +164,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -172,7 +181,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -188,7 +198,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -204,7 +215,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -220,7 +232,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -236,7 +249,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -252,7 +266,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +283,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -284,7 +300,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -300,7 +317,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -338,7 +356,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -354,7 +373,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -370,7 +390,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/srcbmi/mf6bmiUtil.f90 b/srcbmi/mf6bmiUtil.f90 index 4a5f1d1945e..f586ed6f79e 100644 --- a/srcbmi/mf6bmiUtil.f90 +++ b/srcbmi/mf6bmiUtil.f90 @@ -8,7 +8,7 @@ module mf6bmiUtil LENMODELNAME, LINELENGTH, LENMEMTYPE, & LENMEMADDRESS, LENCOMPONENTNAME use KindModule, only: DP, I4B, LGP - use GenericUtilitiesModule, only: sim_message + use MessageModule, only: write_message use SimVariablesModule, only: istdout use MemoryHelperModule, only: split_mem_address, split_mem_path implicit none @@ -210,7 +210,7 @@ function get_model_name(grid_id) result(model_name) end do write (error_msg, '(a,i0)') 'BMI error: no model for grid id ', grid_id - call sim_message(error_msg, iunit=istdout, skipbefore=1, skipafter=1) + call write_message(error_msg, iunit=istdout, skipbefore=1, skipafter=1) end function get_model_name !> @brief Get the solution object for this index diff --git a/utils/idmloader/IDM.md b/utils/idmloader/IDM.md index 37ff976aa77..4b2d07c5ac4 100644 --- a/utils/idmloader/IDM.md +++ b/utils/idmloader/IDM.md @@ -1,111 +1,45 @@ -# MODFLOW 6 Input Data Model developer resource - +# MODFLOW 6 Input Data Model MODFLOW 6 reads simulation input from text and binary input files. Traditionally, each model package has been responsible for reading its own input. Although there are low-level utilities for reading arrays, and parsing input blocks, these utilities are called from dedicated read routines for each package. To support new types of input, such as from NetCDF files or through the Application Programming Interface, a new effort is underway to implement a comprehensive Input Data Model (IDM) for MODFLOW 6. Implementation of an Output Data Model may follow this effort. -This document intends to describe, from a development perspective, the MODFLOW 6 IDM, and provide guidance for how to work with it. As the IDM is an active area of development this document should be expected to change frequently and will be updated to track with current state. - -* [Overview](#overview) -* [Terminology](#terminology) -* [Package Update Process](#package-update-process) +- [Overview](#overview) +- [Framework](#framework) +- [Design](#design) +- [Integration](#integration) ## Overview -The MODFLOW 6 IDM is intended to provide a common entry point for simulation input data. The approach is to read the input data first into memory and store the input data in the "input context." Reading the simulation input into memory is performed by IDM load routines. Model packages are then refactored so that they obtain their required information from the input context, rather than directly from the input files. We refer to the process as "sourcing." A model package "sources" its input from the input context. The advantage here is that other readers can be implemented to load information into the input context, and then the model packages should work without modification. This approach is built upon the MODFLOW 6 memory management infrastructure to define variable access paths that are scoped to a particular component/subcomponent. Input variables themselves are ultimately described by MODFLOW 6 definition (dfn) files. +The MODFLOW 6 IDP (Input Data Processor) is a subsystem meant to generically read and store simulation input data from more than one type of input source. It is built upon existing MODFLOW 6 capabilities, specifically input parameter descriptions currently stored in \*.dfn (definition) files, and the Memory Manager. The parameter descriptions provide IDP with input block and parameter attributes needed to create memory and store input data. The Memory Manager provides a globally accessible way to create, update, access and remove input (and other) data. Existing components that read a traditional ASCII input file can be updated to source their input from the Memory Manager. This type of update is a significant step towards supporting sources of input data other than the traditional ASCII files. -The MODFLOW 6 IDM is intended to decouple a simulation run from any particular, supported source of input that a user might construct. Currently, MODFLOW 6 packages read input directly from proprietary MODFLOW-specific input files as required during a simulation run. The new design assigns responsibility for reading and loading data from the files to IDM proper, which builds the input context from the supported user input source (currently, MODFLOW 6 input files). Simulation components then access (or source) the input context to retrieve relevant input data. +## Framework +MODFLOW 6 \*.dfn files are used pre-compile time to generate fortran source files containing a subset of the parameter and block attribute information necessary to process input for the simulation. A single definition file is converted into one fortran source file that defines the component parameters and blocks and organizes them into lists. This conversion from defintion file to fortran source file is currently managed by the [dfn2f90.py](scripts/dfn2f90.py) script. This script also creates framework fortran source files with routines for generically accessing package definitions by component. A package or other component intended to be updated and integrated with IDM must be added to the dfn2f90.py script. This process is described below. -## Terminology -### Definition File (.dfn suffix) -MODFLOW 6 dfn file formats are described in the [dfn readme.md](../../doc/mf6io/mf6ivar/readme.md). These definition files describe MODFLOW 6 input files and parameters. They are used to generate the documentation in mf6io.pdf. They are also used to auto-generate the FloPy classes for MODFLOW 6. Definition files are also read as input to the dfn2f90.py script, which is a new utility developed as part of this IDM effort. This script generates Fortran source code that describes MODFLOW 6 input. The Fortran source code generated by dfn2f90.py defines the input parameters and input file structure, and is used by IDM to load simulation input. -### input definition -The Fortran version of the Input definitions are generated from MODFLOW 6 dfn files and describe input parameter or blocks: +## Design +Input data stored in the Memory Manager use the special identifier ```__INPUT__``` as a prefix to a memory path. MODFLOW 6 refers to memory path prefixes such as these as a "context" and as such the collection of input data stored in the Memory Manager is referred to as the "input context". -```fortran -type(InputParamDefinitionType), parameter :: & - gwtdsp_opt_xt3d_off = InputParamDefinitionType & - ( & - 'GWT', & ! component - 'DSP', & ! subcomponent - 'OPTIONS', & ! block - 'XT3D_OFF', & ! tag name - 'XT3D_OFF', & ! fortran variable - 'KEYWORD', & ! type - '', & ! shape - .false., & ! required - .false., & ! multi-record - .false., & ! preserve case - .false. & ! layered - ) -``` +IDM defines and implements loaders as objects to read input from some supported source and to allocate and store that input in a source independent way for the package or component. Variations across sources are managed by the loaders. Input retrieved by simulation packages is stuctured such that the source is not apparent or relevant to the package. -These Fortran definitions are used by IDM input handlers to interpret user input and load input data into the input context. +IDM distinguishes between static and dynamic loader objects. Static loader objects load all pre-period input before any simulation objects are created and prepare for dynamic (stress period) data loads by creating the dynamic loader when relevant. Static and dynamic loaders are defined per supported source by extending base types defined in [InputLoadType.f90](../../src/Utilities/Idm/InputLoadType.f90). Top level IDM context ([IdmLoad.f90](../../src/Utilities/Idm/IdmLoad.f90)) maintains pointers to loader base types and invoke the common deferred interfaces load() (static) and rp() (dynamic) for each component. Each source can introduce as much complexity as needed to support variations in input by introducing source specific loader types. For example, there are currently distinct loaders for dynamic ASCII list based and array-based inputs. These sub-loaders are allocated and managed within the context of a given source (e.g. ASCII). -A related set of input definitions are contained in a Fortran file that is named from the related package file, e.g. [gwf3npf8idm.f90](../../src/Model/GroundWaterFlow/gwf3npf8idm.f90) contains input definitions relevant to [gwf3npf8.f90](../../src/Model/GroundWaterFlow/gwf3npf8.f90). A Fortran input definition file is organized into 3 lists, a parameter (input variable) list, an aggregate (similar to a numpy recarray) list, and a block list. The Fortran input definitions also contain the definition for a found type object that can be used within packages to track what input variable paths were loaded into the input context by the IDM load routine: +## Integration +A simulation component (package, etc) can be integrated with IDM by following these steps: +- Create dfn file +- Add component to dfn2f90.py and run script +- Update MODFLOW 6 build scripts (e.g. meson / msvs) +- Use common intefaces to source input from input context + +The dfn file is already a requirement for MODFLOW 6 package integration and so is not an IDM specific requirement. The dfn2f90.py update should be straightforward and currently amounts to specifying the input path to the package dfn file and an output path for the generated package \*idm.f90 file. To run the script: -```fortran -type GwtDspParamFoundType - logical :: opt_xt3d_off = .false. - logical :: opt_xt3d_rhs = .false. - logical :: grid_diffc = .false. - logical :: grid_alh = .false. - logical :: grid_alv = .false. - logical :: grid_ath1 = .false. - logical :: grid_ath2 = .false. - logical :: grid_atv = .false. -end type GwtDspParamFoundType` -``` -## Package Update process -### Update [dfn2f90.py](scripts/dfn2f90.py) -Add a new dfns entry in main, designating paths and names for the input dfn and output f90 files. -### Run the dfn2f90.py script ```shell cd utils/idmloader/scripts python dfn2f90.py ``` -This will create the new IDM Fortran definition file at the location designated. This will also automatically update IDM selector modules so that the newly generated definitions can be used. If a new component (e.g. a new model) has been introduced, a new selector file will be generated in the src/Utitilites/Idm/selector directory. -### Update [meson.build](../../src/meson.build) and [mf6core.vfproj](../../msvs/mf6core.vfproj) -Add any newly generated fortran files to relevant build scripts to compile new definitions and definition select routines into MODFLOW 6 binaries. - -Note: To simplify the update process, all necessary internal modifications are performed when dfn2f90.py is run. Compiling with these changes immediately updates IDM to treat any newly added package as integrated. This may not be the case if, for example, model package code has not been updated to source input from the input context. GWF and GWT model code is fully integrated with IDM and as such either a valid unit number (for packages that are not IDM integrated) or a valid mempath (for packages that are IDM integrated) is passed into a package but not both. Once a new fortran idm definition file has been compiled in, a valid unit number will no longer be provided to the package and parser operations will fail if attempted. -### Update the package file -#### Source package input data -To convert a package to use the new IDM approach, the read routine for the package must be replaced by a sourcing routine that accesses data from the input context. The implementation of the source routine is dependent on the data itself but a common pattern is to use the MemoryManagerExtModule `mem_set_value()` interface to copy data from the input context to package paths. A parameter found type, in the generated IDM definition file, should be used to pass a corresponding logical to `mem_set_value()`, which sets the logical to True if the input path was found and data was copied. When sourcing has been completed, the found type parameter logicals can be checked to determine what other actions need to be taken in response to both found or not found input data. - -```fortran -character(len=LENMEMPATH) :: idmMemoryPath -type(GwtDspParamFoundType) :: found -! ------------------------------------------------------------------------------ -! -! -- set memory path -idmMemoryPath = create_mem_path(this%name_model, 'DSP', idm_context) -! -! -- update defaults with idm sourced values -call mem_set_value(this%ixt3doff, 'XT3D_OFF', idmMemoryPath, found%opt_xt3d_off) -call mem_set_value(this%ixt3drhs, 'XT3D_RHS', idmMemoryPath, found%opt_xt3d_rhs) -! -! -- set xt3d state flag -if (found%opt_xt3d_off) this%ixt3d = 0 -if (found%opt_xt3d_rhs) this%ixt3d = 2 -``` +Running this command will generate a new definition file for the package and update the IDM selector framework. If the package also introduces a new model then a new selector framework file will also be created. Update the MODFLOW 6 build system (meson and msvs) files with any newly generated files. -#### Deallocate package input paths -In deallocate, add a call to MemoryManagerExtModule `memorylist_remove()` for the package. This call will search the subcomponent input path and deallocate all memory that was allocated as part of the load process. +Once these files have been added to the build the package can be updated to source it's input from the input context. In general, static input data is copied from the input context to the package (or "model") context by using the ```mem_set_value()``` interface: -```fortran -! -- Deallocate input memory -call memorylist_remove(this%name_model, 'DSP', idm_context) -``` - -## Adding params to packages already using IDM - -Once a model package has been modified to use the IDM approach, adding a new package option or block requires two steps. The steps are as follows. - -### Update appropriate dfn file with new param(s) -### Run the dfn2f90.py script ```shell -cd utils/idmloader/scripts -python dfn2f90.py +call mem_set_value(this%xorigin, 'XORIGIN', this%input_mempath, found%xorigin) ``` -This will update the existing idm package f90 file to add the new parameter definition. Compile to update the binaries. -#### Source package input data -Update the package source routine for the relevant block to copy the data from the input path to the package path. Take any necessary action depending on whether the data was found or not found. +The found instance is a convenience type generated by dfn2f90.py and should be complete and ready to use from the \*idm.f90 package module. The inteface updates the data pointer (```this%xorigin``` in the example) only if the relevant data was provided as input and will set the logical ```found%xorigin``` to TRUE when this is the case. + +Dynamic data can also be copied between contexts by using the ```mem_set_value()``` interface or it can be accessed directly by setting a pointer to it. In most cases, dynamic input memory is not reallocated during it's lifetime and such a pointer is valid for the duration of the simulation. See CHD package code for an example (e.g. "HEAD") diff --git a/utils/idmloader/README.md b/utils/idmloader/README.md deleted file mode 100644 index 300d55e9811..00000000000 --- a/utils/idmloader/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# idmloader - -This is a placeholder for the idmloader utility, a standalone tool that populates input memory paths from a supported input source. diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py index 6f59df4b38b..5b5a0c58c99 100644 --- a/utils/idmloader/scripts/dfn2f90.py +++ b/utils/idmloader/scripts/dfn2f90.py @@ -1,11 +1,11 @@ -import os import sys -import json from pathlib import Path -from enum import Enum MF6_LENVARNAME = 16 F90_LINELEN = 82 +PROJ_ROOT = Path(__file__).parents[3] +DFN_PATH = PROJ_ROOT / "doc" / "mf6io" / "mf6ivar" / "dfn" +SRC_PATH = PROJ_ROOT / "src" class Dfn2F90: @@ -46,7 +46,6 @@ def add_dfn_entry(self, dfn_d=None): def write_f90(self, ofspec=None): with open(ofspec, "w") as f: - # file header f.write(self._source_file_header(self.component, self.subcomponent)) @@ -138,7 +137,6 @@ def _set_var_d(self): vd = {} for line in lines: - # skip blank lines if len(line.strip()) == 0: if len(vd) > 0: @@ -256,7 +254,8 @@ def _set_param_strs(self): self._param_str += " .false., & ! required\n" self._param_str += " .false., & ! multi-record\n" self._param_str += " .false., & ! preserve case\n" - self._param_str += " .false. & ! layered\n" + self._param_str += " .false., & ! layered\n" + self._param_str += " .false. & ! timeseries\n" self._param_str += " ), &\n" if not self._aggregate_str: @@ -272,7 +271,8 @@ def _set_param_strs(self): self._aggregate_str += " .false., & ! required\n" self._aggregate_str += " .false., & ! multi-record\n" self._aggregate_str += " .false., & ! preserve case\n" - self._aggregate_str += " .false. & ! layered\n" + self._aggregate_str += " .false., & ! layered\n" + self._aggregate_str += " .false. & ! timeseries\n" self._aggregate_str += " ), &\n" if not self._block_str: @@ -301,7 +301,6 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): r = ".false." for k in self._var_d: - varname, bname = k if bname != blockname: continue @@ -333,12 +332,23 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): shape = "" shapelist = [] + # workaround for Flopy shape issue with exg dfns: + if c.upper() == "EXG": + if vn == "CELLIDM1" or vn == "CELLIDM2": + v["shape"] = "(ncelldim)" if "shape" in v: shape = v["shape"] shape = shape.replace("(", "") shape = shape.replace(")", "") shape = shape.replace(",", "") shape = shape.upper() + if shape == "NCOL*NROW; NCPL": + # grid array input syntax + if mf6vn == "AUXVAR": + # for grid, set AUX as DOUBLE2D + shape = "NAUX NCPL" + else: + shape = "NCPL" shapelist = shape.strip().split() ndim = len(shapelist) @@ -375,6 +385,13 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): else: layered = ".false." + timeseries = ".false." + if "time_series" in v: + if v["time_series"] == "true": + timeseries = ".true." + else: + timeseries = ".false." + if inrec == ".false.": required_l.append(r) tuple_list = [ @@ -389,6 +406,7 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): (inrec, "multi-record"), (preserve_case, "preserve case"), (layered, "layered"), + (timeseries, "timeseries"), ] if aggregate_t: @@ -443,6 +461,7 @@ def _source_file_header(self, component, subcomponent): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module {component.title()}{subcomponent.title()}InputModule\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" f" private\n" @@ -505,6 +524,7 @@ class IdmDfnSelector: def __init__( self, dfn_d: dict = None, + varnames: list = None, ): """IdmDfnSelector init""" @@ -515,7 +535,7 @@ def write(self): self._write_master() def _write_master(self): - ofspec = f"../../../src/Utilities/Idm/selector/IdmDfnSelector.f90" + ofspec = SRC_PATH / "Utilities" / "Idm" / "selector" / "IdmDfnSelector.f90" with open(ofspec, "w") as fh: self._write_master_decl(fh) self._write_master_defn(fh, defn="param", dtype="param") @@ -523,12 +543,17 @@ def _write_master(self): self._write_master_defn(fh, defn="block", dtype="block") self._write_master_multi(fh) self._write_master_integration(fh) + self._write_master_component(fh) fh.write(f"end module IdmDfnSelectorModule\n") def _write_selectors(self): for c in self._d: ofspec = ( - f"../../../src/Utilities/Idm/selector/Idm{c.title()}DfnSelector.f90" + SRC_PATH + / "Utilities" + / "Idm" + / "selector" + / f"Idm{c.title()}DfnSelector.f90" ) with open(ofspec, "w") as fh: self._write_selector_decl(fh, component=c, sc_list=self._d[c]) @@ -554,6 +579,7 @@ def _write_selector_decl(self, fh=None, component=None, sc_list=None): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module Idm{c.title()}DfnSelectorModule\n\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use SimModule, only: store_error\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" @@ -563,16 +589,7 @@ def _write_selector_decl(self, fh=None, component=None, sc_list=None): len_sc = len(sc) spacer = space * (len_c + len_sc) - s += ( - f" use {c.title()}{sc.title()}InputModule, only: " - f"{c.lower()}_{sc.lower()}_param_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_aggregate_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_block_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_multi_package\n" - ) + s += f" use {c.title()}{sc.title()}InputModule\n" s += ( f"\n implicit none\n" @@ -582,8 +599,8 @@ def _write_selector_decl(self, fh=None, component=None, sc_list=None): f" public :: {c.lower()}_block_definitions\n" f" public :: {c.lower()}_idm_multi_package\n" f" public :: {c.lower()}_idm_integrated\n\n" - f"contains\n\n" ) + s += f"contains\n\n" fh.write(s) @@ -704,6 +721,7 @@ def _write_master_decl(self, fh=None): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module IdmDfnSelectorModule\n\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use SimModule, only: store_error\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" @@ -712,18 +730,7 @@ def _write_master_decl(self, fh=None): for c in self._d: len_c = len(c) spacer = space * (len_c) - s += ( - f" use Idm{c.title()}DfnSelectorModule, only: " - f"{c.lower()}_param_definitions, &" - f"\n {spacer}" - f"{c.lower()}_aggregate_definitions, &" - f"\n {spacer}" - f"{c.lower()}_block_definitions, &" - f"\n {spacer}" - f"{c.lower()}_idm_multi_package, &" - f"\n {spacer}" - f"{c.lower()}_idm_integrated\n" - ) + s += f" use Idm{c.title()}DfnSelectorModule\n" s += ( f"\n implicit none\n" @@ -732,7 +739,8 @@ def _write_master_decl(self, fh=None): f" public :: aggregate_definitions\n" f" public :: block_definitions\n" f" public :: idm_multi_package\n" - f" public :: idm_integrated\n\n" + f" public :: idm_integrated\n" + f" public :: idm_component\n\n" f"contains\n\n" ) @@ -823,55 +831,136 @@ def _write_master_integration(self, fh=None): fh.write(s) + def _write_master_component(self, fh=None): + s = ( + f" function idm_component(component) " + f"result(integrated)\n" + f" character(len=*), intent(in) :: component\n" + f" logical :: integrated\n" + f" integrated = .false.\n" + f" select case (component)\n" + ) + + for c in dfn_d: + s += f" case ('{c}')\n" f" integrated = .true.\n" + + s += ( + f" case default\n" + f" end select\n" + f" return\n" + f" end function idm_component\n\n" + ) + + fh.write(s) + if __name__ == "__main__": - dfns = [ # ** Add a new dfn parameter set to MODFLOW 6 by adding a new entry to this list ** # [relative path of input dnf, relative path of output f90 definition file] [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-dis.dfn"), - Path("../../../src/Model/GroundWaterFlow", "gwf3dis8idm.f90"), + DFN_PATH / "gwf-chd.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3chd8idm.f90", + ], + [ + DFN_PATH / "gwf-dis.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3dis8idm.f90", + ], + [ + DFN_PATH / "gwf-disu.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3disu8idm.f90", + ], + [ + DFN_PATH / "gwf-disv.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3disv8idm.f90", + ], + [ + DFN_PATH / "gwf-drn.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3drn8idm.f90", + ], + [ + DFN_PATH / "gwf-evt.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3evt8idm.f90", + ], + [ + DFN_PATH / "gwf-evta.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3evta8idm.f90", + ], + [ + DFN_PATH / "gwf-ghb.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3ghb8idm.f90", + ], + [ + DFN_PATH / "gwf-ic.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3ic8idm.f90", + ], + [ + DFN_PATH / "gwf-npf.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3npf8idm.f90", + ], + [ + DFN_PATH / "gwf-rch.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3rch8idm.f90", + ], + [ + DFN_PATH / "gwf-rcha.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3rcha8idm.f90", + ], + [ + DFN_PATH / "gwf-riv.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3riv8idm.f90", + ], + [ + DFN_PATH / "gwf-wel.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3wel8idm.f90", + ], + [ + DFN_PATH / "gwt-dis.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1dis1idm.f90", + ], + [ + DFN_PATH / "gwt-disu.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1disu1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-disu.dfn"), - Path("../../../src/Model/GroundWaterFlow", "gwf3disu8idm.f90"), + DFN_PATH / "gwt-disv.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1disv1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-disv.dfn"), - Path("../../../src/Model/GroundWaterFlow", "gwf3disv8idm.f90"), + DFN_PATH / "gwt-dsp.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1dsp1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-npf.dfn"), - Path("../../../src/Model/GroundWaterFlow", "gwf3npf8idm.f90"), + DFN_PATH / "gwt-cnc.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1cnc1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwt-dis.dfn"), - Path("../../../src/Model/GroundWaterTransport", "gwt1dis1idm.f90"), + DFN_PATH / "gwt-ic.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1ic1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwt-disu.dfn"), - Path("../../../src/Model/GroundWaterTransport", "gwt1disu1idm.f90"), + DFN_PATH / "gwf-nam.dfn", + SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwt-disv.dfn"), - Path("../../../src/Model/GroundWaterTransport", "gwt1disv1idm.f90"), + DFN_PATH / "gwt-nam.dfn", + SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1idm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwt-dsp.dfn"), - Path("../../../src/Model/GroundWaterTransport", "gwt1dsp1idm.f90"), + DFN_PATH / "exg-gwfgwf.dfn", + SRC_PATH / "Exchange" / "gwfgwfidm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-nam.dfn"), - Path("../../../src/Model/GroundWaterFlow", "gwf3idm.f90"), + DFN_PATH / "exg-gwfgwt.dfn", + SRC_PATH / "Exchange" / "gwfgwtidm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "gwt-nam.dfn"), - Path("../../../src/Model/GroundWaterTransport", "gwt1idm.f90"), + DFN_PATH / "exg-gwtgwt.dfn", + SRC_PATH / "Exchange" / "gwtgwtidm.f90", ], [ - Path("../../../doc/mf6io/mf6ivar/dfn", "sim-nam.dfn"), - Path("../../../src", "simnamidm.f90"), + DFN_PATH / "sim-nam.dfn", + SRC_PATH / "simnamidm.f90", ], ] diff --git a/utils/mf5to6/make/makedefaults b/utils/mf5to6/make/makedefaults index fdc2fdb51cb..e7b3710e4ab 100644 --- a/utils/mf5to6/make/makedefaults +++ b/utils/mf5to6/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'mf5to6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -64,12 +64,9 @@ else FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index d8eb7e6963d..ccf5741d638 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -1,14 +1,14 @@ -# makefile created by pymake (version 1.2.7) for the 'mf5to6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/NWT -SOURCEDIR3=../src/LGR -SOURCEDIR4=../src/Preproc -SOURCEDIR5=../src/MF2005 +SOURCEDIR2=../src/LGR +SOURCEDIR3=../src/Preproc +SOURCEDIR4=../src/MF2005 +SOURCEDIR5=../src/NWT SOURCEDIR6=../../../src/Utilities/Memory SOURCEDIR7=../../../src/Utilities/TimeSeries SOURCEDIR8=../../../src/Utilities @@ -28,30 +28,35 @@ ${SOURCEDIR8} OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ +$(OBJDIR)/Global.o \ $(OBJDIR)/SimVariables.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ $(OBJDIR)/version.o \ $(OBJDIR)/OpenSpec.o \ -$(OBJDIR)/Global.o \ $(OBJDIR)/GlobalVariables.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/SimPHMF.o \ $(OBJDIR)/InputOutput.o \ $(OBJDIR)/TableTerm.o \ $(OBJDIR)/Table.o \ $(OBJDIR)/MemoryHelper.o \ $(OBJDIR)/CharString.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/Memory.o \ $(OBJDIR)/List.o \ $(OBJDIR)/MemoryList.o \ +$(OBJDIR)/LongLineReader.o \ +$(OBJDIR)/DevFeature.o \ $(OBJDIR)/Utilities.o \ $(OBJDIR)/ConstantsPHMF.o \ $(OBJDIR)/MemoryManager.o \ +$(OBJDIR)/GeomUtil.o \ $(OBJDIR)/BlockParser.o \ $(OBJDIR)/ArrayReadersMF5.o \ $(OBJDIR)/precutls.o \ +$(OBJDIR)/MathUtil.o \ $(OBJDIR)/GlobalVariablesPHMF.o \ $(OBJDIR)/DiscretizationBasePHMF.o \ $(OBJDIR)/File.o \ diff --git a/utils/mf5to6/msvs/mf5to6.vfproj b/utils/mf5to6/msvs/mf5to6.vfproj index 0fdd1b971ce..10ff7233751 100644 --- a/utils/mf5to6/msvs/mf5to6.vfproj +++ b/utils/mf5to6/msvs/mf5to6.vfproj @@ -1,28 +1,32 @@ - + + - - - - - - - - - + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + @@ -93,12 +97,19 @@ - + - + + + + + + + + @@ -190,5 +201,7 @@ - - + + + + diff --git a/utils/mf5to6/pymake/extrafiles.txt b/utils/mf5to6/pymake/extrafiles.txt index 1699e51ed46..f8a3888f945 100644 --- a/utils/mf5to6/pymake/extrafiles.txt +++ b/utils/mf5to6/pymake/extrafiles.txt @@ -9,12 +9,17 @@ ../../../src/Utilities/Constants.f90 ../../../src/Utilities/SimVariables.f90 ../../../src/Utilities/compilerversion.F90 -../../../src/Utilities/genericutils.f90 +../../../src/Utilities/Message.f90 +../../../src/Utilities/ErrorUtil.f90 +../../../src/Utilities/GeomUtil.f90 ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 ../../../src/Utilities/List.f90 +../../../src/Utilities/LongLineReader.f90 +../../../src/Utilities/MathUtil.f90 ../../../src/Utilities/OpenSpec.f90 ../../../src/Utilities/defmacro.F90 ../../../src/Utilities/version.f90 ../../../src/Utilities/Table.f90 ../../../src/Utilities/TableTerm.f90 +../../../src/Utilities/DevFeature.f90 diff --git a/utils/mf5to6/src/Connection.f90 b/utils/mf5to6/src/Connection.f90 index 561d737a049..8c0d8fec34b 100644 --- a/utils/mf5to6/src/Connection.f90 +++ b/utils/mf5to6/src/Connection.f90 @@ -67,13 +67,43 @@ subroutine WriteGhostNodeCorrection(this, iu, numalphaj) ! select case (numalphaj) case (1) + if (this%alphaj1 == 0) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if write(iu,10)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%alphaj1 case (2) + if (this%alphaj1 == 0.) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if + if (this%alphaj2 == 0.) then + this%k2 = 0 + this%i2 = 0 + this%j2 = 0 + end if write(iu,20)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%k2, this%i2, this%j2, & this%alphaj1, this%alphaj2 case (3) + if (this%alphaj1 == 0.) then + this%k1 = 0 + this%i1 = 0 + this%j1 = 0 + end if + if (this%alphaj2 == 0.) then + this%k2 = 0 + this%i2 = 0 + this%j2 = 0 + end if + if (this%alphaj12 == 0.) then + this%k12 = 0 + this%i12 = 0 + this%j12 = 0 + end if write(iu,30)this%kp, this%ip, this%jp, this%kc, this%ic, this%jc, & this%k1, this%i1, this%j1, this%k2, this%i2, this%j2, & this%k12, this%i12, this%j12, this%alphaj1, this%alphaj2, & diff --git a/utils/mf5to6/src/Exchange.f90 b/utils/mf5to6/src/Exchange.f90 index 9071210c74b..3a5d2f1a7de 100644 --- a/utils/mf5to6/src/Exchange.f90 +++ b/utils/mf5to6/src/Exchange.f90 @@ -5,7 +5,7 @@ module ExchangeModule use FileWriterModule, only: FileWriterType use GLOBAL, only: NLAY, NROW, NCOL, IBOUND, BOTM, DELC, DELR, LBOTM, NBOTM use GlobalVariablesModule, only: LgrBilinear - use InputOutputModule, only: get_ijk, get_node + use GeomUtilModule, only: get_ijk, get_node use LGRMODULE, only: IBFLG, NPLBEG, NPRBEG, NPCBEG, NPLEND, & NPREND, NPCEND, NCPP, NCPPL use ModelModule, only: ModelType diff --git a/utils/mf5to6/src/MF2005/GwfBasSubs.f b/utils/mf5to6/src/MF2005/GwfBasSubs.f index 01b15a2e4da..2e8adcdd710 100644 --- a/utils/mf5to6/src/MF2005/GwfBasSubs.f +++ b/utils/mf5to6/src/MF2005/GwfBasSubs.f @@ -11,7 +11,7 @@ module GwfBasSubs use global, only: iout use GlobalVariablesModule, only: echo use GwfBasModule, only: SGWF2BAS7PNT, SGWF2BAS7PSV - use GenericUtilitiesModule, only: write_centered + use MessageModule, only: write_message_centered use ModelModule, only: ModelType use ObsWriterModule, only: ObsWriterType use OpenSpecModule, only: ACCESS, ACTION, FORM @@ -1051,9 +1051,9 @@ SUBROUTINE SGWF2BAS7OPEN(INUNIT,IUNIT,CUNIT,NIUNIT, model%iulist = iu OPEN(UNIT=IU,FILE=FNAME(1:IFLEN),STATUS='REPLACE', 1 FORM='FORMATTED',ACCESS='SEQUENTIAL') - call write_centered(PROGNAM, 80, iunit=iout) + call write_message_centered(PROGNAM, 80, iunit=iout) msg = 'Conversion Report' - call write_centered(msg, 80, iunit=iout) + call write_message_centered(msg, 80, iunit=iout) write(iout,1)trim(model%NameFile2005) write(iout,2)trim(model%BaseName) if (.not. model%ConversionDone) then diff --git a/utils/mf5to6/src/ModelConverter.f90 b/utils/mf5to6/src/ModelConverter.f90 index 3c1f14555e4..bea004b0de6 100644 --- a/utils/mf5to6/src/ModelConverter.f90 +++ b/utils/mf5to6/src/ModelConverter.f90 @@ -34,8 +34,7 @@ module ModelConverterModule use RivObsWriterModule, only: createRivObsWriter, RivObsWriterType use GhbObsWriterModule, only: createGhbObsWriter, GhbObsWriterType use GlobalVariablesModule, only: echo - use SimModule, only: store_error, store_note, store_warning, ustop, & - write_message + use SimModule, only: store_error, store_note, store_warning, ustop use SimListVariablesModule, only: SimMovers use UpwSubsModule, only: GWF2UPW1AR use UtilitiesModule, only: GetArgs diff --git a/utils/mf5to6/src/MultiLayerObsModule.f90 b/utils/mf5to6/src/MultiLayerObsModule.f90 index f8c77064f46..e2c87430a8e 100644 --- a/utils/mf5to6/src/MultiLayerObsModule.f90 +++ b/utils/mf5to6/src/MultiLayerObsModule.f90 @@ -1,8 +1,8 @@ module MultiLayerObs - - use ConstantsModule, only: DONE, MAXCHARLEN - use ConstantsPHMFModule, only: LENOBSNAMENEW - use GenericUtilitiesModule, only: is_same + + use ConstantsModule, only: DONE, MAXCHARLEN + use ConstantsPHMFModule, only: LENOBSNAMENEW + use MathUtilModule, only: is_close use ListModule, only: ListType use SimModule, only: store_error, ustop @@ -26,7 +26,7 @@ module MultiLayerObs procedure, public :: CheckWeightSum end type - contains +contains ! Non-type-bound procedures @@ -43,7 +43,7 @@ function CastAsLayerObsType(obj) result(res) end select return end function CastAsLayerObsType - + subroutine ConstructLayerObs(newLayerObs, layobname, layer, weight) ! dummy type(LayerObsType), pointer :: newLayerObs @@ -51,7 +51,7 @@ subroutine ConstructLayerObs(newLayerObs, layobname, layer, weight) integer, intent(in) :: layer double precision, intent(in) :: weight ! - allocate(newLayerObs) + allocate (newLayerObs) newLayerObs%lobsname = layobname newLayerObs%layer = layer newLayerObs%weight = weight @@ -71,7 +71,7 @@ subroutine AddLayerObsToList(list, layerobs) ! return end subroutine AddLayerObsToList - + function GetLayerObsFromList(list, indx) result(res) ! dummy type(ListType), intent(inout) :: list @@ -88,18 +88,18 @@ function GetLayerObsFromList(list, indx) result(res) ! return end function GetLayerObsFromList - + subroutine ConstructMLObs(newMLObs, obsname) ! dummy type(MLObsType), pointer, intent(inout) :: newMLObs character(len=LENOBSNAMENEW), intent(in) :: obsname ! - allocate(newMLObs) + allocate (newMLObs) newMLObs%mlobsname = obsname ! return end subroutine ConstructMLObs - + subroutine AddMLObsToList(list, mlobs) ! dummy type(ListType), intent(inout) :: list @@ -112,7 +112,7 @@ subroutine AddMLObsToList(list, mlobs) ! return end subroutine AddMLObsToList - + function GetMLObsFromList(list, indx) result(res) ! dummy type(ListType), intent(inout) :: list @@ -129,37 +129,37 @@ function GetMLObsFromList(list, indx) result(res) ! return end function GetMLObsFromList - + ! Type-bound procedures of MLObsType - + subroutine CheckWeightSum(this) ! dummy class(MLObsType) :: this ! local double precision :: weightsum integer :: i, nlayers - type(LayerObsType), pointer :: layobs => null() + type(LayerObsType), pointer :: layobs => null() character(len=MAXCHARLEN) :: ermsg ! formats - 10 format('Weights of layer observations do not sum to 1.0 for', & - ' multilayer observation: ',a) +10 format('Weights of layer observations do not sum to 1.0 for', & + ' multilayer observation: ', a) ! if (this%summ) return ! weightsum = 0.0d0 nlayers = this%LayerObsList%Count() - do i=1,nlayers + do i = 1, nlayers layobs => GetLayerObsFromList(this%LayerObsList, i) weightsum = weightsum + layobs%weight - enddo + end do ! - if (.not. is_same(weightsum, DONE)) then - write(ermsg,10)trim(this%mlobsname) + if (.not. is_close(weightsum, DONE)) then + write (ermsg, 10) trim(this%mlobsname) call store_error(ermsg) call ustop() - endif + end if ! return end subroutine - + end module MultiLayerObs diff --git a/utils/mf5to6/src/Preproc/Discretization3D.f90 b/utils/mf5to6/src/Preproc/Discretization3D.f90 index 38fe5b57304..0d373c8ebae 100644 --- a/utils/mf5to6/src/Preproc/Discretization3D.f90 +++ b/utils/mf5to6/src/Preproc/Discretization3D.f90 @@ -5,7 +5,8 @@ module DnmDis3dModule use ConstantsPHMFModule, only: PI use DnmDisBaseModule, only: DisBaseType use GlobalVariablesPHMFModule, only: verbose - use InputOutputModule, only: get_ijk, get_node, URWORD + use GeomUtilModule, only: get_ijk, get_node + use InputOutputModule, only: URWORD use SimModule, only: count_errors, store_error, & store_error_unit, ustop implicit none @@ -545,7 +546,6 @@ subroutine nodeu_to_string(this, nodeu, str) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ - use InputOutputModule, only: get_ijk implicit none class(Dis3dType) :: this integer, intent(in) :: nodeu @@ -617,7 +617,6 @@ integer function get_nodenumber_idx3(this, k, i, j, icheck) & ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ use ConstantsModule, only: LINELENGTH - use InputOutputModule, only: get_node implicit none ! dummy class(Dis3dType), intent(in) :: this diff --git a/utils/mf5to6/src/Preproc/DiscretizationBasePHMF.f90 b/utils/mf5to6/src/Preproc/DiscretizationBasePHMF.f90 index 5bc906a4b21..3158b4a3c7e 100644 --- a/utils/mf5to6/src/Preproc/DiscretizationBasePHMF.f90 +++ b/utils/mf5to6/src/Preproc/DiscretizationBasePHMF.f90 @@ -5,6 +5,7 @@ module DnmDisBaseModule use InputOutputModule, only: URWORD use SimModule, only: count_errors, store_error, store_error_unit, & ustop + use GeomUtilModule, only: get_node implicit none private public :: DisBaseType @@ -504,7 +505,6 @@ function get_nodenumber_idx2(this, k, j, icheck) result(nodenumber) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ use SimModule, only: ustop, store_error - use InputOutputModule, only: get_node implicit none ! Dummy arguments class(DisBaseType), intent(in) :: this diff --git a/utils/mf5to6/src/Preproc/ObsBlock.f90 b/utils/mf5to6/src/Preproc/ObsBlock.f90 index 9a16e3bfd50..c4e51a3562e 100644 --- a/utils/mf5to6/src/Preproc/ObsBlock.f90 +++ b/utils/mf5to6/src/Preproc/ObsBlock.f90 @@ -3,11 +3,11 @@ module ObsBlockModule use BlockParserModule, only: BlockParserType use ConstantsModule, only: DONE, DZERO, & LINELENGTH, MAXCHARLEN, LENOBSNAME - use GenericUtilitiesModule, only: is_same + use MathUtilModule, only: is_close use ConstantsPHMFModule, only: CONTINUOUS, SINGLE, LENOBSNAMENEW use DnmDis3dModule, only: Dis3dType use GlobalVariablesPHMFModule, only: verbose - use InputOutputModule, only: UPCASE, URWORD, uterminate_block + use InputOutputModule, only: UPCASE, URWORD use ListModule, only: ListType use ObserveModule, only: ObserveType, AddObserveToList, & GetObserveFromList, ConstructObservation @@ -184,7 +184,7 @@ subroutine process_block(this, insertLine, WriteBeginEnd, parser) iadjrow = 0 jadjcol = 0 ! - if (.not. is_same(xoff, DZERO)) then + if (.not. is_close(xoff, DZERO)) then if (xoff > DZERO) then if (jcol < ncol) then if (dis3d%idomain(jcol+1, irow, layer) == 1) then @@ -202,7 +202,7 @@ subroutine process_block(this, insertLine, WriteBeginEnd, parser) endif endif ! - if (.not. is_same(yoff, DZERO)) then + if (.not. is_close(yoff, DZERO)) then if (yoff > DZERO) then if (irow > 1) then if (dis3d%idomain(jcol, irow-1, layer) == 1) then diff --git a/utils/mf5to6/src/Preproc/ObservePHMF.f90 b/utils/mf5to6/src/Preproc/ObservePHMF.f90 index d35fd18079d..c50c7ad5f8d 100644 --- a/utils/mf5to6/src/Preproc/ObservePHMF.f90 +++ b/utils/mf5to6/src/Preproc/ObservePHMF.f90 @@ -15,7 +15,7 @@ module ObserveModule use ConstantsModule, only: DONE, DZERO, LENOBSNAME, & LENOBSTYPE, MAXCHARLEN use ConstantsPHMFModule, only: LENOBSNAMENEW, HUGEDBL, HDRYDEFAULT - use GenericUtilitiesModule, only: is_same + use MathUtilModule, only: is_close use ListModule, only: ListType use SimModule, only: store_warning, store_error, & store_error_unit, ustop @@ -206,7 +206,7 @@ subroutine CalcSimVal(this, itime) sumweights = DZERO k = 0 do i=1,nsrc - if (is_same(this%srcvals(itime, i), this%hdry)) then + if (is_close(this%srcvals(itime, i), this%hdry)) then k = k + 1 weights(i) = DZERO else diff --git a/utils/mf5to6/src/Preproc/Preproc.f90 b/utils/mf5to6/src/Preproc/Preproc.f90 index c320028b428..d840b84beb6 100644 --- a/utils/mf5to6/src/Preproc/Preproc.f90 +++ b/utils/mf5to6/src/Preproc/Preproc.f90 @@ -14,15 +14,13 @@ module PreprocModule use GLOBAL, only: NCOL, NROW, DELC, DELR use globalPHMF, only: ioutPHMF, outfile use GlobalVariablesPHMFModule, only: prognamPHMF, verbose, vnam - use InputOutputModule, only: GetUnit, uget_block, urword, & - uterminate_block, GetUnit, openfile, & - uget_any_block + use InputOutputModule, only: GetUnit, urword, GetUnit, openfile use ListModule, only: ListType use ObsBlockModule, only: ObsBlockType, ConstructObsBlockType, & AddObsBlockToList, GetObsBlockFromList use OpenSpecModule, only: ACCESS, ACTION, FORM use SimModule, only: count_errors, print_notes, store_error, & - store_error_unit, ustop, write_message + store_error_unit, ustop use UtilitiesModule, only: get_extension, CalcContribFactors implicit none @@ -203,8 +201,6 @@ subroutine read_options(this) ierr = 0 ! ! -- get BEGIN line of OPTIONS block -! call uget_block(iin, 0, blockTypeWanted, ierr, found, & -! lloc, line, iuext, continueread) call this%parser%GetBlock('OPTIONS', found, ierr, supportOpenClose=.true.) if (ierr /= 0) then ! end of file @@ -733,7 +729,6 @@ subroutine read_any_block(this, iu ,k, eof, dis3d, WriteBeginEnd) ! ! -- Read any block as long as it's SINGLE or CONTINUOUS. lloc = 1 -! call uget_any_block(iu, this%iout, isfound, lloc, line, ctagfound, iuext) call this%parser%GetBlock('*', isfound, ierr, .true., & .false., ctagfound) if (.not. isfound) then diff --git a/utils/mf5to6/src/Preproc/Utilities.f90 b/utils/mf5to6/src/Preproc/Utilities.f90 index 3d97b4c0618..13e7ec9c3f4 100644 --- a/utils/mf5to6/src/Preproc/Utilities.f90 +++ b/utils/mf5to6/src/Preproc/Utilities.f90 @@ -3,8 +3,7 @@ module UtilitiesModule use ConstantsModule, only: MAXCHARLEN, DZERO, MAXCHARLEN use GlobalVariablesModule, only: optfile, PathToPostObsMf, ScriptType, & verbose, echo - use InputOutputModule, only: GetUnit, openfile, UPCASE, URWORD, & - uget_block, uterminate_block, u9rdcom + use InputOutputModule, only: GetUnit, openfile, UPCASE, URWORD use SimModule, onlY: store_error, store_note, store_warning, ustop private @@ -15,7 +14,7 @@ module UtilitiesModule BuildArrayFormat, Write1dValues, & Write2dValues, Write3dValues, findcell, & close_file, GreaterOf, GreatestOf, RemoveElement, & - get_extension, ReadMf5to6Options, count_file_records, & + get_extension, count_file_records, & CalcContribFactors, PhmfOption interface RemoveElement @@ -876,65 +875,6 @@ subroutine get_extension(name, ext) return end subroutine get_extension - subroutine ReadMf5to6Options() - implicit none - ! local - integer :: ierr, istart, istop, iu, idum, icol - double precision :: rdum - character(len=MAXCHARLEN) :: ermsg - character(len=:), allocatable :: line - character(len=10) :: stype - logical :: continueread=.true., found - integer :: iuext - ! - if (optfile /= '') then - iu = GetUnit() - call openfile(iu, 0, optfile, 'OPTIONS', filstat_opt='OLD') - call uget_block(iu, 0, 'OPTIONS', ierr, found, icol, line, iuext, & - continueread) - if (found) then - do - icol = 1 - call u9rdcom(iu, 0, line, ierr) - call urword(line, icol, istart, istop, 1, idum, rdum, 0, iu) - select case (line(istart:istop)) - case ('PATHTOPOSTOBSMF') - call urword(line, icol, istart, istop, 0, idum, rdum, 0, iu) - PathToPostObsMf = line(istart:istop) - case ('SCRIPT') - call urword(line, icol, istart, istop, 1, idum, rdum, 0, iu) - stype = line(istart:istop) - select case (stype) - case ('BATCH') - ScriptType = 'BATCH' - case ('PYTHON') - ScriptType = 'PYTHON' - case default - ermsg = 'Unknown Script option: ' // line(istart:istop) - call store_error(ermsg) - call ustop() - end select - case default - ermsg = 'Unknown Mf5to6 option: ' // line(istart:istop) - call store_error(ermsg) - call ustop() - case ('END','BEGIN') - call uterminate_block(iu,0,line(istart:istop), & - 'OPTIONS', icol,line,ierr, iuext) - if(ierr==0) exit - end select - enddo - close(iu) - else - ermsg = 'Mf5to6 options file not found: ' // trim(optfile) - call store_error(ermsg) - call ustop() - endif - endif - ! - return - end subroutine ReadMf5to6Options - function count_file_records(filename) result(nrecs) ! Open a text file, count the number of records in it, and close the file. ! dummy diff --git a/utils/mf5to6/src/mf5to6.f90 b/utils/mf5to6/src/mf5to6.f90 index 1e7b07dc8da..ecf2131c8de 100644 --- a/utils/mf5to6/src/mf5to6.f90 +++ b/utils/mf5to6/src/mf5to6.f90 @@ -19,7 +19,7 @@ program mf5to6 use SimFileWriterModule, only: SimFileWriterType use SimModule, only: ustop use SimListVariablesModule, only: SimMovers - use UtilitiesModule, only: GetArgs, ReadMf5to6Options, PhmfOption + use UtilitiesModule, only: GetArgs, PhmfOption ! implicit none integer :: iexg, igrid, ispw, iu @@ -69,7 +69,6 @@ program mf5to6 ! provide a command-prompt instruction that will run PostObsMF, or maybe ! generate a batch or python file (could also be an option) that would ! run PostObsMF (twice, if there are multilayer head observations). - if (SupportPreproc) call ReadMf5to6Options() SimFileWriter%BaseName = basnam if (ilgr > 0) then ! LGR is active; read and initialize parent and all children. diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index 919f5ed9b06..c0eadf7ac21 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.7) for the 'zbud6' executable. +# makedefaults created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -57,19 +57,16 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition diff --git a/utils/zonebudget/make/makefile b/utils/zonebudget/make/makefile index 092dc3b0294..8a24ed1c082 100644 --- a/utils/zonebudget/make/makefile +++ b/utils/zonebudget/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.7) for the 'zbud6' executable. +# makefile created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. include ./makedefaults @@ -16,16 +16,18 @@ ${SOURCEDIR2} OBJECTS = \ $(OBJDIR)/kind.o \ $(OBJDIR)/Constants.o \ +$(OBJDIR)/ErrorUtil.o \ $(OBJDIR)/SimVariables.o \ -$(OBJDIR)/genericutils.o \ +$(OBJDIR)/ArrayHandlers.o \ +$(OBJDIR)/Message.o \ $(OBJDIR)/defmacro.o \ $(OBJDIR)/compilerversion.o \ -$(OBJDIR)/ArrayHandlers.o \ $(OBJDIR)/version.o \ -$(OBJDIR)/Message.o \ $(OBJDIR)/Sim.o \ $(OBJDIR)/OpenSpec.o \ $(OBJDIR)/InputOutput.o \ +$(OBJDIR)/LongLineReader.o \ +$(OBJDIR)/DevFeature.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/BlockParser.o \ $(OBJDIR)/ArrayReaders.o \ @@ -34,6 +36,8 @@ $(OBJDIR)/Budget.o \ $(OBJDIR)/zoneoutput.o \ $(OBJDIR)/grb.o \ $(OBJDIR)/budgetdata.o \ +$(OBJDIR)/MathUtil.o \ +$(OBJDIR)/GeomUtil.o \ $(OBJDIR)/zbud6.o # Define the objects that make up the program diff --git a/utils/zonebudget/msvs/zonebudget.vfproj b/utils/zonebudget/msvs/zonebudget.vfproj index 682849e3f29..f6e8613efd2 100644 --- a/utils/zonebudget/msvs/zonebudget.vfproj +++ b/utils/zonebudget/msvs/zonebudget.vfproj @@ -1,28 +1,32 @@ - + + - - - - - - - - - + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + @@ -34,14 +38,17 @@ - + - - + + + + + @@ -52,5 +59,7 @@ - - + + + + diff --git a/utils/zonebudget/pymake/extrafiles.txt b/utils/zonebudget/pymake/extrafiles.txt index c4cfdf23967..54d11147ff3 100644 --- a/utils/zonebudget/pymake/extrafiles.txt +++ b/utils/zonebudget/pymake/extrafiles.txt @@ -4,13 +4,17 @@ ../../../src/Utilities/Budget.f90 ../../../src/Utilities/Constants.f90 ../../../src/Utilities/compilerversion.F90 -../../../src/Utilities/genericutils.f90 +../../../src/Utilities/ErrorUtil.f90 +../../../src/Utilities/GeomUtil.f90 +../../../src/Utilities/MathUtil.f90 ../../../src/Utilities/InputOutput.f90 ../../../src/Utilities/kind.f90 +../../../src/Utilities/LongLineReader.f90 ../../../src/Utilities/OpenSpec.f90 ../../../src/Utilities/sort.f90 -../../../src/Utilities/Message.f90 ../../../src/Utilities/defmacro.F90 ../../../src/Utilities/Sim.f90 ../../../src/Utilities/SimVariables.f90 ../../../src/Utilities/version.f90 +../../../src/Utilities/DevFeature.f90 +../../../src/Utilities/Message.f90 diff --git a/utils/zonebudget/src/zbud6.f90 b/utils/zonebudget/src/zbud6.f90 index fedccae4ee9..29a5c98e85e 100644 --- a/utils/zonebudget/src/zbud6.f90 +++ b/utils/zonebudget/src/zbud6.f90 @@ -4,7 +4,7 @@ program zonbudmf6 use VersionModule, only: VERSION use SimVariablesModule, only: iout, errmsg use SimModule, only: store_error - use GenericUtilitiesModule, only: sim_message, write_centered + use MessageModule, only: write_message, write_message_centered use InputOutputModule, only: openfile implicit none @@ -21,9 +21,9 @@ program zonbudmf6 logical :: exists ! -- Write title to screen - call write_centered('ZONEBUDGET'//mfvnam, 80) - call write_centered('U.S. GEOLOGICAL SURVEY', 80) - call write_centered('VERSION '//VERSION, 80) + call write_message_centered('ZONEBUDGET'//mfvnam, 80) + call write_message_centered('U.S. GEOLOGICAL SURVEY', 80) + call write_message_centered('VERSION '//VERSION, 80) ! ! -- Find name of zone budget name file and lst file fnam = 'zbud.nam' @@ -37,9 +37,9 @@ program zonbudmf6 ! -- Open list file and write title iout = iunit_lst call openfile(iunit_lst, 0, flst, 'LIST', filstat_opt='REPLACE') - call write_centered('ZONEBUDGET'//mfvnam, 80, iunit=iout) - call write_centered('U.S. GEOLOGICAL SURVEY', 80, iunit=iout) - call write_centered('VERSION '//VERSION, 80, iunit=iout) + call write_message_centered('ZONEBUDGET'//mfvnam, 80, iunit=iout) + call write_message_centered('U.S. GEOLOGICAL SURVEY', 80, iunit=iout) + call write_message_centered('VERSION '//VERSION, 80, iunit=iout) ! ! -- Open name file, read name file, and open csv file call openfile(iunit_nam, iout, fnam, 'NAM') @@ -54,7 +54,7 @@ program zonbudmf6 close (iunit_lst) close (iunit_csv) write (line, '(a)') 'Normal Termination' - call sim_message(line, skipbefore=1) + call write_message(line, skipbefore=1) ! ! -- end of program end program zonbudmf6 @@ -144,7 +144,6 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) use KindModule use ConstantsModule, only: LINELENGTH use SimVariablesModule, only: iout, errmsg - use GenericUtilitiesModule, only: sim_message use SimModule, only: store_error use BudgetDataModule, only: budgetdata_init, budgetdata_read, & budgetdata_finalize, & @@ -160,6 +159,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) use ZoneOutputModule, only: zoneoutput_init, zoneoutput_write, & zoneoutput_finalize use GrbModule, only: read_grb + use MessageModule, only: write_message, write_message_centered implicit none ! -- dummy integer, intent(in) :: iunit_csv @@ -245,7 +245,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) end if ! ! -- write message and check - call sim_message(cdot, advance=.FALSE.) + call write_message(text=cdot, advance=.FALSE.) if (itime == 1) then budtxtarray(ibudterm) = budtxt packagenamearray(ibudterm) = dstpackagename @@ -298,7 +298,7 @@ subroutine process_budget(iunit_csv, iunit_bud, iunit_zon, iunit_grb) end do timeloop ! ! -- Finalize - call sim_message(cdot) + call write_message(text=cdot) call budgetdata_finalize() call zoneoutput_finalize() call zone_finalize() diff --git a/version.txt b/version.txt index b063daa0c02..8e0a2119a7d 100644 --- a/version.txt +++ b/version.txt @@ -1,10 +1 @@ -# MODFLOW 6 version file automatically created using...update_version.py -# created on...June 28, 2023 19:45:12 - -major = 6 -minor = 4 -micro = 2 -label = '' -__version__ = '{:d}.{:d}.{:d}'.format(major, minor, micro) -if label: - __version__ += '{}{}'.format(__version__, label) \ No newline at end of file +6.4.3 \ No newline at end of file