From e7315bdb75d4b95200082347c45c1de9eba7932e Mon Sep 17 00:00:00 2001 From: w-bonelli Date: Tue, 28 Mar 2023 16:52:21 -0400 Subject: [PATCH 1/4] feat(PRT): add particle tracking model Co-authored-by: Alden Provost --- .github/common/update_fortran_style.py | 159 +++ .github/workflows/ci.yml | 6 + CITATION.cff | 2 +- README.md | 4 +- autotest/TestGeomUtil.f90 | 1 + autotest/TestList.f90 | 1 - autotest/TestMathUtil.f90 | 44 +- autotest/TestTimeSelect.f90 | 111 ++ autotest/build_mfio_tex.py | 2 +- autotest/framework.py | 20 +- autotest/meson.build | 3 +- autotest/prt_test_utils.py | 398 ++++++ autotest/test_examples.py | 5 + autotest/test_gwf_ats02.py | 2 +- autotest/test_prt_budget.py | 350 +++++ autotest/test_prt_disv1.py | 486 +++++++ autotest/test_prt_drape.py | 328 +++++ autotest/test_prt_exg.py | 326 +++++ autotest/test_prt_fmi.py | 383 ++++++ autotest/test_prt_notebooks.py | 250 ++++ autotest/test_prt_release_timing.py | 422 ++++++ autotest/test_prt_stop_zones.py | 424 ++++++ autotest/test_prt_ternary_methods.py | 194 +++ autotest/test_prt_track_events.py | 514 +++++++ autotest/test_prt_triangle.py | 297 ++++ autotest/test_prt_voronoi1.py | 412 ++++++ autotest/test_prt_voronoi2.py | 434 ++++++ autotest/test_prt_weak_sinks.py | 380 ++++++ autotest/tester.f90 | 4 +- doc/mf6io/body.tex | 5 + doc/mf6io/mf6ivar/dfn/exg-gwfprt.dfn | 3 + doc/mf6io/mf6ivar/dfn/prt-dis.dfn | 122 ++ doc/mf6io/mf6ivar/dfn/prt-disv.dfn | 204 +++ doc/mf6io/mf6ivar/dfn/prt-fmi.dfn | 50 + doc/mf6io/mf6ivar/dfn/prt-mip.dfn | 40 + doc/mf6io/mf6ivar/dfn/prt-nam.dfn | 73 + doc/mf6io/mf6ivar/dfn/prt-oc.dfn | 497 +++++++ doc/mf6io/mf6ivar/dfn/prt-prp.dfn | 355 +++++ doc/mf6io/mf6ivar/dfn/sln-pts.dfn | 178 +++ .../mf6ivar/examples/prt-fmi-example.dat | 8 + .../mf6ivar/examples/prt-mip-example.dat | 10 + .../mf6ivar/examples/prt-nam-example.dat | 11 + doc/mf6io/mf6ivar/examples/prt-oc-example.dat | 10 + .../mf6ivar/examples/prt-prp-example.dat | 18 + .../mf6ivar/examples/utl-obs-prt-example.dat | 18 + doc/mf6io/mf6ivar/md/mf6ivar.md | 128 +- doc/mf6io/mf6ivar/md/mf6memvar.md | 75 + doc/mf6io/mf6ivar/mf6ivar.py | 9 + doc/mf6io/mf6ivar/readme.md | 2 +- doc/mf6io/mf6ivar/tex/appendixA.tex | 30 + doc/mf6io/mf6ivar/tex/exg-gwfprt-desc.tex | 3 + doc/mf6io/mf6ivar/tex/gwf-drn-desc.tex | 4 +- doc/mf6io/mf6ivar/tex/gwf-ghb-desc.tex | 6 +- doc/mf6io/mf6ivar/tex/gwf-riv-desc.tex | 6 +- doc/mf6io/mf6ivar/tex/prt-dis-desc.tex | 41 + doc/mf6io/mf6ivar/tex/prt-dis-dimensions.dat | 5 + doc/mf6io/mf6ivar/tex/prt-dis-griddata.dat | 12 + doc/mf6io/mf6ivar/tex/prt-dis-options.dat | 7 + doc/mf6io/mf6ivar/tex/prt-disv-cell2d.dat | 5 + doc/mf6io/mf6ivar/tex/prt-disv-desc.tex | 61 + doc/mf6io/mf6ivar/tex/prt-disv-dimensions.dat | 5 + doc/mf6io/mf6ivar/tex/prt-disv-griddata.dat | 8 + doc/mf6io/mf6ivar/tex/prt-disv-options.dat | 7 + doc/mf6io/mf6ivar/tex/prt-disv-vertices.dat | 5 + doc/mf6io/mf6ivar/tex/prt-fmi-desc.tex | 19 + doc/mf6io/mf6ivar/tex/prt-fmi-options.dat | 3 + doc/mf6io/mf6ivar/tex/prt-fmi-packagedata.dat | 5 + doc/mf6io/mf6ivar/tex/prt-mip-desc.tex | 19 + doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat | 8 + doc/mf6io/mf6ivar/tex/prt-mip-options.dat | 3 + doc/mf6io/mf6ivar/tex/prt-nam-desc.tex | 25 + doc/mf6io/mf6ivar/tex/prt-nam-options.dat | 6 + doc/mf6io/mf6ivar/tex/prt-nam-packages.dat | 5 + doc/mf6io/mf6ivar/tex/prt-oc-desc.tex | 93 ++ doc/mf6io/mf6ivar/tex/prt-oc-options.dat | 17 + doc/mf6io/mf6ivar/tex/prt-oc-period.dat | 4 + doc/mf6io/mf6ivar/tex/prt-prp-desc.tex | 85 ++ doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat | 3 + doc/mf6io/mf6ivar/tex/prt-prp-options.dat | 12 + doc/mf6io/mf6ivar/tex/prt-prp-packagedata.dat | 5 + doc/mf6io/mf6ivar/tex/prt-prp-period.dat | 5 + doc/mf6io/mf6ivar/tex/sln-pts-desc.tex | 33 + doc/mf6io/mf6ivar/tex/sln-pts-nonlinear.dat | 3 + doc/mf6io/mf6ivar/tex/sln-pts-options.dat | 8 + doc/mf6io/mf6ivar/tex/swf-dfw-desc.tex | 2 +- doc/mf6io/prt/fmi.tex | 50 + doc/mf6io/prt/mip.tex | 16 + doc/mf6io/prt/namefile.tex | 42 + doc/mf6io/prt/oc.tex | 25 + doc/mf6io/prt/prp.tex | 25 + doc/mf6io/prt/prt-obs.tex | 39 + doc/mf6io/prt/prt.tex | 66 + environment.yml | 4 +- make/makefile | 122 +- msvs/mf6.vfproj | 6 +- msvs/mf6core.vfproj | 50 +- msvs/mf6lib.vfproj | 1 - src/Exchange/exg-gwfprt.f90 | 356 +++++ src/Idm/exg-gwfprtidm.f90 | 70 + src/Idm/prt-disidm.f90 | 313 +++++ src/Idm/prt-disvidm.f90 | 460 +++++++ src/Idm/prt-mipidm.f90 | 136 ++ src/Idm/prt-namidm.f90 | 196 +++ src/Idm/selector/IdmDfnSelector.f90 | 13 + src/Idm/selector/IdmExgDfnSelector.f90 | 11 + src/Idm/selector/IdmPrtDfnSelector.f90 | 127 ++ src/Model/ExplicitModel.f90 | 2 +- src/Model/GroundWaterFlow/gwf-disv.f90 | 2 +- src/Model/GroundWaterFlow/gwf-mvr.f90 | 1 - .../ModelUtilities/FlowModelInterface.f90 | 4 +- .../ModelUtilities/ModelPackageInput.f90 | 18 +- src/Model/ModelUtilities/TimeSelect.f90 | 167 +++ src/Model/ModelUtilities/TrackData.f90 | 324 +++++ src/Model/NumericalModel.f90 | 5 + src/Model/ParticleTracking/prt-fmi.f90 | 225 +++ src/Model/ParticleTracking/prt-mip.f90 | 150 ++ src/Model/ParticleTracking/prt-obs.f90 | 235 ++++ src/Model/ParticleTracking/prt-oc.f90 | 376 ++++++ src/Model/ParticleTracking/prt-prp.f90 | 984 ++++++++++++++ src/Model/ParticleTracking/prt.f90 | 1202 +++++++++++++++++ src/Model/TransportModel/tsp-mvt.f90 | 1 - src/Model/TransportModel/tsp.f90 | 1 - src/SimulationCreate.f90 | 18 +- src/Solution/ExplicitSolution.f90 | 39 +- src/Solution/ParticleTracker/Cell.f90 | 24 + src/Solution/ParticleTracker/CellDefn.f90 | 90 ++ src/Solution/ParticleTracker/CellPoly.f90 | 34 + src/Solution/ParticleTracker/CellRect.f90 | 54 + src/Solution/ParticleTracker/CellRectQuad.f90 | 220 +++ src/Solution/ParticleTracker/CellUtil.f90 | 169 +++ src/Solution/ParticleTracker/Method.f90 | 208 +++ .../ParticleTracker/MethodCellPassToBot.f90 | 61 + .../ParticleTracker/MethodCellPollock.f90 | 201 +++ .../ParticleTracker/MethodCellPollockQuad.f90 | 363 +++++ .../ParticleTracker/MethodCellPool.f90 | 41 + .../ParticleTracker/MethodCellTernary.f90 | 397 ++++++ src/Solution/ParticleTracker/MethodDis.f90 | 444 ++++++ src/Solution/ParticleTracker/MethodDisv.f90 | 786 +++++++++++ src/Solution/ParticleTracker/MethodPool.f90 | 30 + .../ParticleTracker/MethodSubcellPollock.f90 | 452 +++++++ .../ParticleTracker/MethodSubcellPool.f90 | 31 + .../ParticleTracker/MethodSubcellTernary.f90 | 495 +++++++ src/Solution/ParticleTracker/Particle.f90 | 361 +++++ src/Solution/ParticleTracker/Subcell.f90 | 31 + src/Solution/ParticleTracker/SubcellRect.f90 | 45 + src/Solution/ParticleTracker/SubcellTri.f90 | 43 + .../ParticleTracker/TernarySolveTrack.f90 | 972 +++++++++++++ src/Utilities/BlockParser.f90 | 27 +- src/Utilities/GeomUtil.f90 | 21 +- src/Utilities/MathUtil.f90 | 16 +- src/Utilities/Observation/Obs.f90 | 2 +- src/meson.build | 54 +- utils/idmloader/dfns.txt | 9 +- 153 files changed, 19756 insertions(+), 153 deletions(-) create mode 100644 .github/common/update_fortran_style.py create mode 100644 autotest/TestTimeSelect.f90 create mode 100644 autotest/prt_test_utils.py create mode 100644 autotest/test_prt_budget.py create mode 100644 autotest/test_prt_disv1.py create mode 100644 autotest/test_prt_drape.py create mode 100644 autotest/test_prt_exg.py create mode 100644 autotest/test_prt_fmi.py create mode 100644 autotest/test_prt_notebooks.py create mode 100644 autotest/test_prt_release_timing.py create mode 100644 autotest/test_prt_stop_zones.py create mode 100644 autotest/test_prt_ternary_methods.py create mode 100644 autotest/test_prt_track_events.py create mode 100644 autotest/test_prt_triangle.py create mode 100644 autotest/test_prt_voronoi1.py create mode 100644 autotest/test_prt_voronoi2.py create mode 100644 autotest/test_prt_weak_sinks.py create mode 100644 doc/mf6io/mf6ivar/dfn/exg-gwfprt.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-dis.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-disv.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-fmi.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-mip.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-nam.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-oc.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/prt-prp.dfn create mode 100644 doc/mf6io/mf6ivar/dfn/sln-pts.dfn create mode 100644 doc/mf6io/mf6ivar/examples/prt-fmi-example.dat create mode 100644 doc/mf6io/mf6ivar/examples/prt-mip-example.dat create mode 100644 doc/mf6io/mf6ivar/examples/prt-nam-example.dat create mode 100644 doc/mf6io/mf6ivar/examples/prt-oc-example.dat create mode 100644 doc/mf6io/mf6ivar/examples/prt-prp-example.dat create mode 100644 doc/mf6io/mf6ivar/examples/utl-obs-prt-example.dat create mode 100644 doc/mf6io/mf6ivar/tex/exg-gwfprt-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-dis-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-dis-dimensions.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-dis-griddata.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-dis-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-cell2d.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-dimensions.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-griddata.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-disv-vertices.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-fmi-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-fmi-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-fmi-packagedata.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-mip-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-mip-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-nam-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-nam-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-nam-packages.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-oc-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-oc-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-oc-period.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-prp-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-prp-options.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-prp-packagedata.dat create mode 100644 doc/mf6io/mf6ivar/tex/prt-prp-period.dat create mode 100644 doc/mf6io/mf6ivar/tex/sln-pts-desc.tex create mode 100644 doc/mf6io/mf6ivar/tex/sln-pts-nonlinear.dat create mode 100644 doc/mf6io/mf6ivar/tex/sln-pts-options.dat create mode 100644 doc/mf6io/prt/fmi.tex create mode 100644 doc/mf6io/prt/mip.tex create mode 100644 doc/mf6io/prt/namefile.tex create mode 100644 doc/mf6io/prt/oc.tex create mode 100644 doc/mf6io/prt/prp.tex create mode 100644 doc/mf6io/prt/prt-obs.tex create mode 100644 doc/mf6io/prt/prt.tex create mode 100644 src/Exchange/exg-gwfprt.f90 create mode 100644 src/Idm/exg-gwfprtidm.f90 create mode 100644 src/Idm/prt-disidm.f90 create mode 100644 src/Idm/prt-disvidm.f90 create mode 100644 src/Idm/prt-mipidm.f90 create mode 100644 src/Idm/prt-namidm.f90 create mode 100644 src/Idm/selector/IdmPrtDfnSelector.f90 create mode 100644 src/Model/ModelUtilities/TimeSelect.f90 create mode 100644 src/Model/ModelUtilities/TrackData.f90 create mode 100644 src/Model/ParticleTracking/prt-fmi.f90 create mode 100644 src/Model/ParticleTracking/prt-mip.f90 create mode 100644 src/Model/ParticleTracking/prt-obs.f90 create mode 100644 src/Model/ParticleTracking/prt-oc.f90 create mode 100644 src/Model/ParticleTracking/prt-prp.f90 create mode 100644 src/Model/ParticleTracking/prt.f90 create mode 100644 src/Solution/ParticleTracker/Cell.f90 create mode 100644 src/Solution/ParticleTracker/CellDefn.f90 create mode 100644 src/Solution/ParticleTracker/CellPoly.f90 create mode 100644 src/Solution/ParticleTracker/CellRect.f90 create mode 100644 src/Solution/ParticleTracker/CellRectQuad.f90 create mode 100644 src/Solution/ParticleTracker/CellUtil.f90 create mode 100644 src/Solution/ParticleTracker/Method.f90 create mode 100644 src/Solution/ParticleTracker/MethodCellPassToBot.f90 create mode 100644 src/Solution/ParticleTracker/MethodCellPollock.f90 create mode 100644 src/Solution/ParticleTracker/MethodCellPollockQuad.f90 create mode 100644 src/Solution/ParticleTracker/MethodCellPool.f90 create mode 100644 src/Solution/ParticleTracker/MethodCellTernary.f90 create mode 100644 src/Solution/ParticleTracker/MethodDis.f90 create mode 100644 src/Solution/ParticleTracker/MethodDisv.f90 create mode 100644 src/Solution/ParticleTracker/MethodPool.f90 create mode 100644 src/Solution/ParticleTracker/MethodSubcellPollock.f90 create mode 100644 src/Solution/ParticleTracker/MethodSubcellPool.f90 create mode 100644 src/Solution/ParticleTracker/MethodSubcellTernary.f90 create mode 100644 src/Solution/ParticleTracker/Particle.f90 create mode 100644 src/Solution/ParticleTracker/Subcell.f90 create mode 100644 src/Solution/ParticleTracker/SubcellRect.f90 create mode 100644 src/Solution/ParticleTracker/SubcellTri.f90 create mode 100644 src/Solution/ParticleTracker/TernarySolveTrack.f90 diff --git a/.github/common/update_fortran_style.py b/.github/common/update_fortran_style.py new file mode 100644 index 00000000000..6b71687198a --- /dev/null +++ b/.github/common/update_fortran_style.py @@ -0,0 +1,159 @@ +import argparse +import re +from contextlib import nullcontext +from itertools import repeat +from pathlib import Path +from typing import Iterator, Optional +from warnings import warn + +from fprettify.fparse_utils import InputStream + +INTENT_PATTERN = re.compile(r".*(intent\(.+\)).*") + + +def get_intent(s) -> Optional[str]: + result = INTENT_PATTERN.match(s) + return result.group(1) if result else None + + +def get_param(s) -> bool: + return "parameter" in s + + +def get_comments(comments) -> Iterator[str]: + for comment in comments: + if not any(comment): + continue + yield comment.rstrip() + + +class Transforms: + @staticmethod + def separate_lines(path, overwrite=False): + """Variables defined on separate lines""" + + flines = [] + with open(path, "r") as f: + stream = InputStream(f) + while 1: + line, comments, lines = stream.next_fortran_line() + if not lines: + break + line = line.rstrip() + parts = line.rpartition("::") + comments = " " + "".join(get_comments(comments)) + if not parts[1] or "procedure" in parts[0]: + for l in lines: + flines.append(l.rstrip()) + continue + + nspaces = len(lines[0]) - len(lines[0].lstrip()) + prefix = "".join(repeat(" ", nspaces)) + vtype = parts[0].split(",")[0].strip() + split = parts[2].split(",") + intent = get_intent(parts[0]) + param = get_param(parts[0]) + + if not line: + continue + if (len(parts[0]) == 0 and len(parts[1]) == 0) or ( + "(" in parts[2] or ")" in parts[2] + ): + flines.append(prefix + line + comments) + elif len(split) == 1: + flines.append(prefix + line + comments) + elif param: + flines.append(prefix + line + comments) + else: + for s in split: + if s.strip() == "&": + continue + l = prefix + vtype + if intent: + l += f", {intent}" + l += f" :: {s.strip()}" + flines.append(l + comments) + + with open(path, "w") if overwrite else nullcontext() as f: + + def write(line): + if overwrite: + f.write(line + "\n") + else: + print(line) + + for line in flines: + write(line) + + @staticmethod + def no_return_statements(path, overwrite=False): + """Remove return statements at the end of routines""" + # todo + pass + + @staticmethod + def no_empty_comments(path, overwrite=False): + """Remove comments on lines with only whitespace""" + # todo + pass + + +def reformat(path, overwrite, separate_lines, no_return_statements, no_empty_comments): + if separate_lines: + Transforms.separate_lines(path, overwrite=overwrite) + if no_return_statements: + Transforms.no_return_statements(path, overwrite=overwrite) + warn("--no-return not implemented yet") + if no_empty_comments: + Transforms.no_empty_comments(path, overwrite=overwrite) + warn("--no-empty-comments not implemented yet") + + +if __name__ == "__main__": + parser = argparse.ArgumentParser( + """ + Modify MODFLOW 6 Fortran source code, either writing to stdout or + overwriting the input file. Options are provided for several code + styles. + """ + ) + parser.add_argument( + "-i", "--input", help="path to input file" # todo: or directory + ) + parser.add_argument( + "-f", + "--force", + action="store_true", + default=False, + required=False, + help="overwrite/reformat files", + ) + parser.add_argument( + "--separate-lines", + action="store_true", + default=True, + required=False, + help="define variables on separate lines", + ) + parser.add_argument( + "--no-return_statements", + action="store_true", + default=False, + required=False, + help="no return statements at the end of routines", + ) + parser.add_argument( + "--no-empty-comments", + action="store_true", + default=False, + required=False, + help="no empty comments", + ) + args = parser.parse_args() + reformat( + path=Path(args.input).expanduser().absolute(), + overwrite=args.force, + separate_lines=args.separate_lines, + no_return_statements=args.no_return_statements, + no_empty_comments=args.no_empty_comments, + ) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 36d47d7bfce..365a55d7d0a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -336,6 +336,12 @@ jobs: 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 Micromamba uses: mamba-org/setup-micromamba@v1 diff --git a/CITATION.cff b/CITATION.cff index 094e7d0686d..08cfa01c6d4 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -55,7 +55,7 @@ authors: alias: mjreno - family-names: Bonelli given-names: Wesley P. - alias: w-bonelli + alias: wpbonelli affiliation: U.S. Geological Survey orcid: https://orcid.org/0000-0002-2665-5078 - family-names: Boyce diff --git a/README.md b/README.md index 15ec9fb662f..0acb60eac81 100644 --- a/README.md +++ b/README.md @@ -67,12 +67,14 @@ Instructions for building definition files for new packages are summarized in [d MODFLOW is a popular open-source groundwater flow model distributed by the U.S. Geological Survey. For 30 years, the MODFLOW program has been widely used by academic researchers, private consultants, and government scientists to accurately, reliably, and efficiently simulate groundwater flow. With time, growing interest in surface and groundwater interactions, local refinement with nested and unstructured grids, karst groundwater flow, solute transport, and saltwater intrusion, has led to the development of numerous MODFLOW versions. Although these MODFLOW versions are often based on the core version (presently MODFLOW-2005), there are often incompatibilities that restrict their use with one another. In many cases, development of these alternative versions has been challenging due to the underlying MODFLOW structure, which was designed for the simulation with a single groundwater flow model using a rectilinear grid. -MODFLOW 6 is the latest core version of MODFLOW. It synthesizes many of the capabilities available in MODFLOW-2005, MODFLOW-NWT, and MODFLOW-LGR. MODFLOW 6 was built on a new object-oriented framework that allows new packages and models to be added, and allows any number of models to be run simultaneously in a single simulation. Model may be coupled sequentially, such as for flow and transport, or the models may be tightly coupled at the matrix level, such as for multiple flow models. MODFLOW 6 presently contains two types of hydrologic models, the Groundwater Flow (GWF) Model and the Groundwater Transport (GWT) Model. +MODFLOW 6 is the latest core version of MODFLOW. It synthesizes many of the capabilities available in MODFLOW-2005, MODFLOW-NWT, and MODFLOW-LGR. MODFLOW 6 was built on a new object-oriented framework that allows new packages and models to be added, and allows any number of models to be run simultaneously in a single simulation. Model may be coupled sequentially, such as for flow and transport, or the models may be tightly coupled at the matrix level, such as for multiple flow models. MODFLOW 6 presently contains three types of hydrologic models, the Groundwater Flow (GWF) Model, the Groundwater Transport (GWT) Model, and the Particle Tracking (PRT) Model. The Groundwater Flow (GWF) Model was the first model to be released in MODFLOW 6. It supports regular MODFLOW grids consisting of layers, rows, and columns, but it also supports more flexible grids that may conform to irregular boundaries or have increased resolution in areas of interest. The GWF Model consists of the original MODFLOW stress packages (CHD, WEL, DRN, RIV, GHB, RCH, and EVT) and four advanced stress packages (MAW, SFR, LAK, and UZF), which have been distilled from their predecessors to contain the most commonly used capabilities. MODFLOW 6 contains a new Water Mover (MVR) Package that can transfer water from provider packages to receiver packages. Providers can be many of the stress and advanced stress packages; receivers can be any of the advanced stress packages. This new capability makes it possible to route water between lakes and streams, route rejected infiltration into a nearby stream, or augment lakes using groundwater pumped from wells, for example. To modernize user interaction with the program, the MODFLOW 6 input structure was redesigned. Within package input files, information is divided into blocks, and informative keywords are used to label numeric data and activate options. This new input structure was designed to make it easier for users to adjust simulation options in an intuitive manner, reduce user input errors, and allow new capabilities to be added without causing problems with backward compatibility. The GWT model for MODFLOW 6 simulates three-dimensional transport of a single solute species in flowing groundwater. The GWT Model solves the solute transport equation using numerical methods and a generalized CVFD approach, which can be used with regular MODFLOW grids or with unstructured grids. The GWT Model is designed to work with most of the new capabilities released with the GWF Model, including the Newton flow formulation, unstructured grids, advanced packages, and the movement of water between packages. The GWF and GWT Models operate simultaneously during a MODFLOW 6 simulation to represent coupled groundwater flow and solute transport. The GWT Model can also run separately from a GWF Model by reading the heads and flows saved by a previously run GWF Model. The GWT model is also capable of working with the flows from another groundwater flow model, as long as the flows from that model can be written in the correct form to flow and head files. +The Particle Tracking (PRT) Model simulates three-dimensional particle trajectories in flowing groundwater. The PRT Model can operate simultaneously with a GWF model via an exchange, or can consume GWF outputs via Flow Model Interface (FMI). The PRT Model solves structured DIS grids analytically and unstructured DISV grids semi-analytically. Tracking delegates from the model domain to individual cells, and to sub-components of cells for DISV grids. On structured grids the approach reduces to Pollock's method used in MODPATH 7. On DISV grids, polygonal cells are decomposed into triangles, within which particle exit faces/times are solved numerically. Track data are recorded at the boundaries between spatial volumes (cells or subcells) and time segments (timesteps or stress periods), and at other relevant times, e.g. release and termination. Events to record may be configured by the user. Though each particle's motion may be computed independently, parallel solving is not yet supported. Particle exchange between models is also planned but not yet supported. Particle mass is conserved at the cell level, but may not be conserved at the subcell level for DISV grids. + ## How to Cite MODFLOW 6 diff --git a/autotest/TestGeomUtil.f90 b/autotest/TestGeomUtil.f90 index 3447f8eb6e9..933f485e7cd 100644 --- a/autotest/TestGeomUtil.f90 +++ b/autotest/TestGeomUtil.f90 @@ -292,6 +292,7 @@ subroutine test_point_in_polygon_irr(error) deallocate (face_pts) end subroutine test_point_in_polygon_irr + !> @brief Test 2D skew subroutine test_skew(error) type(error_type), allocatable, intent(out) :: error real(DP) :: v(2) diff --git a/autotest/TestList.f90 b/autotest/TestList.f90 index 605460ec9d2..0de78859e14 100644 --- a/autotest/TestList.f90 +++ b/autotest/TestList.f90 @@ -112,7 +112,6 @@ subroutine test_get_next_previous_item_reset(error) type(ListType), pointer :: list type(IntNodeType), pointer :: n1, n2, n3 class(*), pointer :: p - integer(I4B) :: i allocate (list) allocate (n1) diff --git a/autotest/TestMathUtil.f90 b/autotest/TestMathUtil.f90 index a07ad0af55c..18b377fd06d 100644 --- a/autotest/TestMathUtil.f90 +++ b/autotest/TestMathUtil.f90 @@ -4,7 +4,7 @@ module TestMathUtil 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 + zero_ch, zero_test, zero_br implicit none private public :: collect_mathutil @@ -19,12 +19,12 @@ subroutine collect_mathutil(testsuite) 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) & + new_unittest("zero_ch", & + test_zero_ch), & + new_unittest("zero_br", & + test_zero_br), & + new_unittest("zero_test", & + test_zero_test) & ] end subroutine collect_mathutil @@ -177,7 +177,7 @@ pure function sine(bet) result(s) s = sin(bet) end function sine - subroutine test_zeroch(error) + subroutine test_zero_ch(error) type(error_type), allocatable, intent(out) :: error real(DP), parameter :: pi = 4 * atan(1.0_DP) real(DP) :: z @@ -185,20 +185,20 @@ subroutine test_zeroch(error) f => sine - z = zeroch(-1.0_DP, 1.0_DP, f, 0.001_DP) + z = zero_ch(-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) + z = zero_ch(-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) + z = zero_ch(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 + end subroutine test_zero_ch - subroutine test_zeroin(error) + subroutine test_zero_br(error) type(error_type), allocatable, intent(out) :: error real(DP), parameter :: pi = 4 * atan(1.0_DP) real(DP) :: z @@ -206,20 +206,20 @@ subroutine test_zeroin(error) f => sine - z = zeroin(-1.0_DP, 1.0_DP, f, 0.001_DP) + z = zero_br(-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) + z = zero_br(-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) + z = zero_br(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 + end subroutine test_zero_br - subroutine test_zerotest(error) + subroutine test_zero_test(error) type(error_type), allocatable, intent(out) :: error real(DP), parameter :: pi = 4 * atan(1.0_DP) real(DP) :: z @@ -227,17 +227,17 @@ subroutine test_zerotest(error) f => sine - z = zerotest(-1.0_DP, 1.0_DP, f, 0.001_DP) + z = zero_test(-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) + z = zero_test(-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) + z = zero_test(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 subroutine test_zero_test end module TestMathUtil diff --git a/autotest/TestTimeSelect.f90 b/autotest/TestTimeSelect.f90 new file mode 100644 index 00000000000..a1b80a9de10 --- /dev/null +++ b/autotest/TestTimeSelect.f90 @@ -0,0 +1,111 @@ +module TestTimeSelect + use KindModule, only: I4B, DP, LGP + use testdrive, only: check, error_type, new_unittest, test_failed, & + to_string, unittest_type + use TimeSelectModule, only: TimeSelectType + use ConstantsModule, only: LINELENGTH + implicit none + private + public :: collect_timeselect + +contains + subroutine collect_timeselect(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("is_increasing", test_is_increasing), & + new_unittest("slice", test_slice) & + ] + end subroutine collect_timeselect + + subroutine test_is_increasing(error) + type(error_type), allocatable, intent(out) :: error + type(TimeSelectType) :: ts + + call ts%expand(3) + + ! increasing + ts%times = (/0.0_DP, 1.0_DP, 2.0_DP/) + call check(error, ts%increasing()) + + ! not decreasing + ts%times = (/0.0_DP, 0.0_DP, 2.0_DP/) + call check(error,.not. ts%increasing()) + + ! decreasing + ts%times = (/2.0_DP, 1.0_DP, 0.0_DP/) + call check(error,.not. ts%increasing()) + end subroutine + + subroutine test_slice(error) + type(error_type), allocatable, intent(out) :: error + type(TimeSelectType) :: ts + logical(LGP) :: changed + + call ts%expand(3) + ts%times = (/0.0_DP, 1.0_DP, 2.0_DP/) + call check( & + error, & + size(ts%times) == 3, & + "expected size 3, got"//to_string(size(ts%times))) + + ! empty slice + call ts%select(1.1_DP, 1.9_DP) + call check( & + error, & + ts%selection(1) == -1 .and. ts%selection(2) == -1, & + "empty slice failed, got ["// & + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! single-item slice + call ts%select(0.5_DP, 1.5_DP) + call check( & + error, & + ts%selection(1) == 2 .and. ts%selection(2) == 2, & + "1-item slice failed, got ["// & + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! multi-item slice + changed = .false. + call ts%select(0.5_DP, 2.5_DP, changed=changed) + call check(error, changed) + call check( & + error, & + ts%selection(1) == 2 .and. ts%selection(2) == 3, & + "2-item slice failed, got ["// & + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! no-change + call ts%select(0.1_DP, 2.5_DP, changed=changed) + call check(error,.not. changed) + call check( & + error, & + ts%selection(1) == 2 .and. ts%selection(2) == 3, & + "2-item slice failed, got ["// & + to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! lower bound equal to a time value + call ts%select(0.0_DP, 2.5_DP) + call check( & + error, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & + "lb eq slice failed, got [" & + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! upper bound equal to a time value + call ts%select(-0.5_DP, 2.0_DP) + call check( & + error, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & + "ub eq slice failed, got [" & + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + ! both bounds equal to a time value + call ts%select(0.0_DP, 2.0_DP) + call check( & + error, & + ts%selection(1) == 1 .and. ts%selection(2) == 3, & + "lb ub eq slice failed, got [" & + //to_string(ts%selection(1))//","//to_string(ts%selection(2))//"]") + + end subroutine test_slice +end module TestTimeSelect diff --git a/autotest/build_mfio_tex.py b/autotest/build_mfio_tex.py index aca75f8e242..04c79d8e969 100644 --- a/autotest/build_mfio_tex.py +++ b/autotest/build_mfio_tex.py @@ -31,7 +31,7 @@ def test_clean_latex(): files = [ f"{base_name}.pdf", f"{base_name}.aux", - f"{base_name}.bbl", + # f"{base_name}.bbl", ] delete_files(files, pth, allow_failure=True) return diff --git a/autotest/framework.py b/autotest/framework.py index 23de078b6ad..dfc0fa8d366 100644 --- a/autotest/framework.py +++ b/autotest/framework.py @@ -299,10 +299,19 @@ def _compare_heads( else: files2.append(None) - if self.cmp_namefile is None: + # todo: clean up namfile path detection? + nf = next(iter(get_namefiles(cpth)), None) + cmp_namefile = ( + None + if "mf6" in self.compare or "libmf6" in self.compare + else os.path.basename(nf) + if nf + else None + ) + if cmp_namefile is None: pth = None else: - pth = os.path.join(cpth, self.cmp_namefile) + pth = os.path.join(cpth, cmp_namefile) for i in range(len(files1)): file1 = files1[i] @@ -629,8 +638,13 @@ def _run_sim_or_model( else: # non-MF6 model try: + nf_ext = ".mpsim" if "mp7" in target.name else ".nam" + namefile = next(iter(workspace.glob(f"*{nf_ext}")), None) + assert ( + namefile + ), f"Control file with extension {nf_ext} not found" success, buff = flopy.run_model( - target, self.cmp_namefile, workspace, report=True + target, namefile, workspace, report=True ) except Exception: warn(f"{target} model failed:\n{format_exc()}") diff --git a/autotest/meson.build b/autotest/meson.build index a36d6e1e82e..dc9ee68a221 100644 --- a/autotest/meson.build +++ b/autotest/meson.build @@ -9,7 +9,8 @@ if test_drive.found() and not fc_id.contains('intel') 'List', 'MathUtil', 'Message', - 'Sim' + 'Sim', + 'TimeSelect' ] test_srcs = files( diff --git a/autotest/prt_test_utils.py b/autotest/prt_test_utils.py new file mode 100644 index 00000000000..ebce0529780 --- /dev/null +++ b/autotest/prt_test_utils.py @@ -0,0 +1,398 @@ +import os +from types import SimpleNamespace +from typing import Tuple + +import flopy +import matplotlib as mpl +import numpy as np + + +def all_equal(series, val): + a = series.to_numpy() + return a[0] == val and (a[0] == a).all() + + +class HorizontalCase: + nlay = 1 + nrow = 1 + ncol = 10 + top = 1 + botm = [0.0] + nper = 1 + perlen = 1.0 + nstp = 1 + tsmult = 1.0 + porosity = 0.1 + releasepts_mp7 = [ + # node number, localx, localy, localz + (0, float(f"0.{i + 1}"), float(f"0.{i + 1}"), 0.5) + for i in range(9) + ] + releasepts_prt = [ + # particle index, k, i, j, x, y, z + [i, 0, 0, 0, float(f"0.{i + 1}"), float(f"9.{i + 1}"), 0.5] + for i in range(9) + ] + + @staticmethod + def get_gwf_sim(name, ws, mf6) -> flopy.mf6.MFSimulation: + """ + Simple GWF simulation on a simple horizontal line grid. + """ + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=HorizontalCase.nper, + perioddata=[ + (HorizontalCase.perlen, HorizontalCase.nstp, HorizontalCase.tsmult) + ], + ) + + # create gwf model + gwfname = f"{name}_gwf" + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname, save_flows=True) + + # create gwf discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + gwf, + pname="dis", + nlay=HorizontalCase.nlay, + nrow=HorizontalCase.nrow, + ncol=HorizontalCase.ncol, + ) + + # create gwf initial conditions package + flopy.mf6.modflow.mfgwfic.ModflowGwfic(gwf, pname="ic") + + # create gwf node property flow package + flopy.mf6.modflow.mfgwfnpf.ModflowGwfnpf( + gwf, + pname="npf", + save_saturation=True, + save_specific_discharge=True, + ) + + # create gwf chd package + spd = { + 0: [[(0, 0, 0), 1.0, 1.0], [(0, 0, 9), 0.0, 0.0]], + 1: [[(0, 0, 0), 0.0, 0.0], [(0, 0, 9), 1.0, 2.0]], + } + chd = flopy.mf6.ModflowGwfchd( + gwf, + pname="CHD-1", + stress_period_data=spd, + auxiliary=["concentration"], + ) + + # create gwf output control package + # output file names + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=gwf_budget_file, + head_filerecord=gwf_head_file, + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + + # create iterative model solution for gwf model + ims = flopy.mf6.ModflowIms(sim) + + return sim + + +class FlopyReadmeCase: + nlay = 1 + nrow = 10 + ncol = 10 + top = 1.0 + botm = [0.0] + nper = 1 + perlen = 1.0 + nstp = 1 + tsmult = 1.0 + porosity = 0.1 + releasepts_mp7 = [ + # node number, localx, localy, localz + (0, float(f"0.{i + 1}"), float(f"0.{i + 1}"), 0.5) + for i in range(9) + ] + releasepts_prt = [ + # particle index, k, i, j, x, y, z + [i, 0, 0, 0, float(f"0.{i + 1}"), float(f"9.{i + 1}"), 0.5] + for i in range(9) + ] + + @staticmethod + def get_gwf_sim(name, ws, mf6) -> flopy.mf6.MFSimulation: + """ + Simple GWF simulation for use/modification by PRT tests + """ + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[ + (FlopyReadmeCase.perlen, FlopyReadmeCase.nstp, FlopyReadmeCase.tsmult) + ], + ) + + # create gwf model + gwfname = f"{name}_gwf" + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname, save_flows=True) + + # create gwf discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + gwf, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + ) + + # create gwf initial conditions package + flopy.mf6.modflow.mfgwfic.ModflowGwfic(gwf, pname="ic") + + # create gwf node property flow package + flopy.mf6.modflow.mfgwfnpf.ModflowGwfnpf( + gwf, + pname="npf", + save_saturation=True, + save_specific_discharge=True, + ) + + # create gwf chd package + spd = { + 0: [[(0, 0, 0), 1.0, 1.0], [(0, 9, 9), 0.0, 0.0]], + 1: [[(0, 0, 0), 0.0, 0.0], [(0, 9, 9), 1.0, 2.0]], + } + chd = flopy.mf6.ModflowGwfchd( + gwf, + pname="CHD-1", + stress_period_data=spd, + auxiliary=["concentration"], + ) + + # create gwf output control package + # output file names + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=gwf_budget_file, + head_filerecord=gwf_head_file, + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + ) + + # create iterative model solution for gwf model + ims = flopy.mf6.ModflowIms(sim) + + return sim + + +def check_track_data( + track_bin: os.PathLike, + track_hdr: os.PathLike, + track_csv: os.PathLike, +): + """Check that binary and CSV track files are equal.""" + + # get dtype from ascii header file + dt = get_track_dtype(track_hdr) + + # read output files + data_bin = np.fromfile(track_bin, dtype=dt) + data_csv = np.genfromtxt(track_csv, dtype=dt, delimiter=",", names=True) + if len(data_csv.shape) == 0: + # https://stackoverflow.com/a/24943993/6514033 + data_csv = np.array([data_csv]) + + assert ( + data_bin.shape == data_csv.shape + ), f"Binary and CSV track data shapes do not match: {data_bin.shape} != {data_csv.shape}" + + # check each column separately to avoid + # TypeError: The DType could not be promoted by + for k in data_bin.dtype.names: + if k == "name": + continue + assert np.allclose(data_bin[k], data_csv[k], equal_nan=True) + + # make sure columns all have values in the expected range + assert all(data_bin["iprp"] >= 1) + assert all(data_bin["irpt"] >= 1) + assert all(data_bin["kper"] >= 1) + assert all(data_bin["kstp"] >= 1) + assert all(data_bin["ilay"] >= 1) + assert all(data_bin["icell"] >= 1) + assert all(data_bin["istatus"] >= 0) + assert all(data_bin["ireason"] >= 0) + + +def check_budget_data(lst: os.PathLike, perlen=1, nper=1, nstp=1): + # load PRT model's list file + mflist = flopy.utils.mflistfile.ListBudget( + lst, budgetkey="MASS BUDGET FOR ENTIRE MODEL" + ) + names = mflist.get_record_names() + entries = mflist.entries + + # check timesteps + inc = mflist.get_incremental() + v = inc["totim"][-1] + exp = float(perlen * nper) + assert v == exp, f"Last time should be {exp}, found {v}" + + # entries should be a subset of names + assert all(e in names for e in entries) + + # todo what other record names should we expect? + expected_entries = [ + "PRP_IN", + "PRP_OUT", + ] + assert all(en in names for en in expected_entries) + + # import pdb + # pdb.set_trace() + + +def get_model_name(name, mdl): + return f"{name}_{mdl}" + + +def get_track_dtype(path: os.PathLike): + """Read a numpy dtype describing particle track + data format from the ascii track header file.""" + + hdr_lns = open(path).readlines() + hdr_lns_spl = [[ll.strip() for ll in l.split(",")] for l in hdr_lns] + return np.dtype(list(zip(hdr_lns_spl[0], hdr_lns_spl[1]))) + + +def get_ireason_code(output_event): + """ + Map output event to PRT ireason code specifing + the reason a particle track datum was recorded. + """ + + return ( + 0 + if output_event == "RELEASE" + else ( + 1 + if output_event == "TRANSIT" + else ( + 2 + if output_event == "TIMESTEP" + else ( + 3 + if output_event == "TERMINATE" + else 4 if output_event == "WEAKSINK" else -1 + ) + ) + ) # default + ) + + +def get_partdata(grid, rpts): + """ + Make a flopy.modpath.ParticleData from the given grid and release points. + """ + + if grid.grid_type == "structured": + return flopy.modpath.ParticleData( + partlocs=[grid.get_lrc(p[0])[0] for p in rpts], + structured=True, + localx=[p[1] for p in rpts], + localy=[p[2] for p in rpts], + localz=[p[3] for p in rpts], + timeoffset=0, + drape=0, + ) + else: + return flopy.modpath.ParticleData( + partlocs=[p[0] for p in rpts], + structured=False, + localx=[p[1] for p in rpts], + localy=[p[2] for p in rpts], + localz=[p[3] for p in rpts], + timeoffset=0, + drape=0, + ) + + +def has_default_boundnames(data): + name = [int(n.partition("0")[2]) for n in data["name"].to_numpy()] + irpt = data["irpt"].to_numpy() + return np.array_equal(name, irpt) + + +def plot_nodes_and_vertices( + gwf, mg, ibd, ncpl, ax, xmin=None, xmax=None, ymin=None, ymax=None +): + """ + Plot cell nodes and vertices (and IDs) on a zoomed inset + """ + + ax.set_aspect("equal") + xlim = False + ylim = False + if xmin is not None and xmax is not None: + ax.set_xlim([xmin, xmax]) + xlim = True + if ymin is not None and ymax is not None: + ax.set_ylim([ymin, ymax]) + ylim = True + + # create map view plot + pmv = flopy.plot.PlotMapView(gwf, ax=ax) + v = pmv.plot_grid(lw=0.5, edgecolor="black") + t = ax.set_title("Node and vertex indices (one-based)\n", fontsize=14) + ax.set_xlim([xmin, xmax]) + ax.set_ylim([ymin, ymax]) + + # plot vertices + verts = mg.verts + ax.plot(verts[:, 0], verts[:, 1], "bo", alpha=0.5) + for i in range(ncpl): + x, y = verts[i, 0], verts[i, 1] + ax.annotate(str(i + 1), verts[i, :], color="b", alpha=0.5) + + # plot nodes + xc, yc = mg.get_xcellcenters_for_layer(0), mg.get_ycellcenters_for_layer(0) + for i in range(ncpl): + x, y = xc[i], yc[i] + ax.plot(x, y, "o", color="grey", alpha=0.5) + ax.annotate(str(i + 1), (x, y), color="grey", alpha=0.5) + + # create legend + ax.legend( + handles=[ + mpl.patches.Patch(color="blue", label="vertex"), + mpl.patches.Patch(color="grey", label="node"), + ], + loc="upper left", + ) diff --git a/autotest/test_examples.py b/autotest/test_examples.py index 4e8c6de357a..57f974c7148 100644 --- a/autotest/test_examples.py +++ b/autotest/test_examples.py @@ -45,6 +45,11 @@ def test_scenario( targets, ): name, namefiles = example_scenario + exdirs = [nf.parent for nf in namefiles] + + if "prt" in name: + pytest.skip(f"Excluding mf6 prt model (tested separately): {name}") + if name in excluded_models: pytest.skip(f"Skipping: {name} (excluded)") diff --git a/autotest/test_gwf_ats02.py b/autotest/test_gwf_ats02.py index 7e03230de24..7514eeafed5 100644 --- a/autotest/test_gwf_ats02.py +++ b/autotest/test_gwf_ats02.py @@ -202,7 +202,7 @@ def make_plot(test): label=f"Layer {ilay + 1}", ) plt.legend() - plt.show() + # plt.show() def check_output(idx, test): diff --git a/autotest/test_prt_budget.py b/autotest/test_prt_budget.py new file mode 100644 index 00000000000..234811afca3 --- /dev/null +++ b/autotest/test_prt_budget.py @@ -0,0 +1,350 @@ +""" +Tests particle mass budget tracking with a very +simple horizontal steady-state flow system. The +grid is a 1x1x10 horizontal line with 10 columns. +Particles are released from the left-most cell. +Pathlines are compared against a MODPATH 7 model. +""" + +from pathlib import Path + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from flopy.mf6.utils.postprocessing import get_structured_faceflows +from prt_test_utils import ( + HorizontalCase, + all_equal, + check_budget_data, + check_track_data, + get_model_name, + get_partdata, + has_default_boundnames, +) + +from framework import TestFramework + +simname = "prtbud" +cases = [simname] + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=HorizontalCase.nper, + perioddata=[ + (HorizontalCase.perlen, HorizontalCase.nstp, HorizontalCase.tsmult) + ], + ) + + # create prt model + prt_name = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name, save_flows=True) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=HorizontalCase.nlay, + nrow=HorizontalCase.nrow, + ncol=HorizontalCase.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=HorizontalCase.porosity) + + # convert mp7 to prt release points and check against expectation + partdata = get_partdata(prt.modelgrid, HorizontalCase.releasepts_mp7) + coords = partdata.to_coords(prt.modelgrid) + releasepts = [(i, 0, 0, 0, c[0], c[1], c[2]) for i, c in enumerate(coords)] + # assert np.allclose(HorizontalCase.releasepts_prt, releasepts) + + # create prp package + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + stop_at_weak_sink="saws" in prt_name, + boundnames=True, + ) + + # create output control package + prt_budget_file = f"{prt_name}.bud" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + budget_filerecord=[prt_budget_file], + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + saverecord=[("BUDGET", "ALL")], + ) + + # create the flow model interface + gwf_name = get_model_name(name, "gwf") + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + partdata = get_partdata(gwf.modelgrid, HorizontalCase.releasepts_mp7) + mp7_name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=HorizontalCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +def build_models(idx, test): + gwf_sim = HorizontalCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + mp7_sim = build_mp7_sim( + test.name, + test.workspace / "mp7", + test.targets["mp7"], + gwf_sim.get_model(), + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + assert (prt_ws / prp_track_file).is_file() + assert (prt_ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based indexing in mp7 results + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + + # make sure pathline df has "name" (boundname) column and default values + assert "name" in mf6_pls + assert has_default_boundnames(mf6_pls) + + # make sure all mf6 pathline data have correct model and PRP index (1) + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", HorizontalCase.perlen, HorizontalCase.nper + ) + + # check cell-by-cell particle mass flows + prt_budget_file = prt_ws / f"{prt_name}.bud" + prt_bud = flopy.utils.CellBudgetFile(prt_budget_file, precision="double") + prt_bud_data = prt_bud.get_data(kstpkper=(0, 0)) + assert len(prt_bud_data) == 2 + flowja = prt_bud.get_data(text="FLOW-JA-FACE")[0][0, 0, :] + prp = prt_bud.get_data(text="PRP")[0].squeeze() + assert flowja.shape == (28,) + assert prp.shape == (9,) + frf, fff, flf = get_structured_faceflows( + flowja, + grb_file=gwf_ws / f"{gwf_name}.dis.grb", + verbose=True, + ) + assert not fff.any() + assert not flf.any() + assert frf.any() + assert all(v == 9 for v in frf[:-1]) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ + prt_ws / prt_track_csv_file, + prt_ws / prp_track_csv_file, + ]: + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws + / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=track_csv, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_disv1.py b/autotest/test_prt_disv1.py new file mode 100644 index 00000000000..671530651af --- /dev/null +++ b/autotest/test_prt_disv1.py @@ -0,0 +1,486 @@ +""" +Tests particle tracking on a vertex (DISV) grid +that reduces to a regular grid. + +Two cases are provided, one with valid release +position and cell correspondences, and another +with mismatching cell IDs; expect PRT to catch +these and reject them. +""" + +from pathlib import Path +from pprint import pformat + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from flopy.utils.gridutil import get_disv_kwargs +from prt_test_utils import ( + all_equal, + check_budget_data, + check_track_data, + get_partdata, + has_default_boundnames, + plot_nodes_and_vertices, +) + +from framework import TestFramework + +simname = "prtdisv1" +cases = [f"{simname}", f"{simname}bprp", f"{simname}trts", f"{simname}trtf"] + +# model info +nlay = 1 +nrow = 10 +ncol = 10 +ncpl = nrow * ncol +delr = 1.0 +delc = 1.0 +nper = 1 +perlen = 10 +nstp = 5 +tsmult = 1.0 +tdis_rc = [(perlen, nstp, tsmult)] +top = 25.0 +botm = [20.0] +strt = 20 +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-9, 1e-3, 0.97 +porosity = 0.1 +tracktimes = list(np.linspace(0, 11, 10)) + + +def tracktimes_file(path) -> Path: + path = Path(path) + lines = [f"{t}\n" for t in tracktimes] + with open(path, "w") as f: + f.writelines(lines) + return path + + +# vertex grid properties +disvkwargs = get_disv_kwargs( + nlay, + nrow, + ncol, + delr, + delc, + top, + botm, +) + +# release points in mp7 format +releasepts_mp7 = [ + # node number, localx, localy, localz + (i * 10, 0.5, 0.5, 0.5) + for i in range(10) +] + + +def build_gwf_sim(idx, ws, mf6): + gwf_name = f"{cases[idx]}_gwf" + sim = flopy.mf6.MFSimulation( + sim_name=gwf_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 gwf model + gwf = flopy.mf6.ModflowGwf( + sim, modelname=gwf_name, newtonoptions="NEWTON", save_flows=True + ) + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="MODERATE", + 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, + ) + sim.register_ims_package(ims, [gwf.name]) + + disv = flopy.mf6.ModflowGwfdisv(gwf, **disvkwargs) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=True, + save_specific_discharge=True, + save_saturation=True, + ) + + # constant head boundary + spd = { + 0: [[(0, 0), 1.0, 1.0], [(0, 99), 0.0, 0.0]], + # 1: [[(0, 0, 0), 0.0, 0.0], [(0, 9, 9), 1.0, 2.0]], + } + chd = flopy.mf6.ModflowGwfchd( + gwf, + pname="CHD-1", + stress_period_data=spd, + auxiliary=["concentration"], + ) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord="{}.cbc".format(gwf_name), + head_filerecord="{}.hds".format(gwf_name), + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename="{}.oc".format(gwf_name), + ) + + # Print human-readable heads + obs_lst = [] + for k in np.arange(0, 1, 1): + for i in np.arange(40, 50, 1): + obs_lst.append(["obs_" + str(i + 1), "head", (k, i)]) + + obs_dict = {f"{gwf_name}.obs.csv": obs_lst} + obs = flopy.mf6.ModflowUtlobs( + gwf, pname="head_obs", digits=20, continuous=obs_dict + ) + + return sim + + +def build_prt_sim(idx, gwf_ws, prt_ws, mf6): + # create simulation + name = cases[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create prt model + prt_name = f"{cases[idx]}_prt" + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + disv = flopy.mf6.ModflowGwfdisv(prt, **disvkwargs) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=porosity) + + # convert mp7 particledata to prt release points + partdata = get_partdata(prt.modelgrid, releasepts_mp7) + releasepts = list(partdata.to_prp(prt.modelgrid)) + if "bprp" in name: + # wrong cell index, point is in cell (0, 0) + releasepts[0] = (0, (0, 1), 0.5, 9.5, 22.5) + + # create prp package + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + stop_at_weak_sink=False, + boundnames=True, + ) + + # create output control package + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + if "trts" in name or "trtf" in name: + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_release=True, + track_terminate=True, + track_usertime=True, + track_timesrecord=tracktimes if "trts" in name else None, + track_timesfilerecord=( + tracktimes_file(prt_ws / f"{prt_name}.tls") + if "trtf" in name + else None + ), + ) + else: + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_all=True, + ) + + # create the flow model interface + gwf_name = f"{cases[idx]}_gwf" + gwf_budget_file = gwf_ws / f"{gwf_name}.cbc" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(idx, ws, mp7, gwf): + partdata = get_partdata(gwf.modelgrid, releasepts_mp7) + mp7_name = f"{cases[idx]}_mp7" + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.cbc", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="total", + particlegroups=[pg], + ) + + return mp + + +def build_models(idx, test): + gwf_sim = build_gwf_sim(idx, test.workspace, test.targets["mf6"]) + prt_sim = build_prt_sim( + idx, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + mp7_sim = build_mp7_sim( + idx, test.workspace / "mp7", test.targets["mp7"], gwf_sim.get_model() + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = f"{name}_gwf" + prt_name = f"{name}_prt" + mp7_name = f"{name}_mp7" + gwf_sim = test.sims[0] + prt_sim = test.sims[1] + gwf = gwf_sim.get_model(gwf_name) + prt = prt_sim.get_model(prt_name) + mg = gwf.modelgrid + + # if invalid release points, check for error message + if "bprp" in name: + buff = test.buffs[1] + assert any("Error: release point" in l for l in buff) + return + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.cbc" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + assert (prt_ws / prp_track_file).is_file() + assert (prt_ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based indexing in mp7 results + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + if "trts" in name or "trtf" in name: + assert len(mf6_pls) == 100 + + # make sure pathline df has "name" (boundname) column and default values + assert "name" in mf6_pls + assert has_default_boundnames(mf6_pls) + + # make sure all mf6 pathline data have correct model and PRP index (1) + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + check_budget_data(prt_ws / f"{name}_prt.lst", perlen, nper, nstp) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_bin, track_csv in zip( + [prt_ws / prt_track_file, prt_ws / prp_track_file], + [prt_ws / prt_track_csv_file, prt_ws / prp_track_csv_file], + ): + check_track_data( + track_bin=track_bin, + track_hdr=str(track_bin).replace(".trk", ".trk.hdr"), + track_csv=track_csv, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + plot = False + if "bprp" not in name and plot: + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.2) + pmv.plot_vector(qx, qy, normalize=True, color="white") + # set zoom area + # xmin, xmax = 2050, 4800 + # ymin, ymax = 5200, 7550 + # plot labeled nodes and vertices + plot_nodes_and_vertices(gwf, mg, None, mg.ncpl, ax[0]) + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + linestyle="None" if "trst" in name else "--", + marker="o", + markersize=2, + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.2) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mf6_pls["node"] # node numbers reversed in y direction in mp7 + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + del mp7_pls["node"] + + # compare mf6 / mp7 pathline data + if "trts" in name or "trtf" in name: + pass + else: + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + xfail=[False, "bprp" in name, False], + ) + test.run() diff --git a/autotest/test_prt_drape.py b/autotest/test_prt_drape.py new file mode 100644 index 00000000000..09d50eb5220 --- /dev/null +++ b/autotest/test_prt_drape.py @@ -0,0 +1,328 @@ +""" +Tests the "drape" option for the PRP package, +which moves particles released into dry cells +to the top-most active cell below, if any. + +The grid is a 10x10 square with 2 layers, based +on the flow system in autotest/test_gwf_rch01.py. + +Particles are released from the top left cell. +""" + +from pathlib import Path + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import all_equal, check_track_data, get_model_name + +from framework import TestFramework + +simname = "prtfmi09" +cases = [simname, f"{simname}_drp"] +nlay, nrow, ncol = 2, 1, 5 +chdheads = [25.0] +nper = len(chdheads) +perlen = nper * [0.01] +nstp = nper * [1] +tsmult = nper * [1.0] +delr = delc = 1.0 +strt = [[[25.0, 25.0, 75.0, 25.0, 25.0], [25.0, 25.0, 75.0, 25.0, 25.0]]] +strt = np.array(strt, dtype=float) +nouter, ninner = 100, 300 +hclose, rclose, relax = 1e-9, 1e-3, 0.97 +tdis_rc = [(perlen[i], nstp[i], tsmult[i]) for i in range(nper)] +porosity = 0.1 +releasepts = [ + # particle index, k, i, j, x, y, z + [i, 0, 0, 1, float(f"1.{i + 1}"), float(f"0.{i + 1}"), 75] + for i in range(5) +] + [ + [i, 0, 0, 3, float(f"3.{i + 1}"), float(f"0.{i + 1}"), 75] + for i in range(5, 9) +] + + +def build_gwf_sim(name, ws, mf6): + ws = Path(ws) + gwf_name = get_model_name(name, "gwf") + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=gwf_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 + ) + + # set ims csv files + csv0 = f"{gwf_name}.outer.ims.csv" + csv1 = f"{gwf_name}.inner.ims.csv" + + # create iterative model solution and register the gwf model with it + ims = flopy.mf6.ModflowIms( + sim, + print_option="ALL", + csv_outer_output_filerecord=csv0, + csv_inner_output_filerecord=csv1, + 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=gwf_name, save_flows=True) + + dis = flopy.mf6.ModflowGwfdis( + gwf, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=100.0, + botm=[50.0, 0.0], + ) + + # initial conditions + ic = flopy.mf6.ModflowGwfic(gwf, strt=strt) + + # node property flow + npf = flopy.mf6.ModflowGwfnpf( + gwf, + save_flows=True, + save_saturation=True, + save_specific_discharge=True, + icelltype=1, + k=1.0, + ) + + sto = flopy.mf6.ModflowGwfsto(gwf, ss=1.0e-5, sy=0.1) + + # chd files + chdspd = {} + for kper, chdval in enumerate(chdheads): + chdspd[kper] = [ + [(nlay - 1, 0, 0), chdval], + [(nlay - 1, 0, ncol - 1), chdval], + ] + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdspd) + + rch = flopy.mf6.ModflowGwfrcha(gwf, recharge=0.1) + + # output control + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwf_name}.cbc", + head_filerecord=f"{gwf_name}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename=f"{gwf_name}.oc", + ) + + return sim + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + prt_ws = Path(prt_ws) + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=prt_name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create prt model + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + dis = flopy.mf6.ModflowGwfdis( + prt, + nlay=nlay, + nrow=nrow, + ncol=ncol, + delr=delr, + delc=delc, + top=100.0, + botm=[50.0, 0.0], + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=porosity) + + # create prp package + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + drape="drp" in name, + ) + + # create output control package + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + + # create the flow model interface + gwf_budget_file = gwf_ws / f"{gwf_name}.cbc" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_models(idx, test): + gwf_sim = build_gwf_sim(test.name, test.workspace, test.targets["mf6"]) + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + return gwf_sim, prt_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + drape = "drp" in name + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.cbc" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + assert (prt_ws / prp_track_file).is_file() + assert (prt_ws / prp_track_csv_file).is_file() + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + + # make sure all mf6 pathline data have correct model and PRP index (1) + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + # check_budget_data(ws / f"{name}_prt.lst", perlen, nper) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ + prt_ws / prt_track_csv_file, + prt_ws / prp_track_csv_file, + ]: + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws + / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=track_csv, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=1, figsize=(10, 10)) + ax.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title=f"MF6 pathlines{' (drape)' if drape else ''}", + kind="line", + x="x", + y="y", + ax=ax, + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + if drape: + assert mf6_pls.shape[0] == 36 + else: + # expect no movement without drape + assert mf6_pls.shape[0] == 9 + # istatus=8 permanently unreleased + assert mf6_pls.istatus.eq(8).all() + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_exg.py b/autotest/test_prt_exg.py new file mode 100644 index 00000000000..db3dd407e4b --- /dev/null +++ b/autotest/test_prt_exg.py @@ -0,0 +1,326 @@ +""" +Test GWF and PRT models in the same simulation +with an exchange. + +The grid is a 10x10 square with a single layer, +the same flow system shown on the FloPy readme. +Particles are released from the top left cell. + +Results are compared against a MODPATH 7 model. + +This test includes two cases, one which gives +boundnames to particles and one which does not. +""" + +from pathlib import Path +from pprint import pformat + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import FlopyReadmeCase, check_budget_data, check_track_data + +from framework import TestFramework + +simname = "prtexg01" +cases = [simname, f"{simname}bnms"] + + +def get_model_name(idx, mdl): + return f"{cases[idx]}_{mdl}" + + +def build_mf6_sim(idx, test): + # create simulation + name = cases[idx] + sim = FlopyReadmeCase.get_gwf_sim( + name, test.workspace, test.targets["mf6"] + ) + + # create prt model + prt_name = get_model_name(idx, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=FlopyReadmeCase.porosity + ) + + # create prp package + rpts = ( + [r + [str(r[0] + 1)] for r in FlopyReadmeCase.releasepts_prt] + if "bnms" in name + else FlopyReadmeCase.releasepts_prt + ) + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(rpts), + packagedata=rpts, + perioddata={0: ["FIRST"]}, + boundnames="bnms" in name, + ) + + # create output control package + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + + # create a flow model interface + # todo Mike Fienen's report (crash when FMI created but not needed) + # flopy.mf6.ModflowPrtfmi( + # prt, + # packagedata=[ + # ("GWFHEAD", gwf_head_file), + # ("GWFBUDGET", gwf_budget_file), + # ], + # ) + + # create exchange + gwf_name = get_model_name(idx, "gwf") + flopy.mf6.ModflowGwfprt( + sim, + exgtype="GWF6-PRT6", + exgmnamea=gwf_name, + exgmnameb=prt_name, + filename=f"{gwf_name}.gwfprt", + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + return sim + + +def build_mp7_sim(idx, ws, mp7, gwf): + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in FlopyReadmeCase.releasepts_mp7], + localx=[p[1] for p in FlopyReadmeCase.releasepts_mp7], + localy=[p[2] for p in FlopyReadmeCase.releasepts_mp7], + localz=[p[3] for p in FlopyReadmeCase.releasepts_mp7], + timeoffset=0, + drape=0, + ) + mp7_name = get_model_name(idx, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + return mp + + +def build_models(idx, test): + mf6sim = build_mf6_sim(idx, test) + gwf_name = get_model_name(idx, "gwf") + gwf = mf6sim.get_model(gwf_name) + mp7sim = build_mp7_sim( + idx, test.workspace / "mp7", test.targets["mp7"], gwf + ) + return mf6sim, mp7sim + + +def check_output(idx, test): + name = test.name + gwf_ws = Path(test.workspace) + mp7_ws = gwf_ws / "mp7" + + # model names + gwf_name = get_model_name(idx, "gwf") + prt_name = get_model_name(idx, "prt") + mp7_name = get_model_name(idx, "mp7") + + # extract model objects + sim = test.sims[0] + gwf = sim.get_model(gwf_name) + prt = sim.get_model(prt_name) + + # extract model grid + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (gwf_ws / prt_track_file).is_file() + assert (gwf_ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(gwf_ws / prt_track_csv_file).replace( + r"^\s*$", np.nan, regex=True + ) + + # make sure pathline dataframe has "name" column + assert "name" in mf6_pls + + # check boundname values + if "bnms" in name: + # boundnames should be release point numbers (so pandas parses them as ints) + assert np.array_equal( + mf6_pls["name"].to_numpy(), mf6_pls["irpt"].to_numpy() + ) + else: + # no boundnames given so check for defaults + assert pd.isna(mf6_pls["name"]).all() + + # check budget data were written to mf6 prt list file + check_budget_data( + gwf_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=gwf_ws / prt_track_file, + track_hdr=gwf_ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=gwf_ws / prt_track_csv_file, + ) + + # extract head, budget, and specific discharge results from GWF model + gwf = sim.get_model(gwf_name) + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{name}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_fmi.py b/autotest/test_prt_fmi.py new file mode 100644 index 00000000000..242f0d11c5f --- /dev/null +++ b/autotest/test_prt_fmi.py @@ -0,0 +1,383 @@ +""" +Tests ability to run a GWF model then a PRT model +in separate simulations via flow model interface, +as well as + +The grid is a 10x10 square with a single layer, +the same flow system shown on the FloPy readme. + +Test cases are defined for the particle release +package (PRP) option STOP_AT_WEAK_SINK, one on +and one with the option off. No effect on results +is expected, because the model has no weak sinks. +(Motivated by an old bug in which particles were +tracked improperly when this option was enabled, +even with no weak sink cells in the vicinity.) + +This test also specifies `boundnames=True` for +the PRP package, but does not provide boundnames +values, and checks that the "name" column in the +track output files contain the expected defaults. + +Particles are released from the top left cell. + +Pathlines are compared against a MODPATH 7 model. + +Runtime is benchmarked with pytest-benchmark. +""" + +from pathlib import Path + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import ( + FlopyReadmeCase, + all_equal, + check_budget_data, + check_track_data, + get_model_name, + get_partdata, + has_default_boundnames, +) + +from framework import TestFramework + +simname = "prtfmi01" +cases = [simname, f"{simname}saws", f"{simname}bprp"] + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[ + ( + FlopyReadmeCase.perlen, + FlopyReadmeCase.nstp, + FlopyReadmeCase.tsmult, + ) + ], + ) + + # create prt model + prt_name = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name, save_flows=True) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=FlopyReadmeCase.porosity + ) + + # convert mp7 to prt release points and check against expectation + partdata = get_partdata(prt.modelgrid, FlopyReadmeCase.releasepts_mp7) + coords = partdata.to_coords(prt.modelgrid) + if "bprp" in name: + # bad cell indices! + releasepts = [ + (i, 0, 1, 1, c[0], c[1], c[2]) for i, c in enumerate(coords) + ] + else: + releasepts = [ + (i, 0, 0, 0, c[0], c[1], c[2]) for i, c in enumerate(coords) + ] + assert np.allclose(FlopyReadmeCase.releasepts_prt, releasepts) + + # create prp package + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + stop_at_weak_sink="saws" in prt_name, + boundnames=True, + ) + + # create output control package + prt_budget_file = f"{prt_name}.bud" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + budget_filerecord=[prt_budget_file], + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + saverecord=[("BUDGET", "ALL")], + ) + + # create the flow model interface + gwf_name = get_model_name(name, "gwf") + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + partdata = get_partdata(gwf.modelgrid, FlopyReadmeCase.releasepts_mp7) + mp7_name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +def build_models(idx, test): + gwf_sim = FlopyReadmeCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + mp7_sim = build_mp7_sim( + test.name, + test.workspace / "mp7", + test.targets["mp7"], + gwf_sim.get_model(), + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + if "bprp" in name: + buff = test.buffs[1] + assert any("Error: release point" in l for l in buff) + return + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + assert (prt_ws / prp_track_file).is_file() + assert (prt_ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based indexing in mp7 results + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + + # make sure pathline df has "name" (boundname) column and default values + assert "name" in mf6_pls + assert has_default_boundnames(mf6_pls) + + # make sure all mf6 pathline data have correct model and PRP index (1) + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check cell-by-cell particle mass budget file + prt_budget_file = prt_ws / f"{prt_name}.bud" + prt_bud = flopy.utils.CellBudgetFile(prt_budget_file, precision="double") + prt_bud_data = prt_bud.get_data(kstpkper=(0, 0)) + assert len(prt_bud_data) == 2 + assert prt_bud_data[0].shape == (1, 1, 460) + assert prt_bud_data[1].shape == (9,) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ + prt_ws / prt_track_csv_file, + prt_ws / prp_track_csv_file, + ]: + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws + / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=track_csv, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets, benchmark): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + compare=None, + xfail=[False, "bprp" in name, False], + ) + if "bprp" in name: + test.run() + else: + benchmark(test.run) diff --git a/autotest/test_prt_notebooks.py b/autotest/test_prt_notebooks.py new file mode 100644 index 00000000000..ae328857c62 --- /dev/null +++ b/autotest/test_prt_notebooks.py @@ -0,0 +1,250 @@ +import re +from os import environ +from pathlib import Path +from platform import system +from pprint import pprint +from warnings import warn + +import numpy as np +import pandas as pd +import pytest +from flopy.mf6 import MFSimulation +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from modflow_devtools.misc import run_cmd, set_env + +from conftest import project_root_path + + +def get_notebook_scripts(pattern=None, exclude=None): + repos_path = environ.get("REPOS_PATH", None) + if repos_path is None: + repos_path = project_root_path.parent + repo_path = Path(repos_path) / "modflow6-examples" + if not repo_path.is_dir(): + return [] + nbpaths = [ + str(p) + for p in (repo_path / "scripts").glob("*.py") + if pattern is None or pattern in p.name + ] + + # sort for pytest-xdist: workers must collect tests in the same order + return sorted( + [p for p in nbpaths if not exclude or not any(e in p for e in exclude)] + ) + + +@pytest.mark.slow +@pytest.mark.parametrize( + "notebook", + get_notebook_scripts(pattern="ex-prt", exclude=["ex-prt-mp7-p03"]), +) +def test_notebooks(notebook, function_tmpdir, targets): + notebook = Path(notebook) + + # temporarily add testing binaries to PATH + delim = ";" if system() == "Windows" else ":" + path = ( + environ.get("PATH", "") + + f"{delim}{targets['mf6'].parent}" + + f"{delim}{targets['mf6'].parent / 'downloaded'}" + + f"{delim}{targets['mf6'].parent / 'rebuilt'}" + ) + with set_env(PATH=path): + args = [ + "jupytext", + "--from", + "py", + "--to", + "ipynb", + "--execute", + "--run-path", + function_tmpdir, + "--output", + function_tmpdir / f"{notebook.stem}.ipynb", + str(notebook), + ] + # run the notebook + stdout, stderr, returncode = run_cmd(*args, verbose=True) + + # show output + pprint(stdout) + pprint(stderr) + + # check return code + if returncode != 0: + if "Missing optional dependency" in stderr: + pkg = re.findall("Missing optional dependency '(.*)'", stderr)[0] + pytest.skip(f"notebook requires optional dependency {pkg!r}") + elif "No module named " in stderr: + pkg = re.findall("No module named '(.*)'", stderr)[0] + pytest.skip(f"notebook requires package {pkg!r}") + assert returncode == 0, f"could not run {notebook}" + + # define expected simulation and model names + simname = Path(notebook).stem.replace("ex-prt-", "") + gwfname = f"{simname}-gwf" + prtname = f"{simname}-prt" + mp7_name = f"{simname}-mp7" + + # if example working directory doesn't exist, return early + example_ws = function_tmpdir.parent / "examples" / notebook.stem + if not example_ws.is_dir(): + warn(f"example workspace {example_ws} does not exist") + return + + # define working subdirs + mf6ws = example_ws / "mf6" + gwfws = example_ws / "gwf" + prtws = example_ws / "prt" + mp7ws = example_ws / "mp7" + + # prt notebooks running gwf and prt in separate simulations + # use gwf, prt and mp7 subdirectories, notebooks with gwf & + # prt in the same simulation use mf6 and mp7 subdirectories. + if mf6ws.is_dir(): + gwfws = mf6ws + prtws = mf6ws + else: + assert gwfws.is_dir() + # there may be more than one prt subdirectory + prtws = list(example_ws.glob("prt*")) + assert any(prtws) + if len(prtws) == 1: + prtws = prtws[0] + + # load model grid + gwfsim = MFSimulation.load(sim_ws=gwfws, load_only="dis") + gwf = gwfsim.get_model(gwfname) + grid = gwf.modelgrid + + # check gwf output files exist + gwf_budget_file = gwfws / f"{gwfname}.cbb" + gwf_head_file = gwfws / f"{gwfname}.hds" + assert gwf_budget_file.is_file() + assert gwf_head_file.is_file() + + # initialize PRT pathlines dataframe (loaded below) + prt_pls = None + + # check prt track output files exist + if isinstance(prtws, Path): + prt_track_file = prtws / f"{prtname}.trk" + prt_track_csv_file = prtws / f"{prtname}.trk.csv" + assert prt_track_file.is_file() + assert prt_track_csv_file.is_file() + prt_pls = pd.read_csv(prt_track_csv_file, na_filter=False) + else: + for ws in prtws: + ll = ws.stem[-1] # todo append to filename like mp7? + prt_track_file = ws / f"{prtname}.trk" + prt_track_csv_file = ws / f"{prtname}.trk.csv" + assert prt_track_file.is_file() + assert prt_track_csv_file.is_file() + + # if multiple prt dirs and track files, concatenate them into a single dataframe + pls = pd.read_csv(prt_track_csv_file, na_filter=False) + print(f"Adding {pls.shape} pathlines from {prt_track_csv_file}") + prt_pls = pls if prt_pls is None else pd.concat([prt_pls, pls]) + + # initialize MP7 pathlines dataframe (loaded below) + mp7_pls = None + + # there may be more than one mp7 subdirectory + mp7ws = list(example_ws.glob("mp7*")) + assert any(mp7ws) + if len(mp7ws) == 1: + mp7ws = mp7ws[0] + + # check mp7 pathline output file(s) + if isinstance(mp7ws, Path): + mp7_pathline_file = mp7ws / f"{mp7_name}.mppth" + assert mp7_pathline_file.is_file() + mp7_pls = pd.DataFrame.from_records( + PathlineFile(mp7_pathline_file).get_destination_pathline_data( + range(grid.nnodes), to_recarray=True + ), + ) + else: + for ws in mp7ws: + ll = ws.stem[-1] + mp7_pathline_file = ws / f"{mp7_name}{ll}.mppth" + mp7_endpoint_file = ws / f"{mp7_name}{ll}.mpend" + assert mp7_pathline_file.is_file() or mp7_endpoint_file.is_file() + + # if multiple mp7 dirs & pathline files, concatenate them into a single dataframe + if mp7_pathline_file.is_file(): + pls = pd.DataFrame.from_records( + PathlineFile( + mp7_pathline_file + ).get_destination_pathline_data( + range(grid.nnodes), to_recarray=True + ), + ) + print(f"Adding {pls.shape} pathlines from {mp7_pathline_file}") + mp7_pls = pls if mp7_pls is None else pd.concat([mp7_pls, pls]) + + # convert prt results to mp7 format + prt_pls = to_mp7_pathlines(prt_pls) + + # standardize to one-based indexing + if mp7_pls.particlegroup.min() == 0: + mp7_pls.particlegroup = mp7_pls.particlegroup + 1 + if prt_pls.particlegroup.min() == 0: + prt_pls.particlegroup = prt_pls.particlegroup + 1 + if mp7_pls.node.min() == 0: + mp7_pls.node = mp7_pls.node + 1 + if prt_pls.node.min() == 0: + prt_pls.node = prt_pls.node + 1 + if mp7_pls.k.min() == 0: + mp7_pls.k = mp7_pls.k + 1 + if prt_pls.k.min() == 0: + prt_pls.k = prt_pls.k + 1 + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del prt_pls["sequencenumber"] + del prt_pls["particleidloc"] + del prt_pls["xloc"] + del prt_pls["yloc"] + del prt_pls["zloc"] + del prt_pls[ + "node" + ] # mp7 node numbers reversed in y direction for disv grids + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + del mp7_pls["node"] + + # drop values for which time is a whole number (and not 0) + # (kluge to exclude timeseries data until prt supports it) + prt_pls = prt_pls[(prt_pls.time % 1 != 0) | (prt_pls.time == 0)] + mp7_pls = mp7_pls[(mp7_pls.time % 1 != 0) | (mp7_pls.time == 0)] + + # for mp7 example 1 drop prt pathline data for which z = 400 + # (kluge to work around particles starting at water table??) + if "ex-prt-mp7-p01" in notebook.name: + prt_pls = prt_pls[prt_pls.z != 400] + + # sort both dataframes by particleid and time + cols = ["particleid", "time", "x", "y", "z"] + prt_pls.sort_values(by=cols, inplace=True) + mp7_pls.sort_values(by=cols, inplace=True) + + # drop duplicates + prt_pls = prt_pls.drop_duplicates(subset=cols) + mp7_pls = mp7_pls.drop_duplicates(subset=cols) + prt_pls = prt_pls.sort_values(by=cols) + mp7_pls = mp7_pls.sort_values(by=cols) + + # compare result shape + assert prt_pls.shape == mp7_pls.shape + + # skip comparison for ex-prt-mp7-p02 until mp7 and prt particleids can be guaranteed to correspond + if "ex-prt-mp7-p02" in notebook.name: + return + + # compare result equality + assert np.allclose(prt_pls, mp7_pls, atol=1e-3) diff --git a/autotest/test_prt_release_timing.py b/autotest/test_prt_release_timing.py new file mode 100644 index 00000000000..a47fe6e611b --- /dev/null +++ b/autotest/test_prt_release_timing.py @@ -0,0 +1,422 @@ +""" +Test cases exercising release timing, 1st via +package-level RELEASETIME option, & then with +period-block config STEPS 1 and FRACTION 0.5. +The model is setup to release halfway through +the first and only time step of the first and +only stress period, with duration 1 time unit, +so the same value of 0.5 can be used for both +RELEASETIME and FRACTION. A third test case +checks that multiple values can be provided +for RELEASETIME. + +Period-block FRACTION should work with FIRST +and ALL, but flopy hangs with either option. +Todo: debug and enable corresponding cases. + +The grid is a 10x10 square with a single layer, +the same flow system shown on the FloPy readme. + +Particles are released from the top left cell. + +Results are compared against a MODPATH 7 model. +Telease time 0.5 could be configured, but mp7 +reports relative times, so there is no reason +& mp7 results are converted before comparison. +""" + +from pathlib import Path +from typing import Optional + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import ( + FlopyReadmeCase, + all_equal, + check_budget_data, + check_track_data, + get_model_name, + get_partdata, +) + +from framework import TestFramework + +simname = "prtrelt" +cases = [ + # options block options + f"{simname}sgl", # RELEASE_TIMES 0.5 + f"{simname}dbl", # RELEASE_TIMES 0.5 0.6 + f"{simname}tls", # RELEASE_TIMESFILE + # period block options + # f"{simname}all", # ALL FRACTION 0.5 # todo debug flopy hanging + # f"{simname}frst", # FIRST FRACTION 0.5 # todo debug flopy hanging + f"{simname}stps", # STEPS 1 FRACTION 0.5 +] + + +def releasetimes_file(path, rtimes) -> Path: + path = Path(path) + lines = [f"{t}\n" for t in rtimes] + with open(path, "w") as f: + f.writelines(lines) + return path + + +def get_perioddata(name, periods=1, fraction=None) -> Optional[dict]: + if "sgl" in name or "dbl" in name or "tls" in name: + return None + opt = [ + ( + "FIRST" + if "frst" in name + else ( + "ALL" + if "all" in name + else ("STEPS", 1) if "stps" in name else None + ) + ) + ] + if opt[0] is None: + raise ValueError(f"Invalid period option: {name}") + if fraction is not None: + opt.append(("FRACTION", fraction)) + return {i: opt for i in range(periods)} + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6, fraction=None): + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[ + ( + FlopyReadmeCase.perlen, + FlopyReadmeCase.nstp, + FlopyReadmeCase.tsmult, + ) + ], + ) + + # create prt model + prt_name = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=FlopyReadmeCase.porosity + ) + + # convert mp7 particledata to prt release points + partdata = get_partdata(prt.modelgrid, FlopyReadmeCase.releasepts_mp7) + releasepts = list(partdata.to_prp(prt.modelgrid)) + + # check release points match expectation + assert np.allclose(FlopyReadmeCase.releasepts_prt, releasepts) + + # create prp package + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + pdat = get_perioddata(prt_name, fraction=fraction) + # fraction 0.5 equiv. to release time 0.5 since 1 period 1 step with length 1 + releasetime = ( + [fraction] + if "sgl" in prt_name + else ( + [fraction, fraction + 0.1] + if "dbl" in prt_name or "tls" in prt_name + else None + ) + ) + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata=pdat, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + release_timesrecord=( + releasetime if ("sgl" in prt_name or "dbl" in name) else None + ), + release_timesfilerecord=( + releasetimes_file(prt_ws / f"{prt_name}.tls", releasetime) + if "tls" in name + else None + ), + ) + + # create output control package + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + + # create the flow model interface + gwf_name = get_model_name(name, "gwf") + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + partdata = get_partdata(gwf.modelgrid, FlopyReadmeCase.releasepts_mp7) + mp7_name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +def build_models(idx, test, fraction): + gwf_sim = FlopyReadmeCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + prt_sim = build_prt_sim( + test.name, + test.workspace, + test.workspace / "prt", + test.targets["mf6"], + fraction, + ) + mp7_sim = build_mp7_sim( + test.name, + test.workspace / "mp7", + test.targets["mp7"], + gwf_sim.get_model(), + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test, fraction): + name = test.name + ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + assert (prt_ws / prp_track_file).is_file() + assert (prt_ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based indexing in mp7 results + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # apply reference time to mp7 results (mp7 reports relative times) + mp7_pls["time"] = mp7_pls["time"] + fraction + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + + # make sure pathline df has "name" (boundname) column and empty values + assert "name" in mf6_pls + assert (mf6_pls["name"] == "").all() + + # make sure all mf6 pathline data have correct model and PRP index (1) + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ + prt_ws / prt_track_csv_file, + prt_ws / prp_track_csv_file, + ]: + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws + / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=track_csv, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(ws / f"test_{simname}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # compare mf6 / mp7 pathline data + if "dbl" in name or "tls" in name: + assert len(mf6_pls) == 2 * len(mp7_pls) + # todo check for double mass + else: + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +@pytest.mark.parametrize("fraction", [0.5]) +def test_mf6model(idx, name, function_tmpdir, targets, fraction): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t, fraction), + check=lambda t: check_output(idx, t, fraction), + targets=targets, + compare=None, + ) + test.run() diff --git a/autotest/test_prt_stop_zones.py b/autotest/test_prt_stop_zones.py new file mode 100644 index 00000000000..5765a36d8af --- /dev/null +++ b/autotest/test_prt_stop_zones.py @@ -0,0 +1,424 @@ +""" +This test exercises stop zones defined in the +model input package (MIP), i.e. particles are +terminated when they enter the selected zone. + +The grid is a 10x10 square, based on the flow +system from the FloPy readme. Two test cases +are defined with 1 and 2 layers respectively +(to test zone data can be read as 2D or 3D). + +There are two stop zones in the top right and +bottom left of the grid. + +Particles are released from the top left cell +and are either captured by either of the stop +zones, or continue to the bottom right cell. + +GWF and PRT models run in separate simulations +via flow model interface. + +Results are compared against a MODPATH 7 model. +""" + +from itertools import repeat +from pathlib import Path + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from matplotlib.collections import LineCollection +from prt_test_utils import ( + FlopyReadmeCase, + check_budget_data, + check_track_data, + get_model_name, +) + +from framework import TestFramework + +simname = "prtfmi03" +cases = [f"{simname}_l1", f"{simname}_l2"] +stopzone_cells = [(0, 1, 8), (0, 8, 1)] + + +def create_izone(nlay, nrow, ncol): + izone = np.zeros((nlay, nrow, ncol), dtype=int) + for iz in stopzone_cells: + izone[iz] = 1 + return izone + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[ + ( + FlopyReadmeCase.perlen, + FlopyReadmeCase.nstp, + FlopyReadmeCase.tsmult, + ) + ], + ) + + # create prt model + prt_name = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + nlay = int(name[-1]) + botm = [FlopyReadmeCase.top - (k + 1) for k in range(nlay)] + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + top=FlopyReadmeCase.top, + botm=botm, + ) + + # create mip package + izone = create_izone(nlay, FlopyReadmeCase.nrow, FlopyReadmeCase.ncol) + flopy.mf6.ModflowPrtmip( + prt, + pname="mip", + porosity=FlopyReadmeCase.porosity, + izone=izone, + ) + + # create prp package + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(FlopyReadmeCase.releasepts_prt), + packagedata=FlopyReadmeCase.releasepts_prt, + perioddata={0: ["FIRST"]}, + istopzone=1, + ) + + # create output control package + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + + # create the flow model interface + gwf_name = get_model_name(name, "gwf") + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in FlopyReadmeCase.releasepts_mp7], + localx=[p[1] for p in FlopyReadmeCase.releasepts_mp7], + localy=[p[2] for p in FlopyReadmeCase.releasepts_mp7], + localz=[p[3] for p in FlopyReadmeCase.releasepts_mp7], + timeoffset=0, + drape=0, + ) + mp7_name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + nlay = int(name[-1]) + izone = create_izone(nlay, FlopyReadmeCase.nrow, FlopyReadmeCase.ncol) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + stopzone=1, + zones=izone, + zonedataoption="on", + particlegroups=[pg], + ) + + return mp + + +def build_models(idx, test): + gwf_sim = FlopyReadmeCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + gwf = gwf_sim.get_model() + dis = gwf.get_package("DIS") + nlay = int(test.name[-1]) + botm = [FlopyReadmeCase.top - (k + 1) for k in range(nlay)] + botm_data = np.array( + [ + list(repeat(b, FlopyReadmeCase.nrow * FlopyReadmeCase.ncol)) + for b in botm + ] + ).reshape((nlay, FlopyReadmeCase.nrow, FlopyReadmeCase.ncol)) + dis.nlay = nlay + dis.botm.set_data(botm_data) + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + mp7_sim = build_mp7_sim( + test.name, test.workspace / "mp7", test.targets["mp7"], gwf + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7_name}.mppth" + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=prt_ws / prt_track_csv_file, + ) + + # get head, budget, and spdis results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup map view plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + def sort_square_verts(verts): + """Sort 4 or more points on a square in clockwise order, starting with the top-left point""" + + # sort by y coordinate + verts.sort(key=lambda v: v[1], reverse=True) + + # separate top and bottom rows + y0 = verts[0][1] + t = [v for v in verts if v[1] == y0] + b = verts[len(t) :] + + # sort top and bottom rows by x coordinate + t.sort(key=lambda v: v[0]) + b.sort(key=lambda v: v[0]) + + # return vertices in clockwise order + return t + list(reversed(b)) + + def plot_stop_zone(nn, ax): + ifaces = [] + iverts = mg.iverts[nn] + + # sort vertices of well cell in clockwise order + verts = [tuple(mg.verts[v]) for v in iverts] + sorted_verts = sort_square_verts(list(set(verts.copy()))) + for i in range(len(sorted_verts) - 1): + if i == 0: + p0 = sorted_verts[-1] + p1 = sorted_verts[i] + ifaces.append([p0, p1]) + p0 = sorted_verts[i] + p1 = sorted_verts[(i + 1)] + ifaces.append([p0, p1]) + + lc = LineCollection(ifaces, color="red", lw=4) + ax.add_collection(lc) + + # plot stop zones + for iz in stopzone_cells: + for a in ax: + plot_stop_zone(mg.get_node([iz])[0], a) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{name}_map.png") + + # check that cell numbers are correct + for i, row in list(mf6_pls.iterrows()): + # todo debug final cell number disagreement + if row.ireason == 3: # termination + continue + + x, y, z, t, ilay, icell = ( + row.x, + row.y, + row.z, + row.t, + row.ilay, + row.icell, + ) + k, i, j = mg.intersect(x, y, z) + nn = mg.get_node([k, i, j]) + 1 + neighbors = mg.neighbors(nn) + assert np.isclose(nn, icell, atol=1) or any( + (nn - 1) == n for n in neighbors + ) + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # drop duplicates and sort both dataframes + # todo debug why necessary to drop dupes + cols = ["particleid", "time"] + mp7_pls = mp7_pls.drop_duplicates(subset=cols) + mf6_pls = mf6_pls.drop_duplicates(subset=cols) + mf6_pls = mf6_pls.sort_values(by=cols) + mp7_pls = mp7_pls.sort_values(by=cols) + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_ternary_methods.py b/autotest/test_prt_ternary_methods.py new file mode 100644 index 00000000000..c630d65c18e --- /dev/null +++ b/autotest/test_prt_ternary_methods.py @@ -0,0 +1,194 @@ +""" +Tests a PRT model on the vertex grid demonstrated +at the end of Flopy's triangular mesh example: + +https://flopy.readthedocs.io/en/latest/Notebooks/dis_triangle_example.html + +There are two scenarios, both of which release +particles from the right border of the grid. In +the 1st case flow is left to right, in the 2nd +flow is top right to bottom left. + +Runtime is benchmarked with pytest-benchmark. +The ZERO_METHOD option is used to select root- +finding methods for total runtime comparison. +""" + +from math import isclose +from pathlib import Path + +import flopy +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.discretization import VertexGrid +from flopy.utils import GridIntersect +from flopy.utils.triangle import Triangle +from prt_test_utils import get_model_name +from shapely.geometry import LineString + +from framework import TestFramework +from test_prt_triangle import ( + active_domain, + nlay, + top, + botm, + porosity, + get_tri, + build_gwf_sim, +) + +simname = "prtter" +cases = [ + f"{simname}eu", + f"{simname}br", + f"{simname}ch", + # f"{simname}test", +] +methods = [ + 0, # euler + 1, # brent + 2, # chandrupatla + # 3 # test method (doesn't always converge??) +] + + +def build_prt_sim(idx, name, gwf_ws, prt_ws, targets): + prt_ws = Path(prt_ws) + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # create grid + tri = get_tri(prt_ws / "grid", targets) + grid = VertexGrid(tri) + gi = GridIntersect(grid) + + # identify cells on left edge + line = LineString([active_domain[0], active_domain[-1]]) + cells_left = gi.intersect(line)["cellids"] + cells_left = np.array(list(cells_left)) + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=prt_ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + cell2d = tri.get_cell2d() + vertices = tri.get_vertices() + xcyc = tri.get_xcyc() + ncpl = tri.ncpl + nvert = tri.nvert + dis = flopy.mf6.ModflowGwfdisv( + prt, + nlay=nlay, + ncpl=ncpl, + nvert=nvert, + top=top, + botm=botm, + vertices=vertices, + cell2d=cell2d, + ) + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=porosity, zero_method=methods[idx] + ) + prpdata = [ + # particle index, (layer, cell index), x, y, z + (0, (0, 88), 95, 92, 0.5), + (1, (0, 86), 96, 86, 0.5), + ] + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(prpdata), + packagedata=prpdata, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + boundnames=True, + stop_at_weak_sink=True, # currently required for this problem + ) + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + gwf_budget_file = gwf_ws / f"{gwfname}.cbc" + gwf_head_file = gwf_ws / f"{gwfname}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + return sim + + +def build_models(idx, test): + gwf_sim = build_gwf_sim( + test.name, test.workspace, test.targets, ["left", "botm"] + ) + prt_sim = build_prt_sim( + idx, test.name, test.workspace, test.workspace / "prt", test.targets + ) + return gwf_sim, prt_sim + + +def check_output(idx, test): + name = test.name + prt_ws = test.workspace / "prt" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + + # get gwf output + gwf = gwf_sim.get_model() + head = gwf.output.head().get_data() + bdobj = gwf.output.budget() + spdis = bdobj.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # get prt output + prt_name = get_model_name(name, "prt") + prt_track_csv_file = f"{prt_name}.prp.trk.csv" + pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + endpts = ( + pls.sort_values("t") + .groupby(["imdl", "iprp", "irpt", "trelease"]) + .tail(1) + ) + + # check pathline shape and endpoints + assert pls.shape == (112, 16) + assert endpts.shape == (2, 16) + assert set(endpts.icell) == {111, 144} + + +@pytest.mark.parametrize("idx, name", enumerate(cases)) +def test_mf6model(idx, name, function_tmpdir, targets, benchmark): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + compare=None, + ) + benchmark(test.run) diff --git a/autotest/test_prt_track_events.py b/autotest/test_prt_track_events.py new file mode 100644 index 00000000000..45c9c5f7ecb --- /dev/null +++ b/autotest/test_prt_track_events.py @@ -0,0 +1,514 @@ +""" +This test exercises TRACKEVENT options to check +that tracking event selection works as expected. + +GWF and PRT models run in separate simulations. + +The grid is a 10x10 square with a single layer, +the same flow system shown on the FloPy readme, +except for 2 inactive cells in the bottom left +and top right corners. + +The flow system is similar to test_prt_fmi01.py. +Particles are split across two release packages, +and the grid has an inactive region this time, +to check cell numbers recorded in pathline data +are converted from reduced to user node numbers. +This is verified with FloPy by intersecting path +points with the grid then computing node numbers. + +Particles are released from the top left cell. + +Pathlines are compared with a MODPATH 7 model. +""" + +from pathlib import Path +from typing import List + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import ( + FlopyReadmeCase, + check_budget_data, + check_track_data, + get_model_name, +) + +from framework import TestFramework + +simname = "prtevnt" +cases = [ + f"{simname}all", + f"{simname}rel", + f"{simname}tsit", + f"{simname}tstp", + f"{simname}term", + f"{simname}wksk", + f"{simname}mult", + f"{simname}trts", +] +releasepts_prt = { + "a": [ + # index, k, i, j, x, y, z + [i, 0, 0, 0, float(f"0.{i + 1}"), float(f"9.{i + 1}"), 0.5] + for i in range(4) + ], + "b": [ + # index, k, i, j, x, y, z + [i, 0, 0, 0, float(f"0.{i + 5}"), float(f"9.{i + 5}"), 0.5] + for i in range(5) + ], +} +releasepts_mp7 = { + "a": [ + # node number, localx, localy, localz + (0, float(f"0.{i + 1}"), float(f"0.{i + 1}"), 0.5) + for i in range(4) + ], + "b": [ + # node number, localx, localy, localz + (0, float(f"0.{i + 5}"), float(f"0.{i + 5}"), 0.5) + for i in range(5) + ], +} +tracktimes = list(np.linspace(0, 50, 1000)) + + +# function to create idomain from grid dimensions +def create_idomain(nlay, nrow, ncol): + idmn = np.ones((nlay, nrow, ncol), dtype=int) + idmn[0, 0, 9] = 0 + idmn[0, 9, 0] = 0 + return idmn + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[ + ( + FlopyReadmeCase.perlen, + FlopyReadmeCase.nstp, + FlopyReadmeCase.tsmult, + ) + ], + ) + + # create prt model + prt_name = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + idomain=create_idomain( + FlopyReadmeCase.nlay, FlopyReadmeCase.nrow, FlopyReadmeCase.ncol + ), + ) + + # create mip package + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=FlopyReadmeCase.porosity + ) + + # create a prp package for groups a and b + prps = [ + flopy.mf6.ModflowPrtprp( + prt, + pname=f"prp_{grp}", + filename=f"{prt_name}_{grp}.prp", + nreleasepts=len(releasepts_prt[grp]), + packagedata=releasepts_prt[grp], + perioddata={0: ["FIRST"]}, + ) + for grp in ["a", "b"] + ] + + def get_oc() -> List[str]: + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + if "all" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_all=True, + ) + elif "rel" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_release=True, + ) + elif "tsit" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_transit=True, + ) + elif "tstp" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_timestep=True, + ) + elif "wksk" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_weaksink=True, + ) + elif "term" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_terminate=True, + ) + elif "mult" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_release=True, + track_terminate=True, + ) + elif "trts" in name: + return flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_usertime=True, + track_timesrecord=tracktimes if "trts" in name else None, + ) + + oc = get_oc() + + # create the flow model interface + gwf_name = get_model_name(name, "gwf") + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + mp7_name = get_model_name(name, "mp7") + pgs = [ + flopy.modpath.ParticleGroup( + particlegroupname=f"group_{grp}", + particledata=flopy.modpath.ParticleData( + partlocs=[p[0] for p in releasepts_mp7[grp]], + localx=[p[1] for p in releasepts_mp7[grp]], + localy=[p[2] for p in releasepts_mp7[grp]], + localz=[p[3] for p in releasepts_mp7[grp]], + timeoffset=0, + drape=0, + ), + filename=f"{mp7_name}_{grp}.sloc", + ) + for grp in ["a", "b"] + ] + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=pgs, + ) + + return mp + + +def build_models(idx, test): + # build gwf model + gwf_sim = FlopyReadmeCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + # add idomain + gwf = gwf_sim.get_model() + dis = gwf.get_package("DIS") + dis.idomain = create_idomain( + FlopyReadmeCase.nlay, FlopyReadmeCase.nrow, FlopyReadmeCase.ncol + ) + + # build prt model + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + # build mp7 model + mp7_sim = build_mp7_sim( + test.name, test.workspace / "mp7", test.targets["mp7"], gwf + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + mp7_pathline_file = f"{mp7_name}.mppth" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file) + + # check pathlines total size + expected_len = 0 + if "all" in name: + expected_len = len(mp7_pls) + if "rel" in name: + expected_len += len(releasepts_prt["a"]) + len(releasepts_prt["b"]) + if "term" in name: + expected_len += len(releasepts_prt["a"]) + len(releasepts_prt["b"]) + if "tsit" in name: + expected_len += len(mp7_pls) - 2 * ( + len(releasepts_prt["a"]) + len(releasepts_prt["b"]) + ) + if "tstp" in name: + pass + if "wksk" in name: + pass + if "trts" in name: + expected_len += 5324 # hardcoded... todo: or 5315?? debug + if "mult" in name: + expected_len += 2 * ( + len(releasepts_prt["a"]) + len(releasepts_prt["b"]) + ) + assert len(mf6_pls) == expected_len + + # make sure mf6 pathline data have correct + # - model index (1) + # - PRP index (1 or 2, depending on release point index) + def all_equal(col, val): + a = col.to_numpy() + return a[0] == val and (a[0] == a).all() + + if len(mf6_pls) > 0: + assert all_equal(mf6_pls["imdl"], 1) + assert set(mf6_pls[mf6_pls["iprp"] == 1]["irpt"].unique()) == set( + range(1, 5) + ) + assert set(mf6_pls[mf6_pls["iprp"] == 2]["irpt"].unique()) == set( + range(1, 6) + ) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=prt_ws / prt_track_csv_file, + ) + + # check that particle names are particle indices + # assert len(mf6_pldata) == len(mf6_pldata[mf6_pldata['irpt'].astype(str).eq(mf6_pldata['name'])]) + + # get head, budget, and spdis results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + marker="o", + markersize=2, + linestyle="None", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(modelgrid=mg, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + # check that cell numbers are correct + for i, row in list(mf6_pls.iterrows()): + # todo debug final cell number disagreement + if row.ireason == 3: # termination + continue + + x, y, z, t, ilay, icell = ( + row.x, + row.y, + row.z, + row.t, + row.ilay, + row.icell, + ) + k, i, j = mg.intersect(x, y, z) + nn = mg.get_node([k, i, j]) + 1 + neighbors = mg.neighbors(nn) + assert np.isclose(nn, icell, atol=1) or any( + (nn - 1) == n for n in neighbors + ), f"nn comparison failed: expected {nn}, got {icell}" + assert ilay == (k + 1) == 1 + + if "all" in name: + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # sort both dataframes + cols = ["x", "y", "z", "time"] + mf6_pls = mf6_pls.sort_values(by=cols) + mp7_pls = mp7_pls.sort_values(by=cols) + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_triangle.py b/autotest/test_prt_triangle.py new file mode 100644 index 00000000000..fc9bb94da7d --- /dev/null +++ b/autotest/test_prt_triangle.py @@ -0,0 +1,297 @@ +""" +Tests a PRT model on the vertex grid demonstrated +at the end of Flopy's triangular mesh example: + +https://flopy.readthedocs.io/en/latest/Notebooks/dis_triangle_example.html + +There are two scenarios, both of which release +particles from the right border of the grid. In +the 1st case flow is left to right, in the 2nd +flow is top right to bottom left. +""" + +from math import isclose +from pathlib import Path + +import flopy +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.discretization import VertexGrid +from flopy.utils import GridIntersect +from flopy.utils.triangle import Triangle +from prt_test_utils import get_model_name +from shapely.geometry import LineString + +from framework import TestFramework + +simname = "prttri" +cases = [f"{simname}r2l", f"{simname}diag"] +angle = 30 +max_area = 100 +active_domain = [(0, 0), (100, 0), (100, 100), (0, 100)] +nlay = 1 +top = 1.0 +botm = [0.0] +k = 10.0 +tdis_rc = [[1.0, 1, 1.0]] +porosity = 0.1 + + +def get_chd_head(x): + return x * 10.0 / 100.0 + + +def get_tri(workspace, targets) -> Triangle: + workspace.mkdir(exist_ok=True, parents=True) + tri = Triangle( + angle=angle, + maximum_area=max_area, + model_ws=workspace, + exe_name=targets["triangle"], + ) + tri.add_polygon(active_domain) + tri.build() + return tri + + +def build_gwf_sim(name, ws, targets, chd_sides=None): + ws = Path(ws) + gwfname = get_model_name(name, "gwf") + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=ws + ) + tdis = flopy.mf6.ModflowTdis(sim, time_units="DAYS", perioddata=tdis_rc) + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwfname, save_flows=True) + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="complex", + outer_dvclose=1.0e-8, + inner_dvclose=1.0e-8, + ) + tri = get_tri(ws / "grid", targets) + cell2d = tri.get_cell2d() + vertices = tri.get_vertices() + xcyc = tri.get_xcyc() + ncpl = tri.ncpl + nvert = tri.nvert + dis = flopy.mf6.ModflowGwfdisv( + gwf, + nlay=nlay, + ncpl=ncpl, + nvert=nvert, + top=top, + botm=botm, + vertices=vertices, + cell2d=cell2d, + ) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + xt3doptions=[(True)], + save_specific_discharge=True, + save_saturation=True, + ) + ic = flopy.mf6.ModflowGwfic(gwf) + cells = [] + chdlist = [] + + if isinstance(chd_sides, (list, tuple)): + if "left" in chd_sides: + leftcells = tri.get_edge_cells(4) + cells.extend(leftcells) + if "right" in chd_sides: + rightcells = tri.get_edge_cells(2) + cells.extend(rightcells) + if "botm" in chd_sides: + botmcells = tri.get_edge_cells(3) + cells.extend(botmcells) + if "top" in chd_sides: + topcells = tri.get_edge_cells(1) + cells.extend(topcells) + for icpl in set(cells): + h = get_chd_head(xcyc[icpl, 0]) + chdlist.append([(0, icpl), h]) + + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdlist) + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwfname}.cbc", + head_filerecord=f"{gwfname}.hds", + saverecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + return sim + + +def build_prt_sim(idx, name, gwf_ws, prt_ws, targets): + prt_ws = Path(prt_ws) + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # create grid + tri = get_tri(prt_ws / "grid", targets) + grid = VertexGrid(tri) + gi = GridIntersect(grid) + + # identify cells on left edge + line = LineString([active_domain[0], active_domain[-1]]) + cells_left = gi.intersect(line)["cellids"] + cells_left = np.array(list(cells_left)) + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=prt_ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + cell2d = tri.get_cell2d() + vertices = tri.get_vertices() + xcyc = tri.get_xcyc() + ncpl = tri.ncpl + nvert = tri.nvert + dis = flopy.mf6.ModflowGwfdisv( + prt, + nlay=nlay, + ncpl=ncpl, + nvert=nvert, + top=top, + botm=botm, + vertices=vertices, + cell2d=cell2d, + ) + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=porosity) + prpdata = [ + # particle index, (layer, cell index), x, y, z + (0, (0, 88), 95, 92, 0.5), + (1, (0, 86), 96, 86, 0.5), + ] + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(prpdata), + packagedata=prpdata, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + boundnames=True, + stop_at_weak_sink=True, # currently required for this problem + ) + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + gwf_budget_file = gwf_ws / f"{gwfname}.cbc" + gwf_head_file = gwf_ws / f"{gwfname}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + return sim + + +def build_models(idx, test): + gwf_sim = build_gwf_sim( + test.name, + test.workspace, + test.targets, + ( + ["left", "right"] + if "r2l" in test.name + else ["left", "botm"] if "diag" in test.name else None + ), + ) + prt_sim = build_prt_sim( + idx, test.name, test.workspace, test.workspace / "prt", test.targets + ) + return gwf_sim, prt_sim + + +def check_output(idx, test): + name = test.name + prt_ws = test.workspace / "prt" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + + # get gwf output + gwf = gwf_sim.get_model() + head = gwf.output.head().get_data() + bdobj = gwf.output.budget() + spdis = bdobj.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # get prt output + prt_name = get_model_name(name, "prt") + prt_track_csv_file = f"{prt_name}.prp.trk.csv" + pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + endpts = ( + pls.sort_values("t") + .groupby(["imdl", "iprp", "irpt", "trelease"]) + .tail(1) + ) + + plot_debug = False + if plot_debug: + fig = plt.figure(figsize=(10, 10)) + ax = plt.subplot(1, 1, 1, aspect="equal") + pmv = flopy.plot.PlotMapView(model=gwf, ax=ax) + pmv.plot_grid() + pmv.plot_array(head, cmap="Blues", alpha=0.25) + pmv.plot_vector(qx, qy, normalize=True, alpha=0.25) + mf6_plines = pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title=f"MF6 pathlines ({name})", + kind="line", + x="x", + y="y", + ax=ax, + legend=False, + color="black", + ) + plt.show() + + if "r2l" in name: + assert pls.shape == (76, 16) + assert (pls.z == 0.5).all() + assert isclose(min(pls.x), 5.1145, rel_tol=1e-6) + assert isclose(max(pls.x), 96, rel_tol=1e-6) + assert set(endpts.icell) == {12, 128} + elif "diag" in name: + assert pls.shape == (112, 16) + assert endpts.shape == (2, 16) + assert set(endpts.icell) == {111, 144} + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_voronoi1.py b/autotest/test_prt_voronoi1.py new file mode 100644 index 00000000000..192550a3080 --- /dev/null +++ b/autotest/test_prt_voronoi1.py @@ -0,0 +1,412 @@ +""" +Tests a PRT model on the Voronoi grid demonstrated +in Flopy's Voronoi example: + +https://flopy.readthedocs.io/en/latest/Notebooks/dis_voronoi_example.html + +Three variants are included, first with straight +left to right pathlines and no boundary conditions, +then again with wells, first pumping, then injection. + +TODO: support parallel adjacent cell faces, +duplicated vertices as flopy.utils.voronoi +can produce via scipy/Qhull (for now flopy +filters these but mf6 probably should too) +""" + +from math import isclose +from pathlib import Path + +import flopy +import matplotlib as mpl +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.discretization import VertexGrid +from flopy.utils import GridIntersect +from flopy.utils.triangle import Triangle +from flopy.utils.voronoi import VoronoiGrid +from prt_test_utils import get_model_name +from shapely.geometry import LineString, Point + +from framework import TestFramework + +simname = "prtvor1" +cases = [f"{simname}l2r", f"{simname}welp", f"{simname}weli"] +times = [True, False, False] +tracktimes = list(np.linspace(0, 40000, 100)) +xmin = 0.0 +xmax = 2000.0 +ymin = 0.0 +ymax = 1000.0 +top = 1.0 +botm = [0.0] +angle_min = 30 +area_max = 1000.0 +delr = area_max**0.5 +nlay = 1 +ncol = xmax / delr +nrow = ymax / delr +nodes = ncol * nrow +porosity = 0.1 +rpts = [[20, i, 0.5] for i in range(1, 999, 20)] + + +def get_grid(workspace, targets): + workspace.mkdir(exist_ok=True, parents=True) + tri = Triangle( + maximum_area=area_max, + angle=angle_min, + model_ws=workspace, + exe_name=targets["triangle"], + ) + poly = np.array(((xmin, ymin), (xmax, ymin), (xmax, ymax), (xmin, ymax))) + tri.add_polygon(poly) + tri.build(verbose=False) + return VoronoiGrid(tri) + + +def build_gwf_sim(name, ws, targets): + ws = Path(ws) + gwf_name = get_model_name(name, "gwf") + + # create grid + grid = get_grid(ws / "grid", targets) + vgrid = VertexGrid(**grid.get_gridprops_vertexgrid(), nlay=1) + ibd = np.zeros(vgrid.ncpl, dtype=int) + gi = GridIntersect(vgrid) + + # identify cells on left edge + line = LineString([(xmin, ymin), (xmin, ymax)]) + cells_left = gi.intersect(line)["cellids"] + cells_left = np.array(list(cells_left)) + ibd[cells_left] = 1 + + # identify cells on right edge + line = LineString([(xmax, ymin), (xmax, ymax)]) + cells_right = gi.intersect(line)["cellids"] + cells_right = np.array(list(cells_right)) + ibd[cells_right] = 2 + + # identify cells on bottom edge + line = LineString([(xmin, ymin), (xmax, ymin)]) + cells_bottom = gi.intersect(line)["cellids"] + cells_bottom = np.array(list(cells_bottom)) + ibd[cells_bottom] = 3 + + # identify release cell + point = Point((500, 500)) + cells2 = gi.intersect(point)["cellids"] + cells2 = np.array(list(cells2)) + + # identify well cell + points = [Point((1200, 500)), Point((700, 200)), Point((1600, 700))] + well_cells = [vgrid.intersect(p.x, p.y) for p in points] + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwf_name, save_flows=True) + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="complex", + outer_dvclose=1.0e-8, + inner_dvclose=1.0e-8, + ) + disv = flopy.mf6.ModflowGwfdisv( + gwf, nlay=nlay, **grid.get_disv_gridprops(), top=top, botm=botm + ) + if "wel" in name: + # k, j, q + wells = [ + (0, c, 0.5 * (-1 if "welp" in name else 1)) for c in well_cells + ] + wel = flopy.mf6.ModflowGwfwel( + gwf, + maxbound=len(wells), + save_flows=True, + stress_period_data={0: wells}, + ) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + xt3doptions=[(True)], + k=10.0, + save_saturation=True, + save_specific_discharge=True, + ) + ic = flopy.mf6.ModflowGwfic(gwf) + + chdlist = [] + icpl_seen = [] + for icpl in cells_left: + chdlist.append([(0, icpl), 1.0]) + icpl_seen.append(icpl) + for icpl in cells_right: + chdlist.append([(0, icpl), 0.0]) + icpl_seen.append(icpl) + if "wel" in name: + for icpl in cells_bottom: + if icpl in icpl_seen: + continue + chdlist.append([(0, icpl), 0.8]) + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdlist) + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwf_name}.bud", + head_filerecord=f"{gwf_name}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + return sim + + +def build_prt_sim(idx, name, gwf_ws, prt_ws, targets): + prt_ws = Path(prt_ws) + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + + # create grid + grid = get_grid(prt_ws / "grid", targets) + gridprops = grid.get_gridprops_vertexgrid() + vgrid = VertexGrid(**gridprops, nlay=1) + ibd = np.zeros(vgrid.ncpl, dtype=int) + gi = GridIntersect(vgrid) + + # identify cells on left edge + line = LineString([(xmin, ymin), (xmin, ymax)]) + cells0 = gi.intersect(line)["cellids"] + cells0 = np.array(list(cells0)) + ibd[cells0] = 1 + + # identify cells on right edge + line = LineString([(xmax, ymin), (xmax, ymax)]) + cells1 = gi.intersect(line)["cellids"] + cells1 = np.array(list(cells1)) + ibd[cells1] = 2 + + # identify well cell + point = Point((800, 500)) + cell_wel = vgrid.intersect(point.x, point.y) + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=prt_ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + disv = flopy.mf6.ModflowGwfdisv( + prt, nlay=nlay, **grid.get_disv_gridprops(), top=top, botm=botm + ) + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=porosity) + + prpdata = [ + # index, (layer, cell index), x, y, z + (i, (0, vgrid.intersect(p[0], p[1])), p[0], p[1], p[2]) + for i, p in enumerate(rpts[1:]) # first release point crashes + ] + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(prpdata), + packagedata=prpdata, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + boundnames=True, + stop_at_weak_sink=True, # currently required for this problem + ) + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + track_all=not times[idx], + track_usertime=times[idx], + track_timesrecord=tracktimes if times[idx] else None, + ) + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + return sim + + +def build_models(idx, test): + gwf_sim = build_gwf_sim(test.name, test.workspace, test.targets) + prt_sim = build_prt_sim( + idx, test.name, test.workspace, test.workspace / "prt", test.targets + ) + return gwf_sim, prt_sim + + +def check_output(idx, test): + name = test.name + prt_ws = test.workspace / "prt" + prt_name = get_model_name(name, "prt") + gwfsim = test.sims[0] + + # get gwf output + gwf = gwfsim.get_model() + head = gwf.output.head().get_data() + bdobj = gwf.output.budget() + spdis = bdobj.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # get prt output + prt_track_csv_file = f"{prt_name}.prp.trk.csv" + pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + endpts = ( + pls.sort_values("t") + .groupby(["imdl", "iprp", "irpt", "trelease"]) + .tail(1) + ) + + if "l2r" in name: + # assert pls.shape == (212, 16) + assert (pls.z == 0.5).all() # no z change + # path should be horizontal from left to right + assert isclose(min(pls.x), 20, rel_tol=1e-4) + assert isclose(max(pls.x), 1980.571, rel_tol=1e-4) + assert isclose(min(pls.y), 21, rel_tol=1e-4) + assert isclose(max(pls.y), 981, rel_tol=1e-4) + + plot_2d = False + if plot_2d: + # plot in 2d with mpl + fig = plt.figure(figsize=(16, 10)) + ax = plt.subplot(1, 1, 1, aspect="equal") + pmv = flopy.plot.PlotMapView(model=gwf, ax=ax) + pmv.plot_grid(alpha=0.25) + pmv.plot_ibound(alpha=0.5) + headmesh = pmv.plot_array(head, alpha=0.25) + cv = pmv.contour_array( + head, levels=np.linspace(0, 1, 9), colors="black" + ) + plt.clabel(cv) + plt.colorbar( + headmesh, shrink=0.25, ax=ax, label="Head", location="right" + ) + handles = [ + mpl.lines.Line2D( + [0], + [0], + marker=">", + linestyle="", + label="Specific discharge", + color="grey", + markerfacecolor="gray", + ), + ] + if "wel" in name: + handles.append( + mpl.lines.Line2D( + [0], + [0], + marker="o", + linestyle="", + label="Well", + markerfacecolor="red", + ), + ) + ax.legend( + handles=handles, + loc="lower right", + ) + pmv.plot_vector(qx, qy, normalize=True, alpha=0.25) + if "wel" in name: + pmv.plot_bc(ftype="WEL") + mf6_plines = pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + title = "DISV voronoi grid particle tracks" + if "welp" in name: + title += ": pumping wells" + elif "weli" in name: + title += ": injection wells" + pl.plot( + title=title, + kind="line", + linestyle="--", + marker="o", + markersize=2, + x="x", + y="y", + ax=ax, + legend=False, + color="black", + ) + plt.show() + plt.savefig(prt_ws / f"{name}.png") + + plot_3d = False + if plot_3d: + # plot in 3d with pyvista (via vtk) + import pyvista as pv + from flopy.export.vtk import Vtk + from flopy.plot.plotutil import to_mp7_pathlines + + def get_meshes(model, pathlines): + vtk = Vtk(model=model, binary=False, smooth=False) + vtk.add_model(model) + vtk.add_pathline_points( + to_mp7_pathlines(pathlines.to_records(index=False)) + ) + grid_mesh, path_mesh = vtk.to_pyvista() + grid_mesh.rotate_x(-100, point=axes.origin, inplace=True) + grid_mesh.rotate_z(90, point=axes.origin, inplace=True) + grid_mesh.rotate_y(120, point=axes.origin, inplace=True) + path_mesh.rotate_x(-100, point=axes.origin, inplace=True) + path_mesh.rotate_z(90, point=axes.origin, inplace=True) + path_mesh.rotate_y(120, point=axes.origin, inplace=True) + return grid_mesh, path_mesh + + def callback(mesh, value): + sub = pls[pls.t <= value] + gm, pm = get_meshes(gwf, sub) + mesh.shallow_copy(pm) + + pv.set_plot_theme("document") + axes = pv.Axes(show_actor=True, actor_scale=2.0, line_width=5) + p = pv.Plotter(notebook=False) + grid_mesh, path_mesh = get_meshes(gwf, pls) + p.add_mesh(grid_mesh, scalars=head[0], cmap="Blues", opacity=0.5) + p.add_mesh(path_mesh, label="Time", style="points", color="black") + p.camera.zoom(1) + p.add_slider_widget(lambda v: callback(path_mesh, v), [0, 30202]) + p.show() + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_voronoi2.py b/autotest/test_prt_voronoi2.py new file mode 100644 index 00000000000..cd93b532488 --- /dev/null +++ b/autotest/test_prt_voronoi2.py @@ -0,0 +1,434 @@ +""" +Tests a PRT model on the Voronoi grid demonstrated +in Flopy's Voronoi example: + +https://flopy.readthedocs.io/en/latest/Notebooks/dis_voronoi_example.html + +Particles are released from the center of the plume +(i.e. the constant concentration cell) used in the +transport model. + +TODO: support parallel adjacent cell faces, +duplicated vertices as flopy.utils.voronoi +can produce via scipy/Qhull (for now flopy +filters these but mf6 probably should too) +""" + +from pathlib import Path + +import flopy +import matplotlib as mpl +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.discretization import VertexGrid +from flopy.utils import GridIntersect +from flopy.utils.triangle import Triangle +from flopy.utils.voronoi import VoronoiGrid +from prt_test_utils import get_model_name +from shapely.geometry import LineString, Point + +from framework import TestFramework + +simname = "prtvor2" +cases = [simname] +xmin = 0.0 +xmax = 2000.0 +ymin = 0.0 +ymax = 1000.0 +top = 1.0 +botm = [0.0] +angle_min = 30 +area_max = 1000.0 +delr = area_max**0.5 +nlay = 1 +ncol = xmax / delr +nrow = ymax / delr +nodes = ncol * nrow +porosity = 0.1 + + +def get_grid(workspace, targets): + workspace.mkdir(exist_ok=True, parents=True) + tri = Triangle( + maximum_area=area_max, + angle=angle_min, + model_ws=workspace, + exe_name=targets["triangle"], + ) + poly = np.array(((xmin, ymin), (xmax, ymin), (xmax, ymax), (xmin, ymax))) + tri.add_polygon(poly) + tri.build(verbose=False) + return VoronoiGrid(tri) + + +def build_gwf_sim(name, ws, targets): + ws = Path(ws) + gwf_name = get_model_name(name, "gwf") + + # create grid + grid = get_grid(ws / "grid", targets) + vgrid = VertexGrid(**grid.get_gridprops_vertexgrid(), nlay=1) + ibd = np.zeros(vgrid.ncpl, dtype=int) + gi = GridIntersect(vgrid) + + # identify cells on left edge + line = LineString([(xmin, ymin), (xmin, ymax)]) + cells_left = gi.intersect(line)["cellids"] + cells_left = np.array(list(cells_left)) + ibd[cells_left] = 1 + + # identify cells on right edge + line = LineString([(xmax, ymin), (xmax, ymax)]) + cells_right = gi.intersect(line)["cellids"] + cells_right = np.array(list(cells_right)) + ibd[cells_right] = 2 + + # identify cells on bottom edge + line = LineString([(xmin, ymin), (xmax, ymin)]) + cells_bottom = gi.intersect(line)["cellids"] + cells_bottom = np.array(list(cells_bottom)) + ibd[cells_bottom] = 3 + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + gwf = flopy.mf6.ModflowGwf(sim, modelname=gwf_name, save_flows=True) + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="complex", + outer_dvclose=1.0e-8, + inner_dvclose=1.0e-8, + ) + disv = flopy.mf6.ModflowGwfdisv( + gwf, nlay=nlay, **grid.get_disv_gridprops(), top=top, botm=botm + ) + npf = flopy.mf6.ModflowGwfnpf( + gwf, + xt3doptions=[(True)], + k=10.0, + save_saturation=True, + save_specific_discharge=True, + ) + ic = flopy.mf6.ModflowGwfic(gwf) + + chdlist = [] + icpl_seen = [] + for icpl in cells_left: + chdlist.append([(0, icpl), 1.0]) + icpl_seen.append(icpl) + for icpl in cells_right: + chdlist.append([(0, icpl), 0.0]) + icpl_seen.append(icpl) + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdlist) + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwf_name}.bud", + head_filerecord=f"{gwf_name}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + return sim + + +def build_gwt_sim(name, gwf_ws, gwt_ws, targets): + ws = Path(gwt_ws) + gwf_name = get_model_name(name, "gwf") + gwt_name = get_model_name(name, "gwt") + + # create grid + grid = get_grid(ws / "grid", targets) + vgrid = VertexGrid(**grid.get_gridprops_vertexgrid(), nlay=1) + ibd = np.zeros(vgrid.ncpl, dtype=int) + gi = GridIntersect(vgrid) + + # identify release cell + point = Point((500, 500)) + cells2 = gi.intersect(point)["cellids"] + cells2 = np.array(list(cells2)) + + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[100 * 365.0, 100, 1.0]] + ) + gwt = flopy.mf6.ModflowGwt(sim, modelname=gwt_name, save_flows=True) + ims = flopy.mf6.ModflowIms( + sim, + print_option="SUMMARY", + complexity="simple", + linear_acceleration="bicgstab", + outer_dvclose=1.0e-6, + inner_dvclose=1.0e-6, + ) + disv_gridprops = grid.get_disv_gridprops() + nlay = 1 + top = 1.0 + botm = [0.0] + disv = flopy.mf6.ModflowGwtdisv( + gwt, nlay=nlay, **disv_gridprops, top=top, botm=botm + ) + ic = flopy.mf6.ModflowGwtic(gwt, strt=0.0) + sto = flopy.mf6.ModflowGwtmst(gwt, porosity=0.2) + adv = flopy.mf6.ModflowGwtadv(gwt, scheme="TVD") + dsp = flopy.mf6.ModflowGwtdsp(gwt, alh=5.0, ath1=0.5) + sourcerecarray = [()] + ssm = flopy.mf6.ModflowGwtssm(gwt, sources=sourcerecarray) + cnclist = [ + [(0, cells2[0]), 1.0], + ] + cnc = flopy.mf6.ModflowGwtcnc( + gwt, maxbound=len(cnclist), stress_period_data=cnclist, pname="CNC-1" + ) + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowGwtfmi( + gwt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + oc = flopy.mf6.ModflowGwtoc( + gwt, + budget_filerecord=f"{name}.cbc", + concentration_filerecord=f"{name}.ucn", + saverecord=[("CONCENTRATION", "ALL"), ("BUDGET", "ALL")], + ) + + return sim + + +def build_prt_sim(name, gwf_ws, prt_ws, targets): + prt_ws = Path(prt_ws) + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + + # create grid + grid = get_grid(prt_ws / "grid", targets) + gridprops = grid.get_gridprops_vertexgrid() + vgrid = VertexGrid(**gridprops, nlay=1) + ibd = np.zeros(vgrid.ncpl, dtype=int) + gi = GridIntersect(vgrid) + + # identify cells on left edge + line = LineString([(xmin, ymin), (xmin, ymax)]) + cells0 = gi.intersect(line)["cellids"] + cells0 = np.array(list(cells0)) + ibd[cells0] = 1 + + # identify cells on right edge + line = LineString([(xmax, ymin), (xmax, ymax)]) + cells1 = gi.intersect(line)["cellids"] + cells1 = np.array(list(cells1)) + ibd[cells1] = 2 + + # identify release cell + point = Point((500, 500)) + cells2 = gi.intersect(point)["cellids"] + cells2 = np.array(list(cells2)) + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, version="mf6", exe_name=targets["mf6"], sim_ws=prt_ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + prt = flopy.mf6.ModflowPrt(sim, modelname=prt_name) + disv = flopy.mf6.ModflowGwfdisv( + prt, nlay=nlay, **grid.get_disv_gridprops(), top=top, botm=botm + ) + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=porosity) + + sddata = flopy.modpath.CellDataType( + columncelldivisions=1, rowcelldivisions=1 + ) + data = flopy.modpath.NodeParticleData( + subdivisiondata=sddata, nodes=[cells2] + ) + prpdata = list(data.to_prp(prt.modelgrid)) + prp_track_file = f"{prt_name}.prp.trk" + prp_track_csv_file = f"{prt_name}.prp.trk.csv" + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prt_name}_1.prp", + nreleasepts=len(prpdata), + packagedata=prpdata, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + boundnames=True, + stop_at_weak_sink=True, # currently required for this problem + ) + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + gwf_budget_file = gwf_ws / f"{gwf_name}.bud" + gwf_head_file = gwf_ws / f"{gwf_name}.hds" + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prt_name}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + return sim + + +def build_models(idx, test): + gwf_sim = build_gwf_sim(test.name, test.workspace, test.targets) + gwt_sim = build_gwt_sim( + test.name, test.workspace, test.workspace / "gwt", test.targets + ) + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets + ) + return gwf_sim, gwt_sim, prt_sim + + +def check_output(idx, test): + name = test.name + prt_ws = test.workspace / "prt" + prt_name = get_model_name(name, "prt") + gwfsim, gwtsim, prtsim = test.sims + + # get gwf output + gwf = gwfsim.get_model() + head = gwf.output.head().get_data() + bdobj = gwf.output.budget() + spdis = bdobj.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # get gwt output + gwt = gwtsim.get_model() + conc = gwt.output.concentration().get_data() + + # get prt output + prt_track_csv_file = f"{prt_name}.prp.trk.csv" + pls = pd.read_csv(prt_ws / prt_track_csv_file, na_filter=False) + + plot_2d = False + if plot_2d: + # plot in 2d with mpl + fig = plt.figure(figsize=(16, 10)) + ax = plt.subplot(1, 1, 1, aspect="equal") + pmv = flopy.plot.PlotMapView(model=gwf, ax=ax) + pmv.plot_grid(alpha=0.25) + pmv.plot_ibound(alpha=0.5) + # headmesh = pmv.plot_array(head, alpha=0.25) + # headctr = pmv.contour_array(head, levels=np.linspace(0, 1, 9), colors="black") + # plt.clabel(headctr) + # plt.colorbar(headmesh, shrink=0.25, ax=ax, label="Head", location="right") + concmesh = pmv.plot_array(conc, cmap="jet") + concctr = pmv.contour_array( + conc, levels=(0.0001, 0.001, 0.01, 0.1), colors="y" + ) + plt.clabel(concctr) + plt.colorbar( + concmesh, + shrink=0.25, + ax=ax, + label="Concentration", + location="right", + ) + + handles = [ + mpl.lines.Line2D( + [0], + [0], + marker=">", + linestyle="", + label="Specific discharge", + color="grey", + markerfacecolor="gray", + ), + ] + ax.legend( + handles=handles, + loc="lower right", + ) + pmv.plot_vector(qx, qy, normalize=True, alpha=0.25) + mf6_plines = pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + title = "DISV voronoi grid particle tracks" + pl.plot( + title=title, + kind="line", + x="x", + y="y", + ax=ax, + legend=False, + color="black", + ) + plt.show() + plt.savefig(prt_ws / f"{name}.png") + + plot_3d = False + if plot_3d: + # plot in 3d with pyvista (via vtk) + import pyvista as pv + from flopy.export.vtk import Vtk + from flopy.plot.plotutil import to_mp7_pathlines + + def get_meshes(model, pathlines): + vtk = Vtk(model=model, binary=False, smooth=False) + vtk.add_model(model) + vtk.add_pathline_points( + to_mp7_pathlines(pathlines.to_records(index=False)) + ) + grid_mesh, path_mesh = vtk.to_pyvista() + grid_mesh.rotate_x(-100, point=axes.origin, inplace=True) + grid_mesh.rotate_z(90, point=axes.origin, inplace=True) + grid_mesh.rotate_y(120, point=axes.origin, inplace=True) + path_mesh.rotate_x(-100, point=axes.origin, inplace=True) + path_mesh.rotate_z(90, point=axes.origin, inplace=True) + path_mesh.rotate_y(120, point=axes.origin, inplace=True) + return grid_mesh, path_mesh + + def callback(mesh, value): + sub = pls[pls.t <= value] + gm, pm = get_meshes(gwf, sub) + mesh.shallow_copy(pm) + + pv.set_plot_theme("document") + axes = pv.Axes(show_actor=True, actor_scale=2.0, line_width=5) + p = pv.Plotter(notebook=False) + grid_mesh, path_mesh = get_meshes(gwf, pls) + p.add_mesh(grid_mesh, scalars=head[0], cmap="Blues", opacity=0.5) + p.add_mesh(path_mesh, label="Time", style="points", color="black") + p.camera.zoom(1) + p.add_slider_widget(lambda v: callback(path_mesh, v), [0, 30202]) + p.show() + + +@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=None, + ) + test.run() diff --git a/autotest/test_prt_weak_sinks.py b/autotest/test_prt_weak_sinks.py new file mode 100644 index 00000000000..6f420a40ce0 --- /dev/null +++ b/autotest/test_prt_weak_sinks.py @@ -0,0 +1,380 @@ +""" +GWF and PRT models run in separate simulations +via flow model interface. + +The grid is a 10x10 square with 2 layers, based +on the flow system provided in the FloPy readme. +There is a well near the middle of the grid in +the top layer, which pumps at a very low rate. +Two test cases are defined, one with particle +release package (PRP) option STOP_AT_WEAK_SINK +disabled and one with the option enabled. + +Particles are released from the top left cell. +With the STOP_AT_WEAK_SINK option enabled, the +well is expected to capture one particle. With +STOP_AT_WEAK_SINK disabled, the well no longer +captures the particle. + +Results are compared against a MODPATH 7 model, +using WeakSinkOption 1 (pass-through) when the +STOP_AT_WEAK_SINK option is disabled, and when +it is enabled using WeakSinkOption 2 (stop-at). +""" + +from pathlib import Path +from pprint import pformat + +import flopy +import matplotlib.cm as cm +import matplotlib.pyplot as plt +import numpy as np +import pandas as pd +import pytest +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from flopy.utils.binaryfile import HeadFile +from prt_test_utils import ( + FlopyReadmeCase, + check_budget_data, + check_track_data, + get_ireason_code, + get_model_name, +) + +from framework import TestFramework + +simname = "prtfmi04" +cases = [simname, f"{simname}saws"] + + +def build_prt_sim(name, gwf_ws, prt_ws, mf6): + # output files + gwfname = f"{name}_gwf" + prtname = f"{name}_prt" + gwf_budget_file = gwf_ws / f"{gwfname}.bud" + gwf_head_file = gwf_ws / f"{gwfname}.hds" + prt_track_file = prt_ws / f"{prtname}.trk" + prt_track_csv_file = prt_ws / f"{prtname}.trk.csv" + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=prt_ws, + ) + + # create tdis package + pd = (FlopyReadmeCase.perlen, FlopyReadmeCase.nstp, FlopyReadmeCase.tsmult) + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=FlopyReadmeCase.nper, + perioddata=[pd], + ) + + # create prt model + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=FlopyReadmeCase.nlay, + nrow=FlopyReadmeCase.nrow, + ncol=FlopyReadmeCase.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip( + prt, pname="mip", porosity=FlopyReadmeCase.porosity + ) + + # create prp package + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(FlopyReadmeCase.releasepts_prt), + packagedata=FlopyReadmeCase.releasepts_prt, + perioddata={0: ["FIRST"]}, + stop_at_weak_sink="saws" in name, + ) + + # create output control package + flopy.mf6.ModflowPrtoc( + prt, + pname="oc", + track_filerecord=[prt_track_file], + trackcsv_filerecord=[prt_track_csv_file], + ) + + # create the flow model interface + flopy.mf6.ModflowPrtfmi( + prt, + packagedata=[ + ("GWFHEAD", gwf_head_file), + ("GWFBUDGET", gwf_budget_file), + ], + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(name, ws, mp7, gwf): + mp7_name = f"{name}_mp7" + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in FlopyReadmeCase.releasepts_mp7], + localx=[p[1] for p in FlopyReadmeCase.releasepts_mp7], + localy=[p[2] for p in FlopyReadmeCase.releasepts_mp7], + localz=[p[3] for p in FlopyReadmeCase.releasepts_mp7], + timeoffset=0, + drape=0, + ) + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7_name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7_name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + headfilename=f"{gwf.name}.hds", + budgetfilename=f"{gwf.name}.bud", + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=FlopyReadmeCase.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + weaksinkoption="stop_at" if "saws" in name else "pass_through", + ) + + return mp + + +def get_different_rows(source_df, new_df): + """Returns just the rows from the new dataframe that differ from the source dataframe""" + merged_df = source_df.merge(new_df, indicator=True, how="outer") + changed_rows_df = merged_df[merged_df["_merge"] == "right_only"] + return changed_rows_df.drop("_merge", axis=1) + + +def build_models(idx, test): + # build gwf model + gwf_sim = FlopyReadmeCase.get_gwf_sim( + test.name, test.workspace, test.targets["mf6"] + ) + # add wel package + gwf = gwf_sim.get_model() + wells = [ + # k, i, j, q + (0, 4, 4, -0.1), + ] + wel = flopy.mf6.ModflowGwfwel( + gwf, + maxbound=len(wells), + save_flows=True, + stress_period_data={0: wells, 1: wells}, + ) + + # build prt model + prt_sim = build_prt_sim( + test.name, test.workspace, test.workspace / "prt", test.targets["mf6"] + ) + + # build mp7 model + mp7_sim = build_mp7_sim( + test.name, test.workspace / "mp7", test.targets["mp7"], gwf + ) + return gwf_sim, prt_sim, mp7_sim + + +def check_output(idx, test): + name = test.name + gwf_ws = test.workspace + prt_ws = test.workspace / "prt" + mp7_ws = test.workspace / "mp7" + gwf_name = get_model_name(name, "gwf") + prt_name = get_model_name(name, "prt") + mp7_name = get_model_name(name, "mp7") + gwf_sim = test.sims[0] + gwf = gwf_sim.get_model(gwf_name) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwf_name}.bud" + gwf_head_file = f"{gwf_name}.hds" + prt_track_file = f"{prt_name}.trk" + prt_track_csv_file = f"{prt_name}.trk.csv" + mp7_pathline_file = f"{mp7_name}.mppth" + assert (gwf_ws / gwf_budget_file).is_file() + assert (gwf_ws / gwf_head_file).is_file() + assert (prt_ws / prt_track_file).is_file() + assert (prt_ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + assert (mp7_ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(mp7_ws / mp7_pathline_file) + mp7_pls = pd.DataFrame( + plf.get_destination_pathline_data(range(mg.nnodes), to_recarray=True) + ) + # convert zero-based to one-based indexing in mp7 results + mp7_pls["particlegroup"] = mp7_pls["particlegroup"] + 1 + mp7_pls["node"] = mp7_pls["node"] + 1 + mp7_pls["k"] = mp7_pls["k"] + 1 + + # load mf6 pathline results + mf6_pls = pd.read_csv(prt_ws / prt_track_csv_file) + + # if STOP_AT_WEAK_SINK disabled, check for an extra datum when particle exited weak sink + wksk_irsn = get_ireason_code("WEAKSINK") + assert len(mf6_pls[mf6_pls["ireason"] == wksk_irsn]) == ( + 1 if not "saws" in name else 0 + ) + # then drop the row so comparison will succeed below + mf6_pls.drop(mf6_pls[mf6_pls["ireason"] == wksk_irsn].index, inplace=True) + + # make sure all mf6 pathline data have correct model and PRP index (1) + def all_equal(col, val): + a = col.to_numpy() + return a[0] == val and (a[0] == a).all() + + assert all_equal(mf6_pls["imdl"], 1) + assert all_equal(mf6_pls["iprp"], 1) + + # check budget data were written to mf6 prt list file + check_budget_data( + prt_ws / f"{name}_prt.lst", + FlopyReadmeCase.perlen, + FlopyReadmeCase.nper, + ) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=prt_ws / prt_track_file, + track_hdr=prt_ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=prt_ws / prt_track_csv_file, + ) + + # extract head, budget, and specific discharge results from GWF model + hds = HeadFile(gwf_ws / gwf_head_file).get_data() + bud = gwf.output.budget() + spdis = bud.get_data(text="DATA-SPDIS")[0] + qx, qy, qz = flopy.utils.postprocessing.get_specific_discharge(spdis, gwf) + + # setup plot + fig, ax = plt.subplots(nrows=1, ncols=2, figsize=(10, 10)) + for a in ax: + a.set_aspect("equal") + + # plot mf6 pathlines in map view + pmv = flopy.plot.PlotMapView(model=gwf, ax=ax[0]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + pmv.plot_bc("WEL") + mf6_plines = mf6_pls.groupby(["iprp", "irpt", "trelease"]) + for ipl, ((iprp, irpt, trelease), pl) in enumerate(mf6_plines): + pl.plot( + title="MF6 pathlines", + kind="line", + x="x", + y="y", + ax=ax[0], + legend=False, + color=cm.plasma(ipl / len(mf6_plines)), + ) + + # plot mp7 pathlines in map view + pmv = flopy.plot.PlotMapView(model=gwf, ax=ax[1]) + pmv.plot_grid() + pmv.plot_array(hds[0], alpha=0.1) + pmv.plot_vector(qx, qy, normalize=True, color="white") + pmv.plot_bc("WEL") + mp7_plines = mp7_pls.groupby(["particleid"]) + for ipl, (pid, pl) in enumerate(mp7_plines): + pl.plot( + title="MP7 pathlines", + kind="line", + x="x", + y="y", + ax=ax[1], + legend=False, + color=cm.plasma(ipl / len(mp7_plines)), + ) + + # plot cell centers + # xc, yc = mg.get_xcellcenters_for_layer(0), mg.get_ycellcenters_for_layer(0) + # xc = xc.flatten() + # yc = yc.flatten() + # for i in range(mg.ncpl): + # x, y = xc[i], yc[i] + # nn = mg.get_node(mg.intersect(x, y, 0))[0] + # for a in ax: + # a.plot(x, y, "ro") + # a.annotate(str(nn + 1), (x, y), color="r") + + # view/save plot + # plt.show() + plt.savefig(gwf_ws / f"test_{simname}.png") + + # convert mf6 pathlines to mp7 format + mf6_pls = to_mp7_pathlines(mf6_pls) + + # sort both dataframes by particleid and time + mf6_pls.sort_values(by=["particleid", "time"], inplace=True) + mp7_pls.sort_values(by=["particleid", "time"], inplace=True) + + # drop columns for which there is no direct correspondence between mf6 and mp7 + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["sequencenumber"] + del mp7_pls["particleidloc"] + del mp7_pls["xloc"] + del mp7_pls["yloc"] + del mp7_pls["zloc"] + + # drop node number column because prt and mp7 disagree on a few + del mf6_pls["node"] + del mp7_pls["node"] + + # compare mf6 / mp7 pathline data + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) + + +@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=None, + ) + test.run() diff --git a/autotest/tester.f90 b/autotest/tester.f90 index ed297ef643c..1c9a92d5466 100644 --- a/autotest/tester.f90 +++ b/autotest/tester.f90 @@ -11,6 +11,7 @@ program tester use TestMathUtil, only: collect_mathutil use TestMessage, only: collect_message use TestSim, only: collect_sim + use TestTimeSelect, only: collect_timeselect implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name @@ -27,7 +28,8 @@ program tester new_testsuite("List", collect_list), & new_testsuite("MathUtil", collect_mathutil), & new_testsuite("Message", collect_message), & - new_testsuite("Sim", collect_sim) & + new_testsuite("Sim", collect_sim), & + new_testsuite("TimeSelect", collect_timeselect) & ] call get_argument(1, suite_name) diff --git a/doc/mf6io/body.tex b/doc/mf6io/body.tex index 0c3f69808d1..1a48211159e 100644 --- a/doc/mf6io/body.tex +++ b/doc/mf6io/body.tex @@ -50,6 +50,11 @@ \SECTION{Groundwater Energy Transport (GWE) Model Input} \input{gwe/gwe.tex} +%PRT Model Input Instructions +\newpage +\SECTION{Particle Tracking (PRT) Model Input} +\input{prt/prt.tex} + %SWF Model Input Instructions \newpage \SECTION{Surface Water Flow (SWF) Model Input} diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwfprt.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwfprt.dfn new file mode 100644 index 00000000000..1008a718192 --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/exg-gwfprt.dfn @@ -0,0 +1,3 @@ +# --------------------- exg gwfprt options --------------------- + + diff --git a/doc/mf6io/mf6ivar/dfn/prt-dis.dfn b/doc/mf6io/mf6ivar/dfn/prt-dis.dfn new file mode 100644 index 00000000000..c749650c064 --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-dis.dfn @@ -0,0 +1,122 @@ +# --------------------- prt dis options --------------------- + +block options +name length_units +type string +reader urword +optional true +longname model length units +description is the length units used for this model. Values can be ``FEET'', ``METERS'', or ``CENTIMETERS''. If not specified, the default is ``UNKNOWN''. + +block options +name nogrb +type keyword +reader urword +optional true +longname do not write binary grid file +description keyword to deactivate writing of the binary grid file. + +block options +name xorigin +type double precision +reader urword +optional true +longname x-position of the model grid origin +description x-position of the lower-left corner of the model grid. A default value of zero is assigned if not specified. The value for XORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +block options +name yorigin +type double precision +reader urword +optional true +longname y-position of the model grid origin +description y-position of the lower-left corner of the model grid. If not specified, then a default value equal to zero is used. The value for YORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +block options +name angrot +type double precision +reader urword +optional true +longname rotation angle +description counter-clockwise rotation angle (in degrees) of the lower-left corner of the model grid. If not specified, then a default value of 0.0 is assigned. The value for ANGROT does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + + +# --------------------- prt dis dimensions --------------------- + +block dimensions +name nlay +type integer +reader urword +optional false +longname number of layers +description is the number of layers in the model grid. +default_value 1 + +block dimensions +name nrow +type integer +reader urword +optional false +longname number of rows +description is the number of rows in the model grid. +default_value 2 + +block dimensions +name ncol +type integer +reader urword +optional false +longname number of columns +description is the number of columns in the model grid. +default_value 2 + +# --------------------- prt dis griddata --------------------- + +block griddata +name delr +type double precision +shape (ncol) +reader readarray +longname spacing along a row +description is the column spacing in the row direction. +default_value 1.0 + +block griddata +name delc +type double precision +shape (nrow) +reader readarray +longname spacing along a column +description is the row spacing in the column direction. +default_value 1.0 + +block griddata +name top +type double precision +shape (ncol, nrow) +reader readarray +longname cell top elevation +description is the top elevation for each cell in the top model layer. +default_value 1.0 + +block griddata +name botm +type double precision +shape (ncol, nrow, nlay) +reader readarray +layered true +longname cell bottom elevation +description is the bottom elevation for each cell. +default_value 0. + +block griddata +name idomain +type integer +shape (ncol, nrow, nlay) +reader readarray +layered true +optional true +longname idomain existence array +description is an optional array that characterizes the existence status of a cell. If the IDOMAIN array is not specified, then all model cells exist within the solution. If the IDOMAIN value for a cell is 0, the cell does not exist in the simulation. Input and output values will be read and written for the cell, but internal to the program, the cell is excluded from the solution. If the IDOMAIN value for a cell is 1, the cell exists in the simulation. If the IDOMAIN value for a cell is -1, the cell does not exist in the simulation. Furthermore, the first existing cell above will be connected to the first existing cell below. This type of cell is referred to as a ``vertical pass through'' cell. + + diff --git a/doc/mf6io/mf6ivar/dfn/prt-disv.dfn b/doc/mf6io/mf6ivar/dfn/prt-disv.dfn new file mode 100644 index 00000000000..8ff2a422132 --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-disv.dfn @@ -0,0 +1,204 @@ +# --------------------- prt disv options --------------------- + +block options +name length_units +type string +reader urword +optional true +longname model length units +description is the length units used for this model. Values can be ``FEET'', ``METERS'', or ``CENTIMETERS''. If not specified, the default is ``UNKNOWN''. + +block options +name nogrb +type keyword +reader urword +optional true +longname do not write binary grid file +description keyword to deactivate writing of the binary grid file. + +block options +name xorigin +type double precision +reader urword +optional true +longname x-position origin of the model grid coordinate system +description x-position of the origin used for model grid vertices. This value should be provided in a real-world coordinate system. A default value of zero is assigned if not specified. The value for XORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +block options +name yorigin +type double precision +reader urword +optional true +longname y-position origin of the model grid coordinate system +description y-position of the origin used for model grid vertices. This value should be provided in a real-world coordinate system. If not specified, then a default value equal to zero is used. The value for YORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +block options +name angrot +type double precision +reader urword +optional true +longname rotation angle +description counter-clockwise rotation angle (in degrees) of the model grid coordinate system relative to a real-world coordinate system. If not specified, then a default value of 0.0 is assigned. The value for ANGROT does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +# --------------------- prt disv dimensions --------------------- + +block dimensions +name nlay +type integer +reader urword +optional false +longname number of layers +description is the number of layers in the model grid. + +block dimensions +name ncpl +type integer +reader urword +optional false +longname number of cells per layer +description is the number of cells per layer. This is a constant value for the grid and it applies to all layers. + +block dimensions +name nvert +type integer +reader urword +optional false +longname number of columns +description is the total number of (x, y) vertex pairs used to characterize the horizontal configuration of the model grid. + +# --------------------- prt disv griddata --------------------- + +block griddata +name top +type double precision +shape (ncpl) +reader readarray +longname model top elevation +description is the top elevation for each cell in the top model layer. + +block griddata +name botm +type double precision +shape (ncpl, nlay) +reader readarray +layered true +longname model bottom elevation +description is the bottom elevation for each cell. + +block griddata +name idomain +type integer +shape (ncpl, nlay) +reader readarray +layered true +optional true +longname idomain existence array +description is an optional array that characterizes the existence status of a cell. If the IDOMAIN array is not specified, then all model cells exist within the solution. If the IDOMAIN value for a cell is 0, the cell does not exist in the simulation. Input and output values will be read and written for the cell, but internal to the program, the cell is excluded from the solution. If the IDOMAIN value for a cell is 1, the cell exists in the simulation. If the IDOMAIN value for a cell is -1, the cell does not exist in the simulation. Furthermore, the first existing cell above will be connected to the first existing cell below. This type of cell is referred to as a ``vertical pass through'' cell. + + +# --------------------- prt disv vertices --------------------- + +block vertices +name vertices +type recarray iv xv yv +shape (nvert) +reader urword +optional false +longname vertices data +description + +block vertices +name iv +type integer +in_record true +tagged false +reader urword +optional false +longname vertex number +description is the vertex number. Records in the VERTICES block must be listed in consecutive order from 1 to NVERT. +numeric_index true + +block vertices +name xv +type double precision +in_record true +tagged false +reader urword +optional false +longname x-coordinate for vertex +description is the x-coordinate for the vertex. + +block vertices +name yv +type double precision +in_record true +tagged false +reader urword +optional false +longname y-coordinate for vertex +description is the y-coordinate for the vertex. + + +# --------------------- prt disv cell2d --------------------- + +block cell2d +name cell2d +type recarray icell2d xc yc ncvert icvert +shape (ncpl) +reader urword +optional false +longname cell2d data +description + +block cell2d +name icell2d +type integer +in_record true +tagged false +reader urword +optional false +longname cell2d number +description is the CELL2D number. Records in the CELL2D block must be listed in consecutive order from the first to the last. +numeric_index true + +block cell2d +name xc +type double precision +in_record true +tagged false +reader urword +optional false +longname x-coordinate for cell center +description is the x-coordinate for the cell center. + +block cell2d +name yc +type double precision +in_record true +tagged false +reader urword +optional false +longname y-coordinate for cell center +description is the y-coordinate for the cell center. + +block cell2d +name ncvert +type integer +in_record true +tagged false +reader urword +optional false +longname number of cell vertices +description is the number of vertices required to define the cell. There may be a different number of vertices for each cell. + +block cell2d +name icvert +type integer +shape (ncvert) +in_record true +tagged false +reader urword +optional false +longname array of vertex numbers +description is an array of integer values containing vertex numbers (in the VERTICES block) used to define the cell. Vertices must be listed in clockwise order. Cells that are connected must share vertices. +numeric_index true diff --git a/doc/mf6io/mf6ivar/dfn/prt-fmi.dfn b/doc/mf6io/mf6ivar/dfn/prt-fmi.dfn new file mode 100644 index 00000000000..3deb36646fd --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-fmi.dfn @@ -0,0 +1,50 @@ +# --------------------- prt fmi options --------------------- + +block options +name save_flows +type keyword +reader urword +optional true +longname save cell-by-cell flows to budget file +description REPLACE save_flows {'{#1}': 'FMI'} + +# --------------------- prt fmi packagedata --------------------- + +block packagedata +name packagedata +type recarray flowtype filein fname +reader urword +optional false +longname flowtype list +description + +block packagedata +name flowtype +in_record true +type string +tagged false +reader urword +longname flow type +description is the word GWFBUDGET or GWFHEAD. If GWFBUDGET is specified, then the corresponding file must be a budget file from a previous GWF Model run. + +block packagedata +name filein +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname file keyword +description keyword to specify that an input filename is expected next. + +block packagedata +name fname +in_record true +type string +preserve_case true +tagged false +reader urword +longname file name +description is the name of the file containing flows. The path to the file should be included if the file is not located in the folder where the program was run. + diff --git a/doc/mf6io/mf6ivar/dfn/prt-mip.dfn b/doc/mf6io/mf6ivar/dfn/prt-mip.dfn new file mode 100644 index 00000000000..34f0e6048a9 --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-mip.dfn @@ -0,0 +1,40 @@ +# --------------------- prt mip options --------------------- + +block options +name zero_method +type integer +reader urword +optional true +longname zero method +description the root finding algorithm to solve ternary subcells. 0 euler, 1 brent, 2 chandrupatla, 3 test. + +# --------------------- prt mip griddata --------------------- + +block griddata +name porosity +type double precision +shape (nodes) +reader readarray +layered true +longname porosity +description is the aquifer porosity. + +block griddata +name retfactor +type double precision +shape (nodes) +reader readarray +layered true +optional true +longname retardation factor +description is a real value by which velocity is divided within a given cell. RETFACTOR can be used to account for solute retardation, i.e., the apparent effect of linear sorption on the velocity of particles that track solute advection. RETFACTOR may be assigned any real value. A RETFACTOR value greater than 1 represents particle retardation (slowing), and a value of 1 represents no retardation. The effect of specifying a RETFACTOR value for each cell is the same as the effect of directly multiplying the POROSITY in each cell by the proposed RETFACTOR value for each cell. RETFACTOR allows conceptual isolation of effects such as retardation from the effect of porosity. The default value is 1. + +block griddata +name izone +type integer +shape (nodes) +reader readarray +layered true +optional true +longname zone number +description is an integer zone number assigned to each cell. IZONE may be positive, negative, or zero. The current cell's zone number is recorded with each particle track datum. If the ISTOPZONE option is set to any value other than zero in a PRP Package, particles released by that PRP Package terminate if they enter a cell whose IZONE value matches ISTOPZONE. If ISTOPZONE is not specified or is set to zero in a PRP Package, IZONE has no effect on the termination of particles released by that PRP Package. diff --git a/doc/mf6io/mf6ivar/dfn/prt-nam.dfn b/doc/mf6io/mf6ivar/dfn/prt-nam.dfn new file mode 100644 index 00000000000..e2c5e70e43e --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-nam.dfn @@ -0,0 +1,73 @@ +# --------------------- prt nam options --------------------- + +block options +name list +type string +reader urword +optional true +longname name of listing file +description is name of the listing file to create for this PRT model. If not specified, then the name of the list file will be the basename of the PRT model name file and the '.lst' extension. For example, if the PRT name file is called ``my.model.nam'' then the list file will be called ``my.model.lst''. + +block options +name print_input +type keyword +reader urword +optional true +longname print input to listing file +description REPLACE print_input {'{#1}': 'all model stress package'} + +block options +name print_flows +type keyword +reader urword +optional true +longname print calculated flows to listing file +description REPLACE print_flows {'{#1}': 'all model package'} + +block options +name save_flows +type keyword +reader urword +optional true +longname save flows for all packages to budget file +description REPLACE save_flows {'{#1}': 'all model package'} + +# --------------------- prt nam packages --------------------- + +block packages +name packages +type recarray ftype fname pname +reader urword +optional false +longname package list +description + +block packages +name ftype +in_record true +type string +tagged false +reader urword +longname package type +description is the file type, which must be one of the following character values shown in table~\ref{table:ftype}. Ftype may be entered in any combination of uppercase and lowercase. + +block packages +name fname +in_record true +type string +preserve_case true +tagged false +reader urword +longname file name +description is the name of the file containing the package input. The path to the file should be included if the file is not located in the folder where the program was run. + +block packages +name pname +in_record true +type string +tagged false +reader urword +optional true +longname user name for package +description is the user-defined name for the package. PNAME is restricted to 16 characters. No spaces are allowed in PNAME. PNAME character values are read and stored by the program for stress packages only. These names may be useful for labeling purposes when multiple stress packages of the same type are located within a single PRT Model. If PNAME is specified for a stress package, then PNAME will be used in the flow budget table in the listing file; it will also be used for the text entry in the cell-by-cell budget file. PNAME is case insensitive and is stored in all upper case letters. + diff --git a/doc/mf6io/mf6ivar/dfn/prt-oc.dfn b/doc/mf6io/mf6ivar/dfn/prt-oc.dfn new file mode 100644 index 00000000000..520afa1d9ce --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-oc.dfn @@ -0,0 +1,497 @@ +# --------------------- prt oc options --------------------- + +block options +name budget_filerecord +type record budget fileout budgetfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name budget +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname budget keyword +description keyword to specify that record corresponds to the budget. + +block options +name fileout +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname file keyword +description keyword to specify that an output filename is expected next. + +block options +name budgetfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the output file to write budget information. + +block options +name budgetcsv_filerecord +type record budgetcsv fileout budgetcsvfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name budgetcsv +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname budget keyword +description keyword to specify that record corresponds to the budget CSV. + +block options +name budgetcsvfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the comma-separated value (CSV) output file to write budget summary information. A budget summary record will be written to this file for each time step of the simulation. + +block options +name concentration_filerecord +type record concentration fileout concentrationfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name concentration +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname concentration keyword +description keyword to specify that record corresponds to concentration. + +block options +name concentrationfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the output file to write conc information. + +block options +name concentrationprintrecord +type record concentration print_format formatrecord +shape +reader urword +optional true +longname +description + +block options +name print_format +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname keyword to indicate that a print format follows +description keyword to specify format for printing to the listing file. + +block options +name formatrecord +type record columns width digits format +shape +in_record true +reader urword +tagged +optional false +longname +description + +block options +name columns +type integer +shape +in_record true +reader urword +tagged true +optional +longname number of columns +description number of columns for writing data. + +block options +name width +type integer +shape +in_record true +reader urword +tagged true +optional +longname width for each number +description width for writing each number. + +block options +name digits +type integer +shape +in_record true +reader urword +tagged true +optional +longname number of digits +description number of digits to use for writing a number. + +block options +name format +type string +shape +in_record true +reader urword +tagged false +optional false +longname write format +description write format can be EXPONENTIAL, FIXED, GENERAL, or SCIENTIFIC. + +block options +name track_filerecord +type record track fileout trackfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name track +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname track keyword +description keyword to specify that record corresponds to pathlines. + +block options +name trackfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the output file to write tracking information. + +block options +name trackcsv_filerecord +type record trackcsv fileout trackcsvfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name trackcsv +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname track keyword +description keyword to specify that record corresponds to the track CSV. + +block options +name trackcsvfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the comma-separated value (CSV) file to write tracking information. + +block options +name track_all +type keyword +reader urword +optional true +longname track all events +description whether to track all particle events + +block options +name track_release +type keyword +reader urword +optional true +longname track release +description whether to track particle release events + +block options +name track_transit +type keyword +reader urword +optional true +longname track transitions +description whether to track cell-to-cell transitions + +block options +name track_timestep +type keyword +reader urword +optional true +longname track timestep ends +description whether to track transitions between timesteps + +block options +name track_terminate +type keyword +reader urword +optional true +longname track termination +description whether to track particle termination events + +block options +name track_weaksink +type keyword +reader urword +optional true +longname track weaksink exits +description whether to track occasions when a particle exits a weak sink (a cell which removes some but not all inflow from adjacent cells) + +block options +name track_usertime +type keyword +reader urword +optional true +longname track termination +description whether to track user-specified times, provided as double precision values to the TRACK\_TIMES or TRACK\_TIMESFILE options + +block options +name track_timesrecord +type record track_times times +shape +reader urword +tagged true +optional true +longname +description + +block options +name track_times +type keyword +reader urword +in_record true +tagged true +shape +longname +description keyword indicating tracking times will follow + +block options +name times +type double precision +shape (unknown) +reader urword +in_record true +tagged false +repeating true +longname tracking times +description times to track, relative to the beginning of the simulation. + +block options +name track_timesfilerecord +type record track_timesfile timesfile +shape +reader urword +tagged true +optional true +longname +description + +block options +name track_timesfile +type keyword +reader urword +in_record true +tagged true +shape +longname +description keyword indicating tracking times file name will follow + +block options +name timesfile +type string +preserve_case true +shape +in_record true +reader urword +tagged false +optional false +longname file keyword +description name of the tracking times file + +# --------------------- prt oc period --------------------- + +block period +name iper +type integer +block_variable True +in_record true +tagged false +shape +valid +reader urword +optional false +longname stress period number +description REPLACE iper {} + +block period +name saverecord +type record save rtype ocsetting +shape +reader urword +tagged false +optional true +longname +description + +block period +name save +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname keyword to save +description keyword to indicate that information will be saved this stress period. + +block period +name printrecord +type record print rtype ocsetting +shape +reader urword +tagged false +optional true +longname +description + +block period +name print +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname keyword to save +description keyword to indicate that information will be printed this stress period. + +block period +name rtype +type string +shape +in_record true +reader urword +tagged false +optional false +longname record type +description type of information to save or print. Can be BUDGET or CONCENTRATION. + +block period +name ocsetting +type keystring all first last frequency steps +shape +tagged false +in_record true +reader urword +longname +description specifies the steps for which the data will be saved. + +block period +name all +type keyword +shape +in_record true +reader urword +longname +description keyword to indicate save for all time steps in period. + +block period +name first +type keyword +shape +in_record true +reader urword +longname +description keyword to indicate save for first step in period. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +block period +name last +type keyword +shape +in_record true +reader urword +longname +description keyword to indicate save for last step in period. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +block period +name frequency +type integer +shape +tagged true +in_record true +reader urword +longname +description save at the specified time step frequency. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +block period +name steps +type integer +shape ( + NROW + NCOL +END DIMENSIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-dis-griddata.dat b/doc/mf6io/mf6ivar/tex/prt-dis-griddata.dat new file mode 100644 index 00000000000..daae94c0ee3 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-dis-griddata.dat @@ -0,0 +1,12 @@ +BEGIN GRIDDATA + DELR + -- READARRAY + DELC + -- READARRAY + TOP + -- READARRAY + BOTM [LAYERED] + -- READARRAY + [IDOMAIN [LAYERED] + -- READARRAY] +END GRIDDATA diff --git a/doc/mf6io/mf6ivar/tex/prt-dis-options.dat b/doc/mf6io/mf6ivar/tex/prt-dis-options.dat new file mode 100644 index 00000000000..67e3ed895ae --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-dis-options.dat @@ -0,0 +1,7 @@ +BEGIN OPTIONS + [LENGTH_UNITS ] + [NOGRB] + [XORIGIN ] + [YORIGIN ] + [ANGROT ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-cell2d.dat b/doc/mf6io/mf6ivar/tex/prt-disv-cell2d.dat new file mode 100644 index 00000000000..27900d67235 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-cell2d.dat @@ -0,0 +1,5 @@ +BEGIN CELL2D + + + ... +END CELL2D diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-desc.tex b/doc/mf6io/mf6ivar/tex/prt-disv-desc.tex new file mode 100644 index 00000000000..dac7917328f --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-desc.tex @@ -0,0 +1,61 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{length\_units}---is the length units used for this model. Values can be ``FEET'', ``METERS'', or ``CENTIMETERS''. If not specified, the default is ``UNKNOWN''. + +\item \texttt{NOGRB}---keyword to deactivate writing of the binary grid file. + +\item \texttt{xorigin}---x-position of the origin used for model grid vertices. This value should be provided in a real-world coordinate system. A default value of zero is assigned if not specified. The value for XORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +\item \texttt{yorigin}---y-position of the origin used for model grid vertices. This value should be provided in a real-world coordinate system. If not specified, then a default value equal to zero is used. The value for YORIGIN does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +\item \texttt{angrot}---counter-clockwise rotation angle (in degrees) of the model grid coordinate system relative to a real-world coordinate system. If not specified, then a default value of 0.0 is assigned. The value for ANGROT does not affect the model simulation, but it is written to the binary grid file so that postprocessors can locate the grid in space. + +\end{description} +\item \textbf{Block: DIMENSIONS} + +\begin{description} +\item \texttt{nlay}---is the number of layers in the model grid. + +\item \texttt{ncpl}---is the number of cells per layer. This is a constant value for the grid and it applies to all layers. + +\item \texttt{nvert}---is the total number of (x, y) vertex pairs used to characterize the horizontal configuration of the model grid. + +\end{description} +\item \textbf{Block: GRIDDATA} + +\begin{description} +\item \texttt{top}---is the top elevation for each cell in the top model layer. + +\item \texttt{botm}---is the bottom elevation for each cell. + +\item \texttt{idomain}---is an optional array that characterizes the existence status of a cell. If the IDOMAIN array is not specified, then all model cells exist within the solution. If the IDOMAIN value for a cell is 0, the cell does not exist in the simulation. Input and output values will be read and written for the cell, but internal to the program, the cell is excluded from the solution. If the IDOMAIN value for a cell is 1, the cell exists in the simulation. If the IDOMAIN value for a cell is -1, the cell does not exist in the simulation. Furthermore, the first existing cell above will be connected to the first existing cell below. This type of cell is referred to as a ``vertical pass through'' cell. + +\end{description} +\item \textbf{Block: VERTICES} + +\begin{description} +\item \texttt{iv}---is the vertex number. Records in the VERTICES block must be listed in consecutive order from 1 to NVERT. + +\item \texttt{xv}---is the x-coordinate for the vertex. + +\item \texttt{yv}---is the y-coordinate for the vertex. + +\end{description} +\item \textbf{Block: CELL2D} + +\begin{description} +\item \texttt{icell2d}---is the CELL2D number. Records in the CELL2D block must be listed in consecutive order from the first to the last. + +\item \texttt{xc}---is the x-coordinate for the cell center. + +\item \texttt{yc}---is the y-coordinate for the cell center. + +\item \texttt{ncvert}---is the number of vertices required to define the cell. There may be a different number of vertices for each cell. + +\item \texttt{icvert}---is an array of integer values containing vertex numbers (in the VERTICES block) used to define the cell. Vertices must be listed in clockwise order. Cells that are connected must share vertices. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-dimensions.dat b/doc/mf6io/mf6ivar/tex/prt-disv-dimensions.dat new file mode 100644 index 00000000000..b05791a77b3 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-dimensions.dat @@ -0,0 +1,5 @@ +BEGIN DIMENSIONS + NLAY + NCPL + NVERT +END DIMENSIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-griddata.dat b/doc/mf6io/mf6ivar/tex/prt-disv-griddata.dat new file mode 100644 index 00000000000..e263cb1d7bb --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-griddata.dat @@ -0,0 +1,8 @@ +BEGIN GRIDDATA + TOP + -- READARRAY + BOTM [LAYERED] + -- READARRAY + [IDOMAIN [LAYERED] + -- READARRAY] +END GRIDDATA diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-options.dat b/doc/mf6io/mf6ivar/tex/prt-disv-options.dat new file mode 100644 index 00000000000..67e3ed895ae --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-options.dat @@ -0,0 +1,7 @@ +BEGIN OPTIONS + [LENGTH_UNITS ] + [NOGRB] + [XORIGIN ] + [YORIGIN ] + [ANGROT ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-disv-vertices.dat b/doc/mf6io/mf6ivar/tex/prt-disv-vertices.dat new file mode 100644 index 00000000000..6831f23b5ff --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-disv-vertices.dat @@ -0,0 +1,5 @@ +BEGIN VERTICES + + + ... +END VERTICES diff --git a/doc/mf6io/mf6ivar/tex/prt-fmi-desc.tex b/doc/mf6io/mf6ivar/tex/prt-fmi-desc.tex new file mode 100644 index 00000000000..f1370146b38 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-fmi-desc.tex @@ -0,0 +1,19 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{SAVE\_FLOWS}---keyword to indicate that FMI flow terms will be written to the file specified with ``BUDGET FILEOUT'' in Output Control. + +\end{description} +\item \textbf{Block: PACKAGEDATA} + +\begin{description} +\item \texttt{flowtype}---is the word GWFBUDGET or GWFHEAD. If GWFBUDGET is specified, then the corresponding file must be a budget file from a previous GWF Model run. + +\item \texttt{FILEIN}---keyword to specify that an input filename is expected next. + +\item \texttt{fname}---is the name of the file containing flows. The path to the file should be included if the file is not located in the folder where the program was run. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-fmi-options.dat b/doc/mf6io/mf6ivar/tex/prt-fmi-options.dat new file mode 100644 index 00000000000..f8518b490f4 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-fmi-options.dat @@ -0,0 +1,3 @@ +BEGIN OPTIONS + [SAVE_FLOWS] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-fmi-packagedata.dat b/doc/mf6io/mf6ivar/tex/prt-fmi-packagedata.dat new file mode 100644 index 00000000000..85d840ad9ef --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-fmi-packagedata.dat @@ -0,0 +1,5 @@ +BEGIN PACKAGEDATA + FILEIN + FILEIN + ... +END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/prt-mip-desc.tex b/doc/mf6io/mf6ivar/tex/prt-mip-desc.tex new file mode 100644 index 00000000000..ce3aa30f51a --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-mip-desc.tex @@ -0,0 +1,19 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{zero\_method}---the root finding algorithm to solve ternary subcells. 0 euler, 1 brent, 2 chandrupatla, 3 test. + +\end{description} +\item \textbf{Block: GRIDDATA} + +\begin{description} +\item \texttt{porosity}---is the aquifer porosity. + +\item \texttt{retfactor}---is a real value by which velocity is divided within a given cell. RETFACTOR can be used to account for solute retardation, i.e., the apparent effect of linear sorption on the velocity of particles that track solute advection. RETFACTOR may be assigned any real value. A RETFACTOR value greater than 1 represents particle retardation (slowing), and a value of 1 represents no retardation. The effect of specifying a RETFACTOR value for each cell is the same as the effect of directly multiplying the POROSITY in each cell by the proposed RETFACTOR value for each cell. RETFACTOR allows conceptual isolation of effects such as retardation from the effect of porosity. The default value is 1. + +\item \texttt{izone}---is an integer zone number assigned to each cell. IZONE may be positive, negative, or zero. The current cell's zone number is recorded with each particle track datum. If the ISTOPZONE option is set to any value other than zero in a PRP Package, particles released by that PRP Package terminate if they enter a cell whose IZONE value matches ISTOPZONE. If ISTOPZONE is not specified or is set to zero in a PRP Package, IZONE has no effect on the termination of particles released by that PRP Package. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat b/doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat new file mode 100644 index 00000000000..5777ce9e6b8 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat @@ -0,0 +1,8 @@ +BEGIN GRIDDATA + POROSITY [LAYERED] + -- READARRAY + [RETFACTOR [LAYERED] + -- READARRAY] + [IZONE [LAYERED] + -- READARRAY] +END GRIDDATA diff --git a/doc/mf6io/mf6ivar/tex/prt-mip-options.dat b/doc/mf6io/mf6ivar/tex/prt-mip-options.dat new file mode 100644 index 00000000000..daa82b4bb0a --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-mip-options.dat @@ -0,0 +1,3 @@ +BEGIN OPTIONS + [ZERO_METHOD ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-nam-desc.tex b/doc/mf6io/mf6ivar/tex/prt-nam-desc.tex new file mode 100644 index 00000000000..6c7d8fd876e --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-nam-desc.tex @@ -0,0 +1,25 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{list}---is name of the listing file to create for this PRT model. If not specified, then the name of the list file will be the basename of the PRT model name file and the '.lst' extension. For example, if the PRT name file is called ``my.model.nam'' then the list file will be called ``my.model.lst''. + +\item \texttt{PRINT\_INPUT}---keyword to indicate that the list of all model stress package information will be written to the listing file immediately after it is read. + +\item \texttt{PRINT\_FLOWS}---keyword to indicate that the list of all model package 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. + +\item \texttt{SAVE\_FLOWS}---keyword to indicate that all model package flow terms will be written to the file specified with ``BUDGET FILEOUT'' in Output Control. + +\end{description} +\item \textbf{Block: PACKAGES} + +\begin{description} +\item \texttt{ftype}---is the file type, which must be one of the following character values shown in table~\ref{table:ftype}. Ftype may be entered in any combination of uppercase and lowercase. + +\item \texttt{fname}---is the name of the file containing the package input. The path to the file should be included if the file is not located in the folder where the program was run. + +\item \texttt{pname}---is the user-defined name for the package. PNAME is restricted to 16 characters. No spaces are allowed in PNAME. PNAME character values are read and stored by the program for stress packages only. These names may be useful for labeling purposes when multiple stress packages of the same type are located within a single PRT Model. If PNAME is specified for a stress package, then PNAME will be used in the flow budget table in the listing file; it will also be used for the text entry in the cell-by-cell budget file. PNAME is case insensitive and is stored in all upper case letters. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-nam-options.dat b/doc/mf6io/mf6ivar/tex/prt-nam-options.dat new file mode 100644 index 00000000000..a65ebd5e24d --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-nam-options.dat @@ -0,0 +1,6 @@ +BEGIN OPTIONS + [LIST ] + [PRINT_INPUT] + [PRINT_FLOWS] + [SAVE_FLOWS] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-nam-packages.dat b/doc/mf6io/mf6ivar/tex/prt-nam-packages.dat new file mode 100644 index 00000000000..ee5dc814ee7 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-nam-packages.dat @@ -0,0 +1,5 @@ +BEGIN PACKAGES + [] + [] + ... +END PACKAGES diff --git a/doc/mf6io/mf6ivar/tex/prt-oc-desc.tex b/doc/mf6io/mf6ivar/tex/prt-oc-desc.tex new file mode 100644 index 00000000000..c502d09ca55 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-oc-desc.tex @@ -0,0 +1,93 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{BUDGET}---keyword to specify that record corresponds to the budget. + +\item \texttt{FILEOUT}---keyword to specify that an output filename is expected next. + +\item \texttt{budgetfile}---name of the output file to write budget information. + +\item \texttt{BUDGETCSV}---keyword to specify that record corresponds to the budget CSV. + +\item \texttt{budgetcsvfile}---name of the comma-separated value (CSV) output file to write budget summary information. A budget summary record will be written to this file for each time step of the simulation. + +\item \texttt{CONCENTRATION}---keyword to specify that record corresponds to concentration. + +\item \texttt{concentrationfile}---name of the output file to write conc information. + +\item \texttt{PRINT\_FORMAT}---keyword to specify format for printing to the listing file. + +\item \texttt{columns}---number of columns for writing data. + +\item \texttt{width}---width for writing each number. + +\item \texttt{digits}---number of digits to use for writing a number. + +\item \texttt{format}---write format can be EXPONENTIAL, FIXED, GENERAL, or SCIENTIFIC. + +\item \texttt{TRACK}---keyword to specify that record corresponds to pathlines. + +\item \texttt{trackfile}---name of the output file to write tracking information. + +\item \texttt{TRACKCSV}---keyword to specify that record corresponds to the track CSV. + +\item \texttt{trackcsvfile}---name of the comma-separated value (CSV) file to write tracking information. + +\item \texttt{TRACK\_ALL}---whether to track all particle events + +\item \texttt{TRACK\_RELEASE}---whether to track particle release events + +\item \texttt{TRACK\_TRANSIT}---whether to track cell-to-cell transitions + +\item \texttt{TRACK\_TIMESTEP}---whether to track transitions between timesteps + +\item \texttt{TRACK\_TERMINATE}---whether to track particle termination events + +\item \texttt{TRACK\_WEAKSINK}---whether to track occasions when a particle exits a weak sink (a cell which removes some but not all inflow from adjacent cells) + +\item \texttt{TRACK\_USERTIME}---whether to track user-specified times, provided as double precision values to the TRACK\_TIMES or TRACK\_TIMESFILE options + +\item \texttt{TRACK\_TIMES}---keyword indicating tracking times will follow + +\item \texttt{times}---times to track, relative to the beginning of the simulation. + +\item \texttt{TRACK\_TIMESFILE}---keyword indicating tracking times file name will follow + +\item \texttt{timesfile}---name of the tracking times file + +\end{description} +\item \textbf{Block: PERIOD} + +\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{SAVE}---keyword to indicate that information will be saved this stress period. + +\item \texttt{PRINT}---keyword to indicate that information will be printed this stress period. + +\item \texttt{rtype}---type of information to save or print. Can be BUDGET or CONCENTRATION. + +\item \texttt{ocsetting}---specifies the steps for which the data will be saved. + +\begin{lstlisting}[style=blockdefinition] +ALL +FIRST +LAST +FREQUENCY +STEPS +\end{lstlisting} + +\item \texttt{ALL}---keyword to indicate save for all time steps in period. + +\item \texttt{FIRST}---keyword to indicate save for first step in period. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +\item \texttt{LAST}---keyword to indicate save for last step in period. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +\item \texttt{frequency}---save at the specified time step frequency. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +\item \texttt{steps}---save for each step specified in STEPS. This keyword may be used in conjunction with other keywords to print or save results for multiple time steps. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-oc-options.dat b/doc/mf6io/mf6ivar/tex/prt-oc-options.dat new file mode 100644 index 00000000000..cdb0c5dee6e --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-oc-options.dat @@ -0,0 +1,17 @@ +BEGIN OPTIONS + [BUDGET FILEOUT ] + [BUDGETCSV FILEOUT ] + [CONCENTRATION FILEOUT ] + [CONCENTRATION PRINT_FORMAT COLUMNS WIDTH DIGITS ] + [TRACK FILEOUT ] + [TRACKCSV FILEOUT ] + [TRACK_ALL] + [TRACK_RELEASE] + [TRACK_TRANSIT] + [TRACK_TIMESTEP] + [TRACK_TERMINATE] + [TRACK_WEAKSINK] + [TRACK_USERTIME] + [TRACK_TIMES ] + [TRACK_TIMESFILE ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-oc-period.dat b/doc/mf6io/mf6ivar/tex/prt-oc-period.dat new file mode 100644 index 00000000000..abcceee3794 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-oc-period.dat @@ -0,0 +1,4 @@ +BEGIN PERIOD + [SAVE ] + [PRINT ] +END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/prt-prp-desc.tex b/doc/mf6io/mf6ivar/tex/prt-prp-desc.tex new file mode 100644 index 00000000000..5c8f0eb2967 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-desc.tex @@ -0,0 +1,85 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{BOUNDNAMES}---keyword to indicate that boundary names may be provided with the list of release-point cells. + +\item \texttt{TRACK}---keyword to specify that record corresponds to track. + +\item \texttt{FILEOUT}---keyword to specify that an output filename is expected next. + +\item \texttt{trackfile}---name of the output file to write tracking information. + +\item \texttt{TRACKCSV}---keyword to specify that record corresponds to the track CSV. + +\item \texttt{trackcsvfile}---name of the comma-separated value (CSV) file to write tracking information. + +\item \texttt{stoptime}---real value defining the maximum simulation time to which particles in the model can be tracked. Particles that have not terminated earlier due to another termination condition will terminate when simulation time STOPTIME is reached. If the last stress period in the simulation consists of more than one time step, particles will not be tracked past the ending time of the last stress period, regardless of STOPTIME. If the last stress period in the simulation consists of a single time step, it is assumed to be a steady-state stress period, and its ending time will not limit the simulation time to which particles can be tracked. + +\item \texttt{stoptraveltime}---real value defining the maximum travel time over which particles in the model can be tracked. Particles that have not terminated earlier due to another termination condition will terminate when their travel time reaches STOPTRAVELTIME. If the last stress period in the simulation consists of more than one time step, particles will not be tracked past the ending time of the last stress period, regardless of STOPTRAVELTIME. If the last stress period in the simulation consists of a single time step, it is assumed to be a steady-state stress period, and its ending time will not limit the travel time over which particles can be tracked. + +\item \texttt{STOP\_AT\_WEAK\_SINK}---is a text keyword to indicate that a particle is to terminate when it enters a cell that is a weak sink. By default, particles are allowed to pass though cells that are weak sinks. + +\item \texttt{istopzone}---integer value defining the stop zone number. If cells have been assigned IZONE values in the GRIDDATA block, a particle terminates if it enters a cell whose IZONE value matches ISTOPZONE. An ISTOPZONE value of zero indicates that there is no stop zone. The default value is zero. + +\item \texttt{DRAPE}---is a text keyword to indicate that if a particle's release point is in a cell that happens to be dry at release time, the particle is to be moved to the topmost active cell below it, if any. By default, a particle is not released into the simulation if its release point's cell is dry at release time, instead the particle is terminated immediately with ireason 3 and istatus 8. + +\item \texttt{RELEASE\_TIMES}---keyword indicating release times will follow + +\item \texttt{times}---times to release, relative to the beginning of the simulation. + +\item \texttt{RELEASE\_TIMESFILE}---keyword indicating release times file name will follow + +\item \texttt{timesfile}---name of the release times file + +\end{description} +\item \textbf{Block: DIMENSIONS} + +\begin{description} +\item \texttt{nreleasepts}---is the number of particle release points. + +\end{description} +\item \textbf{Block: PACKAGEDATA} + +\begin{description} +\item \texttt{irptno}---integer value that defines the PRP release point number associated with the specified PACKAGEDATA data on the line. IRPTNO must be greater than zero and less than or equal to NRELEASEPTS. The program will terminate with an error if information for a PRP release point number 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. + +\item \texttt{xrpt}---real value that defines the x coordinate of the release point in model coordinates. The (x, y, z) location specified for the release point must lie within the cell that corresponds to the specified cellid. + +\item \texttt{yrpt}---real value that defines the y coordinate of the release point in model coordinates. The (x, y, z) location specified for the release point must lie within the cell that corresponds to the specified cellid. + +\item \texttt{zrpt}---real value that defines the z coordinate of the release point in model coordinates. The (x, y, z) location specified for the release point must lie within the cell that corresponds to the specified cellid. + +\item \texttt{boundname}---name of the release-point 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. + +\end{description} +\item \textbf{Block: PERIOD} + +\begin{description} +\item \texttt{iper}---integer value specifying the 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 applies only to that stress period. + +\item \texttt{releasesetting}---specifies when to release particles within the stress period. Overrides package-level RELEASETIME option, which applies to all stress periods. By default, RELEASESETTING configures particles for release at the beginning of the specified time steps. For time-offset releases, provide a FRACTION value. + +\begin{lstlisting}[style=blockdefinition] +ALL +FIRST +FREQUENCY +STEPS +[FRACTION ] +\end{lstlisting} + +\item \texttt{ALL}---keyword to indicate release of particles at the start of all time steps in the period. + +\item \texttt{FIRST}---keyword to indicate release of particles at the start of the first time step in the period. This keyword may be used in conjunction with other keywords to release particles at the start of multiple time steps. + +\item \texttt{frequency}---release particles at the specified time step frequency. This keyword may be used in conjunction with other keywords to release particles at the start of multiple time steps. + +\item \texttt{steps}---release particles at the start of each step specified in STEPS. This keyword may be used in conjunction with other keywords to release particles at the start of multiple time steps. + +\item \texttt{fraction}---release particles after the specified fraction of the time step has elapsed. If FRACTION is not set, particles are released at the start of the specified time step(s). FRACTION must be a single value when used with ALL, FIRST, or FREQUENCY. When used with STEPS, FRACTION may be a single value or an array of the same length as STEPS. If a single FRACTION value is provided with STEPS, the fraction applies to all steps. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat b/doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat new file mode 100644 index 00000000000..bbbac31a118 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat @@ -0,0 +1,3 @@ +BEGIN DIMENSIONS + NRELEASEPTS +END DIMENSIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-prp-options.dat b/doc/mf6io/mf6ivar/tex/prt-prp-options.dat new file mode 100644 index 00000000000..fb08e4b0068 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-options.dat @@ -0,0 +1,12 @@ +BEGIN OPTIONS + [BOUNDNAMES] + [TRACK FILEOUT ] + [TRACKCSV FILEOUT ] + [STOPTIME ] + [STOPTRAVELTIME ] + [STOP_AT_WEAK_SINK] + [ISTOPZONE ] + [DRAPE] + [RELEASE_TIMES ] + [RELEASE_TIMESFILE ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/prt-prp-packagedata.dat b/doc/mf6io/mf6ivar/tex/prt-prp-packagedata.dat new file mode 100644 index 00000000000..070166487df --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-packagedata.dat @@ -0,0 +1,5 @@ +BEGIN PACKAGEDATA + [] + [] + ... +END PACKAGEDATA diff --git a/doc/mf6io/mf6ivar/tex/prt-prp-period.dat b/doc/mf6io/mf6ivar/tex/prt-prp-period.dat new file mode 100644 index 00000000000..d183680202b --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-period.dat @@ -0,0 +1,5 @@ +BEGIN PERIOD + + + ... +END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/sln-pts-desc.tex b/doc/mf6io/mf6ivar/tex/sln-pts-desc.tex new file mode 100644 index 00000000000..d4008f5fae5 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/sln-pts-desc.tex @@ -0,0 +1,33 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\item \textbf{Block: OPTIONS} + +\begin{description} +\item \texttt{print\_option}---is a flag that controls printing of convergence information from the solver. NONE means print nothing. SUMMARY means print only the total number of iterations and nonlinear residual reduction summaries. ALL means print linear matrix solver convergence information to the solution listing file and model specific linear matrix solver convergence information to each model listing file in addition to SUMMARY information. NONE is default if PRINT\_OPTION is not specified. + +\item \texttt{complexity}---is an optional keyword that defines default non-linear and linear solver parameters. SIMPLE - indicates that default solver input values will be defined that work well for nearly linear models. This would be used for models that do not include nonlinear stress packages and models that are either confined or consist of a single unconfined layer that is thick enough to contain the water table within a single layer. MODERATE - indicates that default solver input values will be defined that work well for moderately nonlinear models. This would be used for models that include nonlinear stress packages and models that consist of one or more unconfined layers. The MODERATE option should be used when the SIMPLE option does not result in successful convergence. COMPLEX - indicates that default solver input values will be defined that work well for highly nonlinear models. This would be used for models that include nonlinear stress packages and models that consist of one or more unconfined layers representing complex geology and surface-water/groundwater interaction. The COMPLEX option should be used when the MODERATE option does not result in successful convergence. Non-linear and linear solver parameters assigned using a specified complexity can be modified in the NONLINEAR and LINEAR blocks. If the COMPLEXITY option is not specified, NONLINEAR and LINEAR variables will be assigned the simple complexity values. + +\item \texttt{CSV\_OUTER\_OUTPUT}---keyword to specify that the record corresponds to the comma separated values outer iteration convergence output. + +\item \texttt{FILEOUT}---keyword to specify that an output filename is expected next. + +\item \texttt{outer\_csvfile}---name of the ascii comma separated values output file to write maximum dependent-variable (for example, head) change convergence information at the end of each outer iteration for each time step. + +\item \texttt{CSV\_INNER\_OUTPUT}---keyword to specify that the record corresponds to the comma separated values solver convergence output. + +\item \texttt{inner\_csvfile}---name of the ascii comma separated values output file to write solver convergence information. Comma separated values output includes maximum dependent-variable (for example, head) change and maximum residual convergence information for the solution and each model (if the solution includes more than one model) and linear acceleration information for each inner iteration. + +\item \texttt{NO\_PTC}---is a flag that is used to disable pseudo-transient continuation (PTC). Option only applies to steady-state stress periods for models using the Newton-Raphson formulation. For many problems, PTC can significantly improve convergence behavior for steady-state simulations, and for this reason it is active by default. In some cases, however, PTC can worsen the convergence behavior, especially when the initial conditions are similar to the solution. When the initial conditions are similar to, or exactly the same as, the solution and convergence is slow, then the NO\_PTC FIRST option should be used to deactivate PTC for the first stress period. The NO\_PTC ALL option should also be used in order to compare convergence behavior with other MODFLOW versions, as PTC is only available in MODFLOW 6. + +\item \texttt{no\_ptc\_option}---is an optional keyword that is used to define options for disabling pseudo-transient continuation (PTC). FIRST is an optional keyword to disable PTC for the first stress period, if steady-state and one or more model is using the Newton-Raphson formulation. ALL is an optional keyword to disable PTC for all steady-state stress periods for models using the Newton-Raphson formulation. If NO\_PTC\_OPTION is not specified, the NO\_PTC ALL option is used. + +\item \texttt{ats\_outer\_maximum\_fraction}---real value defining the fraction of the maximum allowable outer iterations used with the Adaptive Time Step (ATS) capability if it is active. If this value is set to zero by the user, then this solution will have no effect on ATS behavior. This value must be greater than or equal to zero and less than or equal to 0.5 or the program will terminate with an error. If it is not specified by the user, then it is assigned a default value of one third. When the number of outer iterations for this solution is less than the product of this value and the maximum allowable outer iterations, then ATS will increase the time step length by a factor of DTADJ in the ATS input file. When the number of outer iterations for this solution is greater than the maximum allowable outer iterations minus the product of this value and the maximum allowable outer iterations, then the ATS (if active) will decrease the time step length by a factor of 1 / DTADJ. + +\end{description} +\item \textbf{Block: NONLINEAR} + +\begin{description} +\item \texttt{outer\_maximum}---integer value defining the maximum number of outer (nonlinear) iterations -- that is, calls to the solution routine. For a linear problem OUTER\_MAXIMUM should be 1. + +\end{description} + diff --git a/doc/mf6io/mf6ivar/tex/sln-pts-nonlinear.dat b/doc/mf6io/mf6ivar/tex/sln-pts-nonlinear.dat new file mode 100644 index 00000000000..26678c67d08 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/sln-pts-nonlinear.dat @@ -0,0 +1,3 @@ +BEGIN NONLINEAR + OUTER_MAXIMUM +END NONLINEAR diff --git a/doc/mf6io/mf6ivar/tex/sln-pts-options.dat b/doc/mf6io/mf6ivar/tex/sln-pts-options.dat new file mode 100644 index 00000000000..ebcef48473f --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/sln-pts-options.dat @@ -0,0 +1,8 @@ +BEGIN OPTIONS + [PRINT_OPTION ] + [COMPLEXITY ] + [CSV_OUTER_OUTPUT FILEOUT ] + [CSV_INNER_OUTPUT FILEOUT ] + [NO_PTC []] + [ATS_OUTER_MAXIMUM_FRACTION ] +END OPTIONS diff --git a/doc/mf6io/mf6ivar/tex/swf-dfw-desc.tex b/doc/mf6io/mf6ivar/tex/swf-dfw-desc.tex index 37aad56efcf..103a93ea34f 100644 --- a/doc/mf6io/mf6ivar/tex/swf-dfw-desc.tex +++ b/doc/mf6io/mf6ivar/tex/swf-dfw-desc.tex @@ -3,7 +3,7 @@ \item \textbf{Block: OPTIONS} \begin{description} -\item \texttt{CENTRAL\_IN\_SPACE}---keyword to indicate conductance should be calculated using central-in-space weighting instead of the default upstream weighting approach. +\item \texttt{CENTRAL\_IN\_SPACE}---keyword to indicate conductance should be calculated using central-in-space weighting instead of the default upstream weighting approach. This option should be used with caution as it does not work well unless all of the stream reaches are saturated. With this option, there is no way for water to flow into a dry reach from connected reaches. \item \texttt{length\_conversion}---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. diff --git a/doc/mf6io/prt/fmi.tex b/doc/mf6io/prt/fmi.tex new file mode 100644 index 00000000000..b67883629e2 --- /dev/null +++ b/doc/mf6io/prt/fmi.tex @@ -0,0 +1,50 @@ +Flow Model Interface (FMI) Package information is read from the file that is specified by ``FMI6'' as the file type. The FMI Package is required, and only one FMI Package can be specified for a PRT model. + +For most simulations, the PRT Model needs groundwater flows for every cell in the model grid, for all boundary conditions, and for other terms, such as the flow of water in or out of storage. The FMI Package is the interface between the PRT Model and simulated groundwater flows provided by a corresponding GWF Model that is running concurrently within the simulation or from binary budget files that were created from a previous GWF model run. The following are several different FMI simulation cases: + +\begin{itemize} + +\item Flows are provided by a corresponding GWF Model running in the same simulation---in this case, all groundwater flows are calculated by the corresponding GWF Model and provided through FMI to the transport model. This is a common use case in which the user wants to run the flow and particle-tracking models as part of a single simulation. The GWF and PRT models must be part of a GWF-PRT Exchange that is listed in mfsim.nam. If a GWF-PRT Exchange is specified by the user, then the user does not need to specify an FMI Package input file for the simulation, unless an FMI option is needed. If a GWF-PRT Exchange is specified and the FMI Package is specified, then the PACKAGEDATA block below is not read or used. + +\item Flows are provided from a previous GWF model simulation---in this case FMI should be provided in the PRT name file and the head and budget files should be listed in the FMI PACKAGEDATA block. In this case, FMI reads the simulated head and flows from these files and makes them available to the particle-trcking model. There are some additional considerations when the heads and flows are provided from binary files. + +\begin{itemize} +\item The binary budget file must contain the simulated flows for all of the packages that were included in the GWF model run. Saving of flows can be activated for all packages by specifying ``SAVE\_FLOWS'' as an option in the GWF name file. The GWF Output Control Package must also have ``SAVE BUGET ALL'' specified. The easiest way to ensure that all flows and heads are saved is to use the following simple form of a GWF Output Control file: + +\begin{verbatim} +BEGIN OPTIONS + HEAD FILEOUT mymodel.hds + BUDGET FILEOUT mymodel.bud +END OPTIONS + +BEGIN PERIOD 1 + SAVE HEAD ALL + SAVE BUDGET ALL +END PERIOD +\end{verbatim} + +\item The binary budget file must have the same number of budget terms listed for each time step. This will always be the case when the binary budget file is created by \mf. +\item The binary heads file must have heads saved for all layers in the model. This will always be the case when the binary head file is created by \mf. This was not always the case as previous MODFLOW versions allowed different save options for each layer. +\item If the binary budget and head files have more than one time step for a single stress period, then the budget and head information must be contained within the binary file for every time step in the simulation stress period. +\item The binary budget and head files must correspond in terms of information stored for each time step and stress period. +\item If the binary budget and head files have information provided for only the first time step of a given stress period, this information will be used for all time steps in that stress period in the PRT simulation. If the final (or only) stress period in the binary budget and head files contains data for only one time step, this information will be used for any subsequent time steps and stress periods in the PRT simulation. This makes it possible to provide flows, for example, from a steady-state GWF stress period and have those flows used for all PRT time steps in that stress period, for all remaining time steps in the PRT simulation, or for all time steps throughout the entire GWT simulation. With this option, it is possible to have smaller time steps in the PRT simulation than the time steps used in the GWF simulation. Note that this cannot be done when the GWF and PRT models are run in the same simulation, because in that case, both models are solved over the same sequence of time steps and stress periods, as listed in the TDIS Package. The option to read flows from a previous GWF simulation via Flow Model Interface may offer an efficient alternative to running both models in the same simulation, but comes at the cost of having potentially very large budget files. +\end{itemize} + +\end{itemize} + +\noindent Determination of which FMI use case to invoke requires careful consideration of the different advantages and disadvantages of each case. For example, running PRT and GWF in the same simulation can often be faster because GWF flows are passed through memory to the PRT model instead of being written to files. The disadvantage of this approach is that the same time step lengths must be used for both GWF and PRT. Ultimately, it should be relatively straightforward to test different ways in which GWF and PRT interact and select the use case most appropriate for the particular problem. + +\vspace{5mm} +\subsubsection{Structure of Blocks} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-fmi-packagedata.dat} + +\vspace{5mm} +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/prt-fmi-desc.tex} +\end{description} + +\vspace{5mm} +\subsubsection{Example Input File} +\lstinputlisting[style=inputfile]{./mf6ivar/examples/prt-fmi-example.dat} + diff --git a/doc/mf6io/prt/mip.tex b/doc/mf6io/prt/mip.tex new file mode 100644 index 00000000000..55e275e6174 --- /dev/null +++ b/doc/mf6io/prt/mip.tex @@ -0,0 +1,16 @@ +Model Input (MIP) Package information is read from the file that is specified by ``MIP6'' as the file type. The MIP Package is required, and only one MIP Package can be specified for a PRT model. The information read by the MIP Package pertains to the entire PRT model. + +\vspace{5mm} +\subsubsection{Structure of Blocks} +%%\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-mip-options.dat} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-mip-griddata.dat} + +\vspace{5mm} +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/prt-mip-desc.tex} +\end{description} + +\vspace{5mm} +\subsubsection{Example Input File} +\lstinputlisting[style=inputfile]{./mf6ivar/examples/prt-mip-example.dat} diff --git a/doc/mf6io/prt/namefile.tex b/doc/mf6io/prt/namefile.tex new file mode 100644 index 00000000000..18780f276cf --- /dev/null +++ b/doc/mf6io/prt/namefile.tex @@ -0,0 +1,42 @@ +The PRT Model Name File specifies the options and packages that are active for a PRT model. The Name File contains two blocks: OPTIONS and PACKAGES. The length of each line must be 299 characters or less. The lines in each block can be in any order. Files listed in the PACKAGES block must exist when the program starts. + +Comment lines are indicated when the first character in a line is one of the valid comment characters. Commented lines can be located anywhere in the file. Any text characters can follow the comment character. Comment lines have no effect on the simulation; their purpose is to allow users to provide documentation about a particular simulation. + +\vspace{5mm} +\subsubsection{Structure of Blocks} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-nam-options.dat} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-nam-packages.dat} + +\vspace{5mm} +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/prt-nam-desc.tex} +\end{description} + +\begin{table}[H] +\caption{Ftype values described in this report. The \texttt{Pname} column indicates whether or not a package name can be provided in the name file. The capability to provide a package name also indicates that the PRT Model can have more than one package of that Ftype} +\small +\begin{center} +\begin{tabular*}{\columnwidth}{l l l} +\hline +\hline +Ftype & Input File Description & \texttt{Pname}\\ +\hline +DIS6 & Rectilinear Discretization Input File \\ +DISV6 & Discretization by Vertices Input File \\ +MIP6 & Model Input File \\ +FMI6 & Flow Model Interface Package & \\ +PRP6 & Particle Release Point Package \\ +OC6 & Output Control Option \\ +OBS6 & Observations Option \\ +\hline +\end{tabular*} +\label{table:ftypeprt} +\end{center} +\normalsize +\end{table} + +\vspace{5mm} +\subsubsection{Example Input File} +\lstinputlisting[style=inputfile]{./mf6ivar/examples/prt-nam-example.dat} + diff --git a/doc/mf6io/prt/oc.tex b/doc/mf6io/prt/oc.tex new file mode 100644 index 00000000000..8077ad09bf9 --- /dev/null +++ b/doc/mf6io/prt/oc.tex @@ -0,0 +1,25 @@ +Input to the Output Control Option of the Particle Tracking Model is read from the file that is specified as type ``OC6'' in the Name File. If no ``OC6'' file is specified, default output control is used. The Output Control Option determines how and when concentrations are printed to the listing file and/or written to a separate binary output file. Under the default, concentration and overall transport budget are written to the Listing File at the end of every stress period. The default printout format for concentrations is 10G11.4. The concentrations and overall transport budget are also written to the list file if the simulation terminates prematurely due to failed convergence. + +Output Control data must be specified using words. The numeric codes supported in earlier MODFLOW versions can no longer be used. + +For the PRINT and SAVE options of concentration, there is no option to specify individual layers. Whenever the concentration array is printed or saved, all layers are printed or saved. + +\vspace{5mm} +\subsubsection{Structure of Blocks} +\vspace{5mm} + +\noindent \textit{FOR EACH SIMULATION} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-oc-options.dat} +\vspace{5mm} +\noindent \textit{FOR ANY STRESS PERIOD} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-oc-period.dat} + +\vspace{5mm} +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/prt-oc-desc.tex} +\end{description} + +\vspace{5mm} +\subsubsection{Example Input File} +\lstinputlisting[style=inputfile]{./mf6ivar/examples/prt-oc-example.dat} diff --git a/doc/mf6io/prt/prp.tex b/doc/mf6io/prt/prp.tex new file mode 100644 index 00000000000..68edf7227f8 --- /dev/null +++ b/doc/mf6io/prt/prp.tex @@ -0,0 +1,25 @@ +Particle Release Point (PRP) Package information is read from the file that is specified by ``PRP6'' as the file type. More than one PRP Package can be specified for a PRT model. + +\vspace{5mm} +\subsubsection{Structure of Blocks} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-prp-options.dat} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-prp-dimensions.dat} +%%\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-prp-griddata.dat} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-prp-packagedata.dat} +\vspace{5mm} +\noindent \textit{FOR ANY STRESS PERIOD} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/prt-prp-period.dat} +\packageperioddescription \: If no PERIOD block is specified for any period, a single particle is released from each release point at the beginning of the simulation. +%\noindent All of the stress period information in a PERIOD block will apply only to that stress period; the information will not continue to apply for subsequent stress periods. Note that this behavior is different from the simple stress packages (CHD, WEL, DRN, RIV, +%GHB, RCH and EVT) and the advanced stress packages (MAW, SFR, LAK, and UZF). + +\vspace{5mm} +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/prt-prp-desc.tex} +\end{description} + +\vspace{5mm} +\subsubsection{Example Input File} +\lstinputlisting[style=inputfile]{./mf6ivar/examples/prt-prp-example.dat} + diff --git a/doc/mf6io/prt/prt-obs.tex b/doc/mf6io/prt/prt-obs.tex new file mode 100644 index 00000000000..be59101d85a --- /dev/null +++ b/doc/mf6io/prt/prt-obs.tex @@ -0,0 +1,39 @@ + +PRT Model observations include the simulated groundwater concentration (\texttt{concentration}), and the mass flow, with units of mass per time, between two connected cells (\texttt{flow-ja-face}). The data required for each PRT Model observation type is defined in table~\ref{table:gwtobstype}. For \texttt{flow-ja-face} observation types, negative and positive values represent a loss from and gain to the \texttt{cellid} specified for ID, respectively. + +\subsubsection{Structure of Blocks} +\vspace{5mm} + +\noindent \textit{FOR EACH SIMULATION} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/utl-obs-options.dat} +\lstinputlisting[style=blockdefinition]{./mf6ivar/tex/utl-obs-continuous.dat} + +\subsubsection{Explanation of Variables} +\begin{description} +\input{./mf6ivar/tex/utl-obs-desc.tex} +\end{description} + + +\begin{longtable}{p{2cm} p{2.75cm} p{2cm} p{1.25cm} p{7cm}} +\caption{Available PRT model observation types} \tabularnewline + +\hline +\hline +\textbf{Model} & \textbf{Observation type} & \textbf{ID} & \textbf{ID2} & \textbf{Description} \\ +\hline +\endhead + +\hline +\endfoot + +%%%\input{../Common/prt-obs.tex} +%%%\label{table:prtobstype} +\end{longtable} + +\vspace{5mm} +\subsubsection{Example Observation Input File} + +An example PRT Model observation file is shown below. + +\lstinputlisting[style=inputfile]{./mf6ivar/examples/utl-obs-prt-example.dat} + diff --git a/doc/mf6io/prt/prt.tex b/doc/mf6io/prt/prt.tex new file mode 100644 index 00000000000..372eea93685 --- /dev/null +++ b/doc/mf6io/prt/prt.tex @@ -0,0 +1,66 @@ +The PRT Model performs three-dimensional particle tracking in flowing groundwater. + +This section describes the data files for a \mf Particle Tracking (PRT) Model. A PRT Model is added to the simulation by including a PRT entry in the MODELS block of the simulation name file. There are currently two types of spatial discretization approaches that can be used with the PRT Model: DIS and DISV. The input instructions for these three packages are not described here in this section on PRT Model input; input instructions for these three packages are described in the section on GWF Model input. + +The PRT Model is designed to permit input to be gathered, as it is needed, from many different files. Likewise, results from the model calculations can be written to a number of output files. Details about the files used by each package are provided in this section on the PRT Model Instructions. + +The PRT Model reads a file called the Name File, which specifies most of the files that will be used in a simulation. Several files are always required whereas other files are optional depending on the simulation. The Output Control Package receives instructions from the user to control the amount and frequency of output. Details about the Name File and the Output Control Package are described in this section. + +For the PRT Model, ``flows'' (unless stated otherwise) represent particle mass ``flow'' in mass per time, rather than groundwater flow. Each particle is currently assigned unit mass (configurable mass is planned but not yet implemented), and the numerical value of the flow can be interpreted as particles per time. + +\begin{enumerate} + +\item The PRT Model simulates particle trajectories through flowing groundwater, and requires simulated groundwater flows as input. Flows can be routed to a PRT Model from a GWF Model in the same simulation via a GWF-PRT Exchange. Alternatively, a PRT Model can read binary flow and head files saved by a previously run GWF Model via Flow Model Interface. + +\item Particle tracking is not yet supported for the advanced stress packages or the Water Mover Package. + +\item A PRT-PRT Exchange is planned but has not yet been developed. This exchange will connect multiple particle-tracking models, e.g. for nested grid configurations. + +\end{enumerate} + +\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. + +\subsection{Particle Mass Budget} +A summary of all inflow (sources) and outflow (sinks) of particle mass is called a mass budget. \mf calculates a mass budget for the overall model as a check on the acceptability of the solution, and to provide a summary of the sources and sinks of mass to the flow system. The particle mass budget is printed to the PRT Model Listing File for selected time steps. In the current implementation, each particle is assigned unit mass, and the numerical value of the flow can be interpreted as particles per time. + +\subsection{Time Stepping} +In \mf time step lengths are controlled by the user and specified in the Temporal Discretization (TDIS) input file. When the flow model and particle-tracking model run in the same simulation, the time step length specified in TDIS is used for both models. If the PRT Model runs in a separate simulation, the time discretization may differ. Instructions for specifying time steps are described in the TDIS section of this user guide; additional information on GWF and PRT configurations are in the Flow Model Interface section. + + + +\newpage +\subsection{PRT Model Name File} +\input{prt/namefile.tex} + +%\newpage +%\subsection{Structured Discretization (DIS) Input File} +%\input{gwf/dis} + +%\newpage +%\subsection{Discretization with Vertices (DISV) Input File} +%\input{gwf/disv} + +%\newpage +%\subsection{Unstructured Discretization (DISU) Input File} +%\input{gwf/disu} + +\newpage +\subsection{Model Input (MIP) Package} +\input{prt/mip} + +\newpage +\subsection{Particle Release Point Conditions (PRP) Package} +\input{prt/prp} + +\newpage +\subsection{Output Control (OC) Option} +\input{prt/oc} + +\newpage +\subsection{Observation (OBS) Utility for a PRT Model} +\input{prt/prt-obs} + +\newpage +\subsection{Flow Model Interface (FMI) Package} +\input{prt/fmi} diff --git a/environment.yml b/environment.yml index 118a816e753..c7fc0fc6748 100644 --- a/environment.yml +++ b/environment.yml @@ -17,6 +17,7 @@ dependencies: - numpy - pyshp - shapely + - scipy - pip - pip: - git+https://github.com/modflowpy/flopy.git @@ -25,7 +26,8 @@ dependencies: - git+https://github.com/MODFLOW-USGS/modflowapi.git - git+https://github.com/MODFLOW-USGS/modflow-devtools.git - pytest + - pytest-benchmark - pytest-dotenv - pytest-order - pytest-xdist - - flaky + - flaky \ No newline at end of file diff --git a/make/makefile b/make/makefile index e468b4dd6e1..6b628f91f39 100644 --- a/make/makefile +++ b/make/makefile @@ -11,33 +11,35 @@ SOURCEDIR4=../src/Exchange SOURCEDIR5=../src/Distributed SOURCEDIR6=../src/Solution SOURCEDIR7=../src/Solution/LinearMethods -SOURCEDIR8=../src/Solution/PETSc -SOURCEDIR9=../src/Timing -SOURCEDIR10=../src/Utilities -SOURCEDIR11=../src/Utilities/Idm -SOURCEDIR12=../src/Utilities/Idm/mf6blockfile -SOURCEDIR13=../src/Utilities/TimeSeries -SOURCEDIR14=../src/Utilities/Memory -SOURCEDIR15=../src/Utilities/OutputControl -SOURCEDIR16=../src/Utilities/ArrayRead -SOURCEDIR17=../src/Utilities/Libraries -SOURCEDIR18=../src/Utilities/Libraries/rcm -SOURCEDIR19=../src/Utilities/Libraries/blas -SOURCEDIR20=../src/Utilities/Libraries/sparskit2 -SOURCEDIR21=../src/Utilities/Libraries/daglib -SOURCEDIR22=../src/Utilities/Libraries/sparsekit -SOURCEDIR23=../src/Utilities/Vector -SOURCEDIR24=../src/Utilities/Matrix -SOURCEDIR25=../src/Utilities/Observation -SOURCEDIR26=../src/Model -SOURCEDIR27=../src/Model/Connection -SOURCEDIR28=../src/Model/SurfaceWaterFlow -SOURCEDIR29=../src/Model/GroundWaterTransport -SOURCEDIR30=../src/Model/ModelUtilities -SOURCEDIR31=../src/Model/GroundWaterFlow -SOURCEDIR32=../src/Model/TransportModel -SOURCEDIR33=../src/Model/Geometry -SOURCEDIR34=../src/Model/GroundWaterEnergy +SOURCEDIR8=../src/Solution/ParticleTracker +SOURCEDIR9=../src/Solution/PETSc +SOURCEDIR10=../src/Timing +SOURCEDIR11=../src/Utilities +SOURCEDIR12=../src/Utilities/Idm +SOURCEDIR13=../src/Utilities/Idm/mf6blockfile +SOURCEDIR14=../src/Utilities/TimeSeries +SOURCEDIR15=../src/Utilities/Memory +SOURCEDIR16=../src/Utilities/OutputControl +SOURCEDIR17=../src/Utilities/ArrayRead +SOURCEDIR18=../src/Utilities/Libraries +SOURCEDIR19=../src/Utilities/Libraries/rcm +SOURCEDIR20=../src/Utilities/Libraries/blas +SOURCEDIR21=../src/Utilities/Libraries/sparskit2 +SOURCEDIR22=../src/Utilities/Libraries/daglib +SOURCEDIR23=../src/Utilities/Libraries/sparsekit +SOURCEDIR24=../src/Utilities/Vector +SOURCEDIR25=../src/Utilities/Matrix +SOURCEDIR26=../src/Utilities/Observation +SOURCEDIR27=../src/Model +SOURCEDIR28=../src/Model/Connection +SOURCEDIR29=../src/Model/ParticleTracking +SOURCEDIR30=../src/Model/SurfaceWaterFlow +SOURCEDIR31=../src/Model/GroundWaterTransport +SOURCEDIR32=../src/Model/ModelUtilities +SOURCEDIR33=../src/Model/GroundWaterFlow +SOURCEDIR34=../src/Model/TransportModel +SOURCEDIR35=../src/Model/Geometry +SOURCEDIR36=../src/Model/GroundWaterEnergy VPATH = \ ${SOURCEDIR1} \ @@ -73,7 +75,9 @@ ${SOURCEDIR30} \ ${SOURCEDIR31} \ ${SOURCEDIR32} \ ${SOURCEDIR33} \ -${SOURCEDIR34} +${SOURCEDIR34} \ +${SOURCEDIR35} \ +${SOURCEDIR36} .SUFFIXES: .f90 .F90 .o @@ -107,6 +111,10 @@ $(OBJDIR)/swf-cxsidm.o \ $(OBJDIR)/swf-chdidm.o \ $(OBJDIR)/sim-tdisidm.o \ $(OBJDIR)/sim-namidm.o \ +$(OBJDIR)/prt-namidm.o \ +$(OBJDIR)/prt-mipidm.o \ +$(OBJDIR)/prt-disvidm.o \ +$(OBJDIR)/prt-disidm.o \ $(OBJDIR)/gwt-namidm.o \ $(OBJDIR)/gwt-icidm.o \ $(OBJDIR)/gwt-dspidm.o \ @@ -138,6 +146,7 @@ $(OBJDIR)/gwe-ctpidm.o \ $(OBJDIR)/gwe-cndidm.o \ $(OBJDIR)/exg-swfgwfidm.o \ $(OBJDIR)/exg-gwtgwtidm.o \ +$(OBJDIR)/exg-gwfprtidm.o \ $(OBJDIR)/exg-gwfgwtidm.o \ $(OBJDIR)/exg-gwfgwfidm.o \ $(OBJDIR)/exg-gwfgweidm.o \ @@ -147,6 +156,7 @@ $(OBJDIR)/DevFeature.o \ $(OBJDIR)/MemoryList.o \ $(OBJDIR)/IdmSwfDfnSelector.o \ $(OBJDIR)/IdmSimDfnSelector.o \ +$(OBJDIR)/IdmPrtDfnSelector.o \ $(OBJDIR)/IdmGwtDfnSelector.o \ $(OBJDIR)/IdmGwfDfnSelector.o \ $(OBJDIR)/IdmGweDfnSelector.o \ @@ -180,34 +190,49 @@ $(OBJDIR)/DiscretizationBase.o \ $(OBJDIR)/TimeArraySeries.o \ $(OBJDIR)/ObsOutputList.o \ $(OBJDIR)/Observe.o \ +$(OBJDIR)/BudgetFileReader.o \ $(OBJDIR)/TimeArraySeriesLink.o \ $(OBJDIR)/ObsUtility.o \ $(OBJDIR)/ObsContainer.o \ -$(OBJDIR)/BudgetFileReader.o \ +$(OBJDIR)/BudgetTerm.o \ +$(OBJDIR)/Budget.o \ $(OBJDIR)/TimeArraySeriesManager.o \ $(OBJDIR)/PackageMover.o \ $(OBJDIR)/Obs.o \ $(OBJDIR)/NumericalPackage.o \ -$(OBJDIR)/Budget.o \ -$(OBJDIR)/BudgetTerm.o \ +$(OBJDIR)/PackageBudget.o \ +$(OBJDIR)/HeadFileReader.o \ +$(OBJDIR)/BudgetObject.o \ +$(OBJDIR)/BoundaryPackage.o \ +$(OBJDIR)/CellDefn.o \ +$(OBJDIR)/Particle.o \ +$(OBJDIR)/gwf-disv.o \ +$(OBJDIR)/FlowModelInterface.o \ +$(OBJDIR)/Subcell.o \ +$(OBJDIR)/TrackData.o \ +$(OBJDIR)/TimeSelect.o \ +$(OBJDIR)/prt-fmi.o \ +$(OBJDIR)/Cell.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ -$(OBJDIR)/BoundaryPackage.o \ +$(OBJDIR)/TernarySolveTrack.o \ +$(OBJDIR)/SubcellTri.o \ +$(OBJDIR)/Method.o \ +$(OBJDIR)/SubcellRect.o \ +$(OBJDIR)/gwf-dis.o \ $(OBJDIR)/VirtualBase.o \ $(OBJDIR)/STLVecInt.o \ $(OBJDIR)/BaseModel.o \ -$(OBJDIR)/PackageBudget.o \ -$(OBJDIR)/HeadFileReader.o \ -$(OBJDIR)/BudgetObject.o \ $(OBJDIR)/PrintSaveManager.o \ $(OBJDIR)/SfrCrossSectionManager.o \ $(OBJDIR)/dag_module.o \ $(OBJDIR)/BoundaryPackageExt.o \ +$(OBJDIR)/MethodSubcellTernary.o \ +$(OBJDIR)/MethodSubcellPollock.o \ $(OBJDIR)/VirtualDataLists.o \ $(OBJDIR)/VirtualDataContainer.o \ $(OBJDIR)/SimStages.o \ $(OBJDIR)/NumericalModel.o \ -$(OBJDIR)/FlowModelInterface.o \ $(OBJDIR)/OutputControlData.o \ $(OBJDIR)/gwf-ic.o \ $(OBJDIR)/Xt3dAlgorithm.o \ @@ -221,6 +246,10 @@ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf-ghb.o \ $(OBJDIR)/gwf-drn.o \ $(OBJDIR)/IndexMap.o \ +$(OBJDIR)/MethodSubcellPool.o \ +$(OBJDIR)/CellPoly.o \ +$(OBJDIR)/CellRectQuad.o \ +$(OBJDIR)/CellRect.o \ $(OBJDIR)/VirtualModel.o \ $(OBJDIR)/BaseExchange.o \ $(OBJDIR)/tsp-fmi.o \ @@ -239,6 +268,10 @@ $(OBJDIR)/SeqVector.o \ $(OBJDIR)/ImsLinearSettings.o \ $(OBJDIR)/ConvergenceSummary.o \ $(OBJDIR)/ArrayReaderBase.o \ +$(OBJDIR)/MethodCellTernary.o \ +$(OBJDIR)/MethodCellPollockQuad.o \ +$(OBJDIR)/MethodCellPollock.o \ +$(OBJDIR)/MethodCellPassToBot.o \ $(OBJDIR)/CellWithNbrs.o \ $(OBJDIR)/NumericalExchange.o \ $(OBJDIR)/tsp-ssm.o \ @@ -246,9 +279,7 @@ $(OBJDIR)/tsp-oc.o \ $(OBJDIR)/tsp-obs.o \ $(OBJDIR)/tsp-mvt.o \ $(OBJDIR)/tsp-adv.o \ -$(OBJDIR)/gwf-disv.o \ $(OBJDIR)/gwf-disu.o \ -$(OBJDIR)/gwf-dis.o \ $(OBJDIR)/gwf-uzf.o \ $(OBJDIR)/tsp-apt.o \ $(OBJDIR)/gwt-mst.o \ @@ -270,6 +301,8 @@ $(OBJDIR)/IdmLogger.o \ $(OBJDIR)/Integer2dReader.o \ $(OBJDIR)/DislGeom.o \ $(OBJDIR)/SwfCxsUtils.o \ +$(OBJDIR)/MethodCellPool.o \ +$(OBJDIR)/CellUtil.o \ $(OBJDIR)/VirtualExchange.o \ $(OBJDIR)/GridSorting.o \ $(OBJDIR)/DisConnExchange.o \ @@ -316,6 +349,8 @@ $(OBJDIR)/Double1dReader.o \ $(OBJDIR)/swf-disl.o \ $(OBJDIR)/swf-cxs.o \ $(OBJDIR)/swf-ic.o \ +$(OBJDIR)/MethodDisv.o \ +$(OBJDIR)/MethodDis.o \ $(OBJDIR)/GridConnection.o \ $(OBJDIR)/DistributedVariable.o \ $(OBJDIR)/gwt.o \ @@ -337,7 +372,11 @@ $(OBJDIR)/swf-oc.o \ $(OBJDIR)/swf-obs.o \ $(OBJDIR)/swf-flw.o \ $(OBJDIR)/swf-dfw.o \ -$(OBJDIR)/ExplicitModel.o \ +$(OBJDIR)/prt-prp.o \ +$(OBJDIR)/prt-oc.o \ +$(OBJDIR)/prt-obs.o \ +$(OBJDIR)/prt-mip.o \ +$(OBJDIR)/MethodPool.o \ $(OBJDIR)/SpatialModelConnection.o \ $(OBJDIR)/GwtInterfaceModel.o \ $(OBJDIR)/exg-gwtgwt.o \ @@ -352,6 +391,7 @@ $(OBJDIR)/StressListInput.o \ $(OBJDIR)/StressGridInput.o \ $(OBJDIR)/LoadMf6File.o \ $(OBJDIR)/swf.o \ +$(OBJDIR)/prt.o \ $(OBJDIR)/ExplicitSolution.o \ $(OBJDIR)/GwtGwtConnection.o \ $(OBJDIR)/GwfGwfConnection.o \ @@ -369,6 +409,7 @@ $(OBJDIR)/VirtualGweExchange.o \ $(OBJDIR)/exg-swfgwf.o \ $(OBJDIR)/SolutionGroup.o \ $(OBJDIR)/SolutionFactory.o \ +$(OBJDIR)/exg-gwfprt.o \ $(OBJDIR)/exg-gwfgwt.o \ $(OBJDIR)/exg-gwfgwe.o \ $(OBJDIR)/RunControl.o \ @@ -390,7 +431,8 @@ $(OBJDIR)/rcm.o \ $(OBJDIR)/blas1_d.o \ $(OBJDIR)/Iunit.o \ $(OBJDIR)/RectangularGeometry.o \ -$(OBJDIR)/CircularGeometry.o +$(OBJDIR)/CircularGeometry.o \ +$(OBJDIR)/ExplicitModel.o # Define the objects that make up the program $(PROGRAM) : $(OBJECTS) diff --git a/msvs/mf6.vfproj b/msvs/mf6.vfproj index 3d8eb21730e..cfad99a21e5 100644 --- a/msvs/mf6.vfproj +++ b/msvs/mf6.vfproj @@ -26,7 +26,7 @@ - + @@ -36,7 +36,7 @@ - + @@ -56,7 +56,7 @@ - + diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index fa30c8185cb..aef9e6f560d 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -110,6 +110,7 @@ + @@ -147,6 +148,10 @@ + + + + @@ -156,19 +161,23 @@ - + + + + - + + @@ -234,7 +243,6 @@ - @@ -246,7 +254,6 @@ - @@ -256,6 +263,14 @@ + + + + + + + + @@ -280,6 +295,8 @@ + + @@ -321,6 +338,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + @@ -371,7 +412,6 @@ - diff --git a/msvs/mf6lib.vfproj b/msvs/mf6lib.vfproj index a14282b94e7..2c27e0c358b 100644 --- a/msvs/mf6lib.vfproj +++ b/msvs/mf6lib.vfproj @@ -160,7 +160,6 @@ - diff --git a/src/Exchange/exg-gwfprt.f90 b/src/Exchange/exg-gwfprt.f90 new file mode 100644 index 00000000000..2ea62c71fb3 --- /dev/null +++ b/src/Exchange/exg-gwfprt.f90 @@ -0,0 +1,356 @@ +module GwfPrtExchangeModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: LENPACKAGENAME + use ListsModule, only: basemodellist, baseexchangelist + use SimModule, only: store_error + use SimVariablesModule, only: errmsg + use BaseExchangeModule, only: BaseExchangeType, AddBaseExchangeToList + use BaseModelModule, only: BaseModelType, GetBaseModelFromList + use GwfModule, only: GwfModelType + use PrtModule, only: PrtModelType + use BndModule, only: BndType, GetBndFromList + + implicit none + public :: GwfPrtExchangeType + public :: gwfprt_cr + + type, extends(BaseExchangeType) :: GwfPrtExchangeType + + integer(I4B), pointer :: m1id => null() + integer(I4B), pointer :: m2id => null() + + contains + + procedure :: exg_df + procedure :: exg_ar + procedure :: exg_da + procedure, private :: set_model_pointers + procedure, private :: allocate_scalars + procedure, private :: gwfbnd2prtfmi + ! procedure, private :: gwfconn2prtconn + ! procedure, private :: link_connections + + end type GwfPrtExchangeType + +contains + + !> @brief Create a new GWF to PRT exchange object + subroutine gwfprt_cr(filename, id, m1id, m2id) + ! -- modules + use SimVariablesModule, only: model_loc_idx + ! -- dummy + character(len=*), intent(in) :: filename + integer(I4B), intent(in) :: id + integer(I4B), intent(in) :: m1id + integer(I4B), intent(in) :: m2id + ! -- local + class(BaseExchangeType), pointer :: baseexchange => null() + type(GwfPrtExchangeType), pointer :: exchange => null() + character(len=20) :: cint + ! + ! -- Create a new exchange and add it to the baseexchangelist container + allocate (exchange) + baseexchange => exchange + call AddBaseExchangeToList(baseexchangelist, baseexchange) + ! + ! -- Assign id and name + exchange%id = id + write (cint, '(i0)') id + exchange%name = 'GWF-PRT_'//trim(adjustl(cint)) + exchange%memoryPath = exchange%name + ! + ! -- allocate scalars + call exchange%allocate_scalars() + ! + ! -- NB: convert from id to local model index in base model list + exchange%m1id = model_loc_idx(m1id) + exchange%m2id = model_loc_idx(m2id) + ! + ! -- set model pointers + call exchange%set_model_pointers() + ! + ! -- return + return + end subroutine gwfprt_cr + + subroutine set_model_pointers(this) + ! -- modules + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + class(BaseModelType), pointer :: mb => null() + type(GwfModelType), pointer :: gwfmodel => null() + type(PrtModelType), pointer :: prtmodel => null() + ! + ! -- set gwfmodel + mb => GetBaseModelFromList(basemodellist, this%m1id) + select type (mb) + type is (GwfModelType) + gwfmodel => mb + end select + ! + ! -- set prtmodel + mb => GetBaseModelFromList(basemodellist, this%m2id) + select type (mb) + type is (PrtModelType) + prtmodel => mb + end select + ! + ! -- Verify that GWF model is of the correct type + if (.not. associated(gwfmodel)) then + write (errmsg, '(3a)') 'Problem with GWF-PRT exchange ', trim(this%name), & + '. Specified GWF Model does not appear to be of the correct type.' + call store_error(errmsg, terminate=.true.) + end if + ! + ! -- Verify that PRT model is of the correct type + if (.not. associated(prtmodel)) then + write (errmsg, '(3a)') 'Problem with GWF-PRT exchange ', trim(this%name), & + '. Specified PRT Model does not appear to be of the correct type.' + call store_error(errmsg, terminate=.true.) + end if + ! + ! -- Tell particle tracking model fmi flows are not read from file + prtmodel%fmi%flows_from_file = .false. + ! + ! -- Set a pointer to the GWF bndlist. This will allow the transport model + ! to look through the flow packages and establish a link to GWF flows + prtmodel%fmi%gwfbndlist => gwfmodel%bndlist + ! + ! -- return + return + end subroutine set_model_pointers + + subroutine exg_df(this) + ! -- modules + use MemoryManagerModule, only: mem_checkin + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + class(BaseModelType), pointer :: mb => null() + type(GwfModelType), pointer :: gwfmodel => null() + type(PrtModelType), pointer :: prtmodel => null() + integer(I4B) :: ngwfpack, ip + class(BndType), pointer :: packobj => null() + ! + ! + ! -- set gwfmodel + mb => GetBaseModelFromList(basemodellist, this%m1id) + select type (mb) + type is (GwfModelType) + gwfmodel => mb + end select + ! + ! -- set prtmodel + mb => GetBaseModelFromList(basemodellist, this%m2id) + select type (mb) + type is (PrtModelType) + prtmodel => mb + end select + ! + ! -- Check to make sure that flow is solved before particle tracking and in a + ! different solution + if (gwfmodel%idsoln >= prtmodel%idsoln) then + write (errmsg, '(3a)') 'Problem with GWF-PRT exchange ', trim(this%name), & + '. The GWF model must be solved by a different solution than the PRT model. & + &The IMS specified for GWF must be listed in mfsim.nam & + &before the EMS for PRT.' + call store_error(errmsg, terminate=.true.) + end if + ! + ! -- Set pointer to flowja + prtmodel%fmi%gwfflowja => gwfmodel%flowja + call mem_checkin(prtmodel%fmi%gwfflowja, & + 'GWFFLOWJA', prtmodel%fmi%memoryPath, & + 'FLOWJA', gwfmodel%memoryPath) + ! + ! -- Set the npf flag so that specific discharge is available for + ! transport calculations if dispersion is active + if (prtmodel%indsp > 0) then + gwfmodel%npf%icalcspdis = 1 + end if + ! + ! -- Set the auxiliary names for gwf flow packages in prt%fmi + ngwfpack = gwfmodel%bndlist%Count() + do ip = 1, ngwfpack + packobj => GetBndFromList(gwfmodel%bndlist, ip) + call prtmodel%fmi%gwfpackages(ip)%set_auxname(packobj%naux, & + packobj%auxname) + end do + ! + ! -- return + return + end subroutine exg_df + + subroutine exg_ar(this) + ! -- modules + use MemoryManagerModule, only: mem_checkin + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + class(BaseModelType), pointer :: mb => null() + type(GwfModelType), pointer :: gwfmodel => null() + type(PrtModelType), pointer :: prtmodel => null() + ! -- formats + character(len=*), parameter :: fmtdiserr = & + "('GWF and PRT Models do not have the same discretization for exchange& + & ',a,'.& + & GWF Model has ', i0, ' user nodes and ', i0, ' reduced nodes.& + & PRT Model has ', i0, ' user nodes and ', i0, ' reduced nodes.& + & Ensure discretization packages, including IDOMAIN, are identical.')" + ! + ! -- set gwfmodel + mb => GetBaseModelFromList(basemodellist, this%m1id) + select type (mb) + type is (GwfModelType) + gwfmodel => mb + end select + ! + ! -- set prtmodel + mb => GetBaseModelFromList(basemodellist, this%m2id) + select type (mb) + type is (PrtModelType) + prtmodel => mb + end select + ! + ! -- Check to make sure sizes are identical + if (prtmodel%dis%nodes /= gwfmodel%dis%nodes .or. & + prtmodel%dis%nodesuser /= gwfmodel%dis%nodesuser) then + write (errmsg, fmtdiserr) trim(this%name), & + gwfmodel%dis%nodesuser, & + gwfmodel%dis%nodes, & + prtmodel%dis%nodesuser, & + prtmodel%dis%nodes + call store_error(errmsg, terminate=.TRUE.) + end if + ! + ! -- setup pointers to gwf variables allocated in gwf_ar + prtmodel%fmi%gwfhead => gwfmodel%x + call mem_checkin(prtmodel%fmi%gwfhead, & + 'GWFHEAD', prtmodel%fmi%memoryPath, & + 'X', gwfmodel%memoryPath) + prtmodel%fmi%gwfsat => gwfmodel%npf%sat + call mem_checkin(prtmodel%fmi%gwfsat, & + 'GWFSAT', prtmodel%fmi%memoryPath, & + 'SAT', gwfmodel%npf%memoryPath) + prtmodel%fmi%gwfspdis => gwfmodel%npf%spdis + call mem_checkin(prtmodel%fmi%gwfspdis, & + 'GWFSPDIS', prtmodel%fmi%memoryPath, & + 'SPDIS', gwfmodel%npf%memoryPath) + ! + ! -- setup pointers to the flow storage rates. GWF strg arrays are + ! available after the gwf_ar routine is called. + if (prtmodel%inmst > 0) then + if (gwfmodel%insto > 0) then + prtmodel%fmi%gwfstrgss => gwfmodel%sto%strgss + prtmodel%fmi%igwfstrgss = 1 + if (gwfmodel%sto%iusesy == 1) then + prtmodel%fmi%gwfstrgsy => gwfmodel%sto%strgsy + prtmodel%fmi%igwfstrgsy = 1 + end if + end if + end if + + ! -- todo: set pointer to particle mass concentration, once calculated? + ! if (gwfmodel%inbuy > 0) & + ! call gwfmodel%buy%set_concentration_pointer(& + ! prtmodel%name, prtmodel%mass, prtmodel%ibound) + + ! -- transfer the boundary package information from gwf to prt + call this%gwfbnd2prtfmi() + + ! -- if mover package is active, then set a pointer to it's budget object + if (gwfmodel%inmvr /= 0) & + prtmodel%fmi%mvrbudobj => gwfmodel%mvr%budobj + + ! -- todo connections + end subroutine exg_ar + + ! todo subroutines: gwfconn2prtconn and link_connections + + subroutine exg_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + ! + call mem_deallocate(this%m1id) + call mem_deallocate(this%m2id) + ! + ! -- return + return + end subroutine exg_da + + subroutine allocate_scalars(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_checkin + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + ! + call mem_allocate(this%m1id, 'M1ID', this%memoryPath) + call mem_allocate(this%m2id, 'M2ID', this%memoryPath) + this%m1id = 0 + this%m2id = 0 + ! + ! -- return + return + end subroutine allocate_scalars + + subroutine gwfbnd2prtfmi(this) + ! -- modules + ! -- dummy + class(GwfPrtExchangeType) :: this + ! -- local + integer(I4B) :: ngwfpack, ip, iterm, imover + class(BaseModelType), pointer :: mb => null() + type(GwfModelType), pointer :: gwfmodel => null() + type(PrtModelType), pointer :: prtmodel => null() + class(BndType), pointer :: packobj => null() + ! + ! -- set gwfmodel + mb => GetBaseModelFromList(basemodellist, this%m1id) + select type (mb) + type is (GwfModelType) + gwfmodel => mb + end select + ! + ! -- set prtmodel + mb => GetBaseModelFromList(basemodellist, this%m2id) + select type (mb) + type is (PrtModelType) + prtmodel => mb + end select + ! + ! -- Call routines in FMI that will set pointers to the necessary flow + ! data (SIMVALS and SIMTOMVR) stored within each GWF flow package + ngwfpack = gwfmodel%bndlist%Count() + iterm = 1 + do ip = 1, ngwfpack + packobj => GetBndFromList(gwfmodel%bndlist, ip) + call prtmodel%fmi%gwfpackages(iterm)%set_pointers( & + 'SIMVALS', & + packobj%memoryPath, & + packobj%input_mempath) + iterm = iterm + 1 + ! + ! -- If a mover is active for this package, then establish a separate + ! pointer link for the mover flows stored in SIMTOMVR + imover = packobj%imover + if (packobj%isadvpak /= 0) imover = 0 + if (imover /= 0) then + call prtmodel%fmi%gwfpackages(iterm)%set_pointers( & + 'SIMTOMVR', & + packobj%memoryPath, & + packobj%input_mempath) + iterm = iterm + 1 + end if + end do + ! + ! -- return + return + end subroutine gwfbnd2prtfmi + +end module GwfPrtExchangeModule diff --git a/src/Idm/exg-gwfprtidm.f90 b/src/Idm/exg-gwfprtidm.f90 new file mode 100644 index 00000000000..25f8c662a93 --- /dev/null +++ b/src/Idm/exg-gwfprtidm.f90 @@ -0,0 +1,70 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module ExgGwfprtInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public exg_gwfprt_param_definitions + public exg_gwfprt_aggregate_definitions + public exg_gwfprt_block_definitions + public ExgGwfprtParamFoundType + public exg_gwfprt_multi_package + + type ExgGwfprtParamFoundType + end type ExgGwfprtParamFoundType + + logical :: exg_gwfprt_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + exg_gwfprt_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_gwfprt_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_gwfprt_block_definitions(*) = & + [ & + InputBlockDefinitionType & + ( & + '', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_varaible + ) & + ] + +end module ExgGwfprtInputModule diff --git a/src/Idm/prt-disidm.f90 b/src/Idm/prt-disidm.f90 new file mode 100644 index 00000000000..ff9c3ffc1c7 --- /dev/null +++ b/src/Idm/prt-disidm.f90 @@ -0,0 +1,313 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module PrtDisInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public prt_dis_param_definitions + public prt_dis_aggregate_definitions + public prt_dis_block_definitions + public PrtDisParamFoundType + public prt_dis_multi_package + + type PrtDisParamFoundType + logical :: length_units = .false. + logical :: nogrb = .false. + logical :: xorigin = .false. + logical :: yorigin = .false. + logical :: angrot = .false. + logical :: nlay = .false. + logical :: nrow = .false. + logical :: ncol = .false. + logical :: delr = .false. + logical :: delc = .false. + logical :: top = .false. + logical :: botm = .false. + logical :: idomain = .false. + end type PrtDisParamFoundType + + logical :: prt_dis_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + prtdis_length_units = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'OPTIONS', & ! block + 'LENGTH_UNITS', & ! tag name + 'LENGTH_UNITS', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_nogrb = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'OPTIONS', & ! block + 'NOGRB', & ! tag name + 'NOGRB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_xorigin = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'OPTIONS', & ! block + 'XORIGIN', & ! tag name + 'XORIGIN', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_yorigin = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'OPTIONS', & ! block + 'YORIGIN', & ! tag name + 'YORIGIN', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_angrot = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'OPTIONS', & ! block + 'ANGROT', & ! tag name + 'ANGROT', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_nlay = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'DIMENSIONS', & ! block + 'NLAY', & ! tag name + 'NLAY', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_nrow = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'DIMENSIONS', & ! block + 'NROW', & ! tag name + 'NROW', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_ncol = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'DIMENSIONS', & ! block + 'NCOL', & ! tag name + 'NCOL', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_delr = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'GRIDDATA', & ! block + 'DELR', & ! tag name + 'DELR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCOL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_delc = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'GRIDDATA', & ! block + 'DELC', & ! tag name + 'DELC', & ! fortran variable + 'DOUBLE1D', & ! type + 'NROW', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_top = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'GRIDDATA', & ! block + 'TOP', & ! tag name + 'TOP', & ! fortran variable + 'DOUBLE2D', & ! type + 'NCOL NROW', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_botm = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'GRIDDATA', & ! block + 'BOTM', & ! tag name + 'BOTM', & ! fortran variable + 'DOUBLE3D', & ! type + 'NCOL NROW NLAY', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdis_idomain = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DIS', & ! subcomponent + 'GRIDDATA', & ! block + 'IDOMAIN', & ! tag name + 'IDOMAIN', & ! fortran variable + 'INTEGER3D', & ! type + 'NCOL NROW NLAY', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_dis_param_definitions(*) = & + [ & + prtdis_length_units, & + prtdis_nogrb, & + prtdis_xorigin, & + prtdis_yorigin, & + prtdis_angrot, & + prtdis_nlay, & + prtdis_nrow, & + prtdis_ncol, & + prtdis_delr, & + prtdis_delc, & + prtdis_top, & + prtdis_botm, & + prtdis_idomain & + ] + + type(InputParamDefinitionType), parameter :: & + prt_dis_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 :: & + prt_dis_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'GRIDDATA', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module PrtDisInputModule diff --git a/src/Idm/prt-disvidm.f90 b/src/Idm/prt-disvidm.f90 new file mode 100644 index 00000000000..69cfdcc58bf --- /dev/null +++ b/src/Idm/prt-disvidm.f90 @@ -0,0 +1,460 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module PrtDisvInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public prt_disv_param_definitions + public prt_disv_aggregate_definitions + public prt_disv_block_definitions + public PrtDisvParamFoundType + public prt_disv_multi_package + + type PrtDisvParamFoundType + logical :: length_units = .false. + logical :: nogrb = .false. + logical :: xorigin = .false. + logical :: yorigin = .false. + logical :: angrot = .false. + logical :: nlay = .false. + logical :: ncpl = .false. + logical :: nvert = .false. + logical :: top = .false. + logical :: botm = .false. + logical :: idomain = .false. + logical :: iv = .false. + logical :: xv = .false. + logical :: yv = .false. + logical :: icell2d = .false. + logical :: xc = .false. + logical :: yc = .false. + logical :: ncvert = .false. + logical :: icvert = .false. + end type PrtDisvParamFoundType + + logical :: prt_disv_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + prtdisv_length_units = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'OPTIONS', & ! block + 'LENGTH_UNITS', & ! tag name + 'LENGTH_UNITS', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_nogrb = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'OPTIONS', & ! block + 'NOGRB', & ! tag name + 'NOGRB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_xorigin = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'OPTIONS', & ! block + 'XORIGIN', & ! tag name + 'XORIGIN', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_yorigin = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'OPTIONS', & ! block + 'YORIGIN', & ! tag name + 'YORIGIN', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_angrot = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'OPTIONS', & ! block + 'ANGROT', & ! tag name + 'ANGROT', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_nlay = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'DIMENSIONS', & ! block + 'NLAY', & ! tag name + 'NLAY', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_ncpl = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'DIMENSIONS', & ! block + 'NCPL', & ! tag name + 'NCPL', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_nvert = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'DIMENSIONS', & ! block + 'NVERT', & ! tag name + 'NVERT', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_top = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'GRIDDATA', & ! block + 'TOP', & ! tag name + 'TOP', & ! fortran variable + 'DOUBLE1D', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_botm = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'GRIDDATA', & ! block + 'BOTM', & ! tag name + 'BOTM', & ! fortran variable + 'DOUBLE2D', & ! type + 'NCPL NLAY', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_idomain = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'GRIDDATA', & ! block + 'IDOMAIN', & ! tag name + 'IDOMAIN', & ! fortran variable + 'INTEGER2D', & ! type + 'NCPL NLAY', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_iv = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'VERTICES', & ! block + 'IV', & ! tag name + 'IV', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_xv = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'VERTICES', & ! block + 'XV', & ! tag name + 'XV', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_yv = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'VERTICES', & ! block + 'YV', & ! tag name + 'YV', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_icell2d = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'ICELL2D', & ! tag name + 'ICELL2D', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_xc = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'XC', & ! tag name + 'XC', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_yc = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'YC', & ! tag name + 'YC', & ! fortran variable + 'DOUBLE', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_ncvert = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'NCVERT', & ! tag name + 'NCVERT', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_icvert = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'ICVERT', & ! tag name + 'ICVERT', & ! fortran variable + 'INTEGER1D', & ! type + 'NCVERT', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_disv_param_definitions(*) = & + [ & + prtdisv_length_units, & + prtdisv_nogrb, & + prtdisv_xorigin, & + prtdisv_yorigin, & + prtdisv_angrot, & + prtdisv_nlay, & + prtdisv_ncpl, & + prtdisv_nvert, & + prtdisv_top, & + prtdisv_botm, & + prtdisv_idomain, & + prtdisv_iv, & + prtdisv_xv, & + prtdisv_yv, & + prtdisv_icell2d, & + prtdisv_xc, & + prtdisv_yc, & + prtdisv_ncvert, & + prtdisv_icvert & + ] + + type(InputParamDefinitionType), parameter :: & + prtdisv_vertices = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'VERTICES', & ! block + 'VERTICES', & ! tag name + 'VERTICES', & ! fortran variable + 'RECARRAY IV XV YV', & ! type + 'NVERT', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtdisv_cell2d = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'DISV', & ! subcomponent + 'CELL2D', & ! block + 'CELL2D', & ! tag name + 'CELL2D', & ! fortran variable + 'RECARRAY ICELL2D XC YC NCVERT ICVERT', & ! type + 'NCPL', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_disv_aggregate_definitions(*) = & + [ & + prtdisv_vertices, & + prtdisv_cell2d & + ] + + type(InputBlockDefinitionType), parameter :: & + prt_disv_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'GRIDDATA', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'VERTICES', & ! blockname + .true., & ! required + .true., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'CELL2D', & ! blockname + .true., & ! required + .true., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module PrtDisvInputModule diff --git a/src/Idm/prt-mipidm.f90 b/src/Idm/prt-mipidm.f90 new file mode 100644 index 00000000000..6548c358481 --- /dev/null +++ b/src/Idm/prt-mipidm.f90 @@ -0,0 +1,136 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module PrtMipInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public prt_mip_param_definitions + public prt_mip_aggregate_definitions + public prt_mip_block_definitions + public PrtMipParamFoundType + public prt_mip_multi_package + + type PrtMipParamFoundType + logical :: zero_method = .false. + logical :: porosity = .false. + logical :: retfactor = .false. + logical :: izone = .false. + end type PrtMipParamFoundType + + logical :: prt_mip_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + prtmip_zero_method = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'MIP', & ! subcomponent + 'OPTIONS', & ! block + 'ZERO_METHOD', & ! tag name + 'ZERO_METHOD', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtmip_porosity = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'MIP', & ! subcomponent + 'GRIDDATA', & ! block + 'POROSITY', & ! tag name + 'POROSITY', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtmip_retfactor = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'MIP', & ! subcomponent + 'GRIDDATA', & ! block + 'RETFACTOR', & ! tag name + 'RETFACTOR', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtmip_izone = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'MIP', & ! subcomponent + 'GRIDDATA', & ! block + 'IZONE', & ! tag name + 'IZONE', & ! fortran variable + 'INTEGER1D', & ! type + 'NODES', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_mip_param_definitions(*) = & + [ & + prtmip_zero_method, & + prtmip_porosity, & + prtmip_retfactor, & + prtmip_izone & + ] + + type(InputParamDefinitionType), parameter :: & + prt_mip_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 :: & + prt_mip_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'GRIDDATA', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module PrtMipInputModule diff --git a/src/Idm/prt-namidm.f90 b/src/Idm/prt-namidm.f90 new file mode 100644 index 00000000000..e1414a1e7fc --- /dev/null +++ b/src/Idm/prt-namidm.f90 @@ -0,0 +1,196 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module PrtNamInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public prt_nam_param_definitions + public prt_nam_aggregate_definitions + public prt_nam_block_definitions + public PrtNamParamFoundType + public prt_nam_multi_package + + type PrtNamParamFoundType + logical :: list = .false. + logical :: print_input = .false. + logical :: print_flows = .false. + logical :: save_flows = .false. + logical :: ftype = .false. + logical :: fname = .false. + logical :: pname = .false. + end type PrtNamParamFoundType + + logical :: prt_nam_multi_package = .false. + + type(InputParamDefinitionType), parameter :: & + prtnam_list = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'OPTIONS', & ! block + 'LIST', & ! tag name + 'LIST', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_print_input = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'PRINT_INPUT', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_print_flows = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'PRINT_FLOWS', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_save_flows = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'SAVE_FLOWS', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_ftype = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'PACKAGES', & ! block + 'FTYPE', & ! tag name + 'FTYPE', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_fname = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'PACKAGES', & ! block + 'FNAME', & ! tag name + 'FNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prtnam_pname = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'PACKAGES', & ! block + 'PNAME', & ! tag name + 'PNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + .false., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_nam_param_definitions(*) = & + [ & + prtnam_list, & + prtnam_print_input, & + prtnam_print_flows, & + prtnam_save_flows, & + prtnam_ftype, & + prtnam_fname, & + prtnam_pname & + ] + + type(InputParamDefinitionType), parameter :: & + prtnam_packages = InputParamDefinitionType & + ( & + 'PRT', & ! component + 'NAM', & ! subcomponent + 'PACKAGES', & ! block + 'PACKAGES', & ! tag name + 'PACKAGES', & ! fortran variable + 'RECARRAY FTYPE FNAME PNAME', & ! type + '', & ! shape + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + prt_nam_aggregate_definitions(*) = & + [ & + prtnam_packages & + ] + + type(InputBlockDefinitionType), parameter :: & + prt_nam_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PACKAGES', & ! blockname + .true., & ! required + .true., & ! aggregate + .false. & ! block_variable + ) & + ] + +end module PrtNamInputModule diff --git a/src/Idm/selector/IdmDfnSelector.f90 b/src/Idm/selector/IdmDfnSelector.f90 index 64c1053bc8b..0cc1a8f55db 100644 --- a/src/Idm/selector/IdmDfnSelector.f90 +++ b/src/Idm/selector/IdmDfnSelector.f90 @@ -10,6 +10,7 @@ module IdmDfnSelectorModule use IdmGwtDfnSelectorModule use IdmGweDfnSelectorModule use IdmSwfDfnSelectorModule + use IdmPrtDfnSelectorModule use IdmExgDfnSelectorModule implicit none @@ -39,6 +40,8 @@ function param_definitions(component, subcomponent) result(input_definition) input_definition => gwe_param_definitions(subcomponent) case ('SWF') input_definition => swf_param_definitions(subcomponent) + case ('PRT') + input_definition => prt_param_definitions(subcomponent) case ('EXG') input_definition => exg_param_definitions(subcomponent) case default @@ -62,6 +65,8 @@ function aggregate_definitions(component, subcomponent) result(input_definition) input_definition => gwe_aggregate_definitions(subcomponent) case ('SWF') input_definition => swf_aggregate_definitions(subcomponent) + case ('PRT') + input_definition => prt_aggregate_definitions(subcomponent) case ('EXG') input_definition => exg_aggregate_definitions(subcomponent) case default @@ -85,6 +90,8 @@ function block_definitions(component, subcomponent) result(input_definition) input_definition => gwe_block_definitions(subcomponent) case ('SWF') input_definition => swf_block_definitions(subcomponent) + case ('PRT') + input_definition => prt_block_definitions(subcomponent) case ('EXG') input_definition => exg_block_definitions(subcomponent) case default @@ -107,6 +114,8 @@ function idm_multi_package(component, subcomponent) result(multi_package) multi_package = gwe_idm_multi_package(subcomponent) case ('SWF') multi_package = swf_idm_multi_package(subcomponent) + case ('PRT') + multi_package = prt_idm_multi_package(subcomponent) case ('EXG') multi_package = exg_idm_multi_package(subcomponent) case default @@ -133,6 +142,8 @@ function idm_integrated(component, subcomponent) result(integrated) integrated = gwe_idm_integrated(subcomponent) case ('SWF') integrated = swf_idm_integrated(subcomponent) + case ('PRT') + integrated = prt_idm_integrated(subcomponent) case ('EXG') integrated = exg_idm_integrated(subcomponent) case default @@ -155,6 +166,8 @@ function idm_component(component) result(integrated) integrated = .true. case ('SWF') integrated = .true. + case ('PRT') + integrated = .true. case ('EXG') integrated = .true. case default diff --git a/src/Idm/selector/IdmExgDfnSelector.f90 b/src/Idm/selector/IdmExgDfnSelector.f90 index 55ac35a1537..ac464834577 100644 --- a/src/Idm/selector/IdmExgDfnSelector.f90 +++ b/src/Idm/selector/IdmExgDfnSelector.f90 @@ -11,6 +11,7 @@ module IdmExgDfnSelectorModule use ExgGwfgweInputModule use ExgGwegweInputModule use ExgSwfgwfInputModule + use ExgGwfprtInputModule implicit none private @@ -51,6 +52,8 @@ function exg_param_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, exg_gwegwe_param_definitions) case ('SWFGWF') call set_param_pointer(input_definition, exg_swfgwf_param_definitions) + case ('GWFPRT') + call set_param_pointer(input_definition, exg_gwfprt_param_definitions) case default end select return @@ -73,6 +76,8 @@ function exg_aggregate_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, exg_gwegwe_aggregate_definitions) case ('SWFGWF') call set_param_pointer(input_definition, exg_swfgwf_aggregate_definitions) + case ('GWFPRT') + call set_param_pointer(input_definition, exg_gwfprt_aggregate_definitions) case default end select return @@ -95,6 +100,8 @@ function exg_block_definitions(subcomponent) result(input_definition) call set_block_pointer(input_definition, exg_gwegwe_block_definitions) case ('SWFGWF') call set_block_pointer(input_definition, exg_swfgwf_block_definitions) + case ('GWFPRT') + call set_block_pointer(input_definition, exg_gwfprt_block_definitions) case default end select return @@ -116,6 +123,8 @@ function exg_idm_multi_package(subcomponent) result(multi_package) multi_package = exg_gwegwe_multi_package case ('SWFGWF') multi_package = exg_swfgwf_multi_package + case ('GWFPRT') + multi_package = exg_gwfprt_multi_package case default call store_error('Idm selector subcomponent not found; '//& &'component="EXG"'//& @@ -141,6 +150,8 @@ function exg_idm_integrated(subcomponent) result(integrated) integrated = .true. case ('SWFGWF') integrated = .true. + case ('GWFPRT') + integrated = .true. case default end select return diff --git a/src/Idm/selector/IdmPrtDfnSelector.f90 b/src/Idm/selector/IdmPrtDfnSelector.f90 new file mode 100644 index 00000000000..2a99cf6fca5 --- /dev/null +++ b/src/Idm/selector/IdmPrtDfnSelector.f90 @@ -0,0 +1,127 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module IdmPrtDfnSelectorModule + + use ConstantsModule, only: LENVARNAME + use SimModule, only: store_error + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + use PrtNamInputModule + use PrtDisInputModule + use PrtDisvInputModule + use PrtMipInputModule + + implicit none + private + public :: prt_param_definitions + public :: prt_aggregate_definitions + public :: prt_block_definitions + public :: prt_idm_multi_package + public :: prt_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 prt_param_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputParamDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('NAM') + call set_param_pointer(input_definition, prt_nam_param_definitions) + case ('DIS') + call set_param_pointer(input_definition, prt_dis_param_definitions) + case ('DISV') + call set_param_pointer(input_definition, prt_disv_param_definitions) + case ('MIP') + call set_param_pointer(input_definition, prt_mip_param_definitions) + case default + end select + return + end function prt_param_definitions + + function prt_aggregate_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputParamDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('NAM') + call set_param_pointer(input_definition, prt_nam_aggregate_definitions) + case ('DIS') + call set_param_pointer(input_definition, prt_dis_aggregate_definitions) + case ('DISV') + call set_param_pointer(input_definition, prt_disv_aggregate_definitions) + case ('MIP') + call set_param_pointer(input_definition, prt_mip_aggregate_definitions) + case default + end select + return + end function prt_aggregate_definitions + + function prt_block_definitions(subcomponent) result(input_definition) + character(len=*), intent(in) :: subcomponent + type(InputBlockDefinitionType), dimension(:), pointer :: input_definition + nullify (input_definition) + select case (subcomponent) + case ('NAM') + call set_block_pointer(input_definition, prt_nam_block_definitions) + case ('DIS') + call set_block_pointer(input_definition, prt_dis_block_definitions) + case ('DISV') + call set_block_pointer(input_definition, prt_disv_block_definitions) + case ('MIP') + call set_block_pointer(input_definition, prt_mip_block_definitions) + case default + end select + return + end function prt_block_definitions + + function prt_idm_multi_package(subcomponent) result(multi_package) + character(len=*), intent(in) :: subcomponent + logical :: multi_package + select case (subcomponent) + case ('NAM') + multi_package = prt_nam_multi_package + case ('DIS') + multi_package = prt_dis_multi_package + case ('DISV') + multi_package = prt_disv_multi_package + case ('MIP') + multi_package = prt_mip_multi_package + case default + call store_error('Idm selector subcomponent not found; '//& + &'component="PRT"'//& + &', subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function prt_idm_multi_package + + function prt_idm_integrated(subcomponent) result(integrated) + character(len=*), intent(in) :: subcomponent + logical :: integrated + integrated = .false. + select case (subcomponent) + case ('NAM') + integrated = .true. + case ('DIS') + integrated = .true. + case ('DISV') + integrated = .true. + case ('MIP') + integrated = .true. + case default + end select + return + end function prt_idm_integrated + +end module IdmPrtDfnSelectorModule diff --git a/src/Model/ExplicitModel.f90 b/src/Model/ExplicitModel.f90 index 6c23d5a0969..dd829d4d465 100644 --- a/src/Model/ExplicitModel.f90 +++ b/src/Model/ExplicitModel.f90 @@ -22,7 +22,7 @@ module ExplicitModelModule !< type, extends(BaseModelType) :: ExplicitModelType character(len=LINELENGTH), pointer :: filename => null() !< input file name - integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< ibound array + integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< ibound type(ListType), pointer :: bndlist => null() !< array of boundary packages class(DisBaseType), pointer :: dis => null() !< discretization object contains diff --git a/src/Model/GroundWaterFlow/gwf-disv.f90 b/src/Model/GroundWaterFlow/gwf-disv.f90 index 41237ddacf8..63752778967 100644 --- a/src/Model/GroundWaterFlow/gwf-disv.f90 +++ b/src/Model/GroundWaterFlow/gwf-disv.f90 @@ -1370,7 +1370,7 @@ subroutine get_polyverts(this, ic, polyverts, closed) 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 + logical(LGP), intent(in), optional :: closed !< whether to close the polygon, duplicating a vertex (default false) ! -- local integer(I4B) :: icu, icu2d, iavert, ncpl, nverts, m, j logical(LGP) :: lclosed diff --git a/src/Model/GroundWaterFlow/gwf-mvr.f90 b/src/Model/GroundWaterFlow/gwf-mvr.f90 index cf536f3c4e1..0e9fd9594ce 100644 --- a/src/Model/GroundWaterFlow/gwf-mvr.f90 +++ b/src/Model/GroundWaterFlow/gwf-mvr.f90 @@ -599,7 +599,6 @@ end subroutine mvr_ot_printflow subroutine mvr_ot_bdsummary(this, ibudfl) ! -- modules use TdisModule, only: kstp, kper, delt, totim - use ArrayHandlersModule, only: ifind, expandarray ! -- dummy class(GwfMvrType) :: this integer(I4B), intent(in) :: ibudfl diff --git a/src/Model/ModelUtilities/FlowModelInterface.f90 b/src/Model/ModelUtilities/FlowModelInterface.f90 index 993a70f34c4..f1f2e2cd049 100644 --- a/src/Model/ModelUtilities/FlowModelInterface.f90 +++ b/src/Model/ModelUtilities/FlowModelInterface.f90 @@ -425,7 +425,7 @@ subroutine read_packagedata(this) 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? + call budgetobject_cr_bfr(this%mvrbudobj, 'MVT', this%iumvr, & this%iout) call this%mvrbudobj%fill_from_bfr(this%dis, this%iout) case default @@ -537,7 +537,7 @@ subroutine advance_bfr(this) 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 & + &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) diff --git a/src/Model/ModelUtilities/ModelPackageInput.f90 b/src/Model/ModelUtilities/ModelPackageInput.f90 index ae0c6708eb5..9ff1ba3f855 100644 --- a/src/Model/ModelUtilities/ModelPackageInput.f90 +++ b/src/Model/ModelUtilities/ModelPackageInput.f90 @@ -18,6 +18,8 @@ module ModelPackageInputModule GWE_BASEPKG, GWE_MULTIPKG use SwfModule, only: SWF_NBASEPKG, SWF_NMULTIPKG, & SWF_BASEPKG, SWF_MULTIPKG + use PrtModule, only: PRT_NBASEPKG, PRT_NMULTIPKG, & + PRT_BASEPKG, PRT_MULTIPKG implicit none @@ -48,22 +50,22 @@ subroutine supported_model_packages(mtype, pkgtypes, numpkgs) 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 ('GWE6') numpkgs = GWE_NBASEPKG + GWE_NMULTIPKG allocate (pkgtypes(numpkgs)) pkgtypes = [GWE_BASEPKG, GWE_MULTIPKG] - ! + case ('PRT6') + numpkgs = PRT_NBASEPKG + PRT_NMULTIPKG + allocate (pkgtypes(numpkgs)) + pkgtypes = [PRT_BASEPKG, PRT_MULTIPKG] case ('SWF6') numpkgs = SWF_NBASEPKG + SWF_NMULTIPKG allocate (pkgtypes(numpkgs)) pkgtypes = [SWF_BASEPKG, SWF_MULTIPKG] - ! case default end select ! @@ -112,6 +114,14 @@ function multi_package_type(mtype_component, ptype_component, pkgtype) & end if end do ! + case ('PRT') + do n = 1, PRT_NMULTIPKG + if (PRT_MULTIPKG(n) == pkgtype) then + multi_package = .true. + exit + end if + end do + ! case default end select ! diff --git a/src/Model/ModelUtilities/TimeSelect.f90 b/src/Model/ModelUtilities/TimeSelect.f90 new file mode 100644 index 00000000000..3d8057b971b --- /dev/null +++ b/src/Model/ModelUtilities/TimeSelect.f90 @@ -0,0 +1,167 @@ +!> @brief Specify times for some event(s) to occur. +module TimeSelectModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DONE + use ArrayHandlersModule, only: ExpandArray + use ErrorUtilModule, only: pstop + implicit none + public :: TimeSelectType + + !> @brief Represents a series of instants at which some event should occur. + !! + !! Supports selection e.g. to filter times in a selected period & time step. + !! Array storage can be expanded as needed. Note: array expansion must take + !! place before selection; when expand() is invoked the selection is cleared. + !! The time series is assumed to strictly increase, increasing() checks this. + !< + type :: TimeSelectType + real(DP), allocatable :: times(:) + integer(I4B) :: selection(2) + contains + procedure :: destroy + procedure :: expand + procedure :: init + procedure :: increasing + procedure :: select + procedure :: try_advance + end type TimeSelectType + +contains + + !> @brief Destroy the time selection object. + subroutine destroy(this) + class(TimeSelectType) :: this + deallocate (this%times) + end subroutine destroy + + !> @brief Expand capacity by the given amount. Resets the current slice. + subroutine expand(this, increment) + class(TimeSelectType) :: this + integer(I4B), optional, intent(in) :: increment + call ExpandArray(this%times, increment=increment) + this%selection = (/1, size(this%times)/) + end subroutine expand + + !> @brief Initialize or clear the time selection object. + subroutine init(this) + class(TimeSelectType) :: this + if (.not. allocated(this%times)) allocate (this%times(0)) + this%selection = (/0, 0/) + end subroutine + + !> @brief Determine if times strictly increase. + !! Returns true if empty or not yet allocated. + function increasing(this) result(inc) + class(TimeSelectType) :: this + logical(LGP) :: inc + integer(I4B) :: i + real(DP) :: l, t + + inc = .true. + if (.not. allocated(this%times)) return + do i = 1, size(this%times) + t = this%times(i) + if (i /= 1) then + if (l >= t) then + inc = .false. + return + end if + end if + l = t + end do + end function increasing + + !> @brief Select times between t0 and t1 (inclusive). + !! + !! Finds and stores the index of the first time at the same instant + !! as or following the start time, and of the last time at the same + !! instant as or preceding the end time. Allows filtering the times + !! for e.g. a particular stress period and time step. Array indices + !! are assumed to start at 1. If no times are found to fall within + !! the selection (i.e. it falls entirely between two consecutive + !! times or beyond the time range), indices are set to [-1, -1]. + !! + !! The given start and end times are first checked against currently + !! stored indices to avoid recalculating them if possible, allowing + !! multiple consuming components (e.g., subdomain particle tracking + !! solutions) to share the object efficiently, provided all proceed + !! through stress periods and time steps in lockstep, i.e. they all + !! solve any given period/step before any will proceed to the next. + !< + subroutine select(this, t0, t1, changed) + ! -- dummy + class(TimeSelectType) :: this + real(DP), intent(in) :: t0, t1 + logical(LGP), intent(inout), optional :: changed + ! -- local + integer(I4B) :: i, i0, i1 + integer(I4B) :: l, u, lp, up + real(DP) :: t + + ! -- by default, need to iterate over all times + i0 = 1 + i1 = size(this%times) + + ! -- if no times fall within the slice, set to [-1, -1] + l = -1 + u = -1 + + ! -- previous bounding indices + lp = this%selection(1) + up = this%selection(2) + + ! -- Check if we can reuse either the lower or upper bound. + ! The lower doesn't need to change if it indexes the 1st + ! time simultaneous with or later than the slice's start. + ! The upper doesn't need to change if it indexes the last + ! time before or simultaneous with the slice's end. + if (lp > 0 .and. up > 0) then + if (lp > 1) then + if (this%times(lp - 1) < t0 .and. & + this%times(lp) >= t0) then + l = lp + i0 = l + end if + end if + if (up > 1 .and. up < i1) then + if (this%times(up + 1) > t1 .and. & + this%times(up) <= t1) then + u = up + i1 = u + end if + end if + if (l == lp .and. u == up) then + this%selection = (/l, u/) + if (present(changed)) changed = .false. + return + end if + end if + + ! -- recompute bounding indices if needed + do i = i0, i1 + t = this%times(i) + if (l < 0 .and. t >= t0 .and. t <= t1) l = i + if (l > 0 .and. t <= t1) u = i + end do + this%selection = (/l, u/) + if (present(changed)) changed = l /= lp .or. u /= up + + end subroutine + + !> @brief Update the selection to match the current time step. + subroutine try_advance(this) + ! -- modules + use TdisModule, only: kper, kstp, nper, nstp, totimc, delt + ! -- dummy + class(TimeSelectType) :: this + ! -- local + real(DP) :: l, u + l = minval(this%times) + u = maxval(this%times) + if (.not. (kper == 1 .and. kstp == 1)) l = totimc + if (.not. (kper == nper .and. kstp == nstp(kper))) u = totimc + delt + call this%select(l, u) + end subroutine try_advance + +end module TimeSelectModule diff --git a/src/Model/ModelUtilities/TrackData.f90 b/src/Model/ModelUtilities/TrackData.f90 new file mode 100644 index 00000000000..b9b6006ebd6 --- /dev/null +++ b/src/Model/ModelUtilities/TrackData.f90 @@ -0,0 +1,324 @@ +module TrackModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DONE + use ParticleModule, only: ParticleType + + implicit none + + private save_record + public :: TrackFileType + public :: TrackFileControlType + + !> @brief Output file containing all or some particle pathlines. + !! + !! Can be associated with a particle release point (PRP) package + !! or with an entire model, and can be binary or comma-separated. + !< + type :: TrackFileType + integer(I4B) :: iun = 0 !< file unit number + logical(LGP) :: csv = .false. !< whether the file is binary or CSV + integer(I4B) :: iprp = -1 !< -1 is model-level file, 0 is exchange PRP + end type TrackFileType + + !> @brief Manages particle track (i.e. pathline) files. + !! + !! Optionally filters events ("ireason" codes), e.g. release + !! or cell-to-cell transitions. Events ("ireason" codes) are: + !! + !! -1: ALL + !! 0: RELEASE: particle is released + !! 1: TRANSIT: particle moves from cell to cell + !! 2: TIMESTEP: timestep ends + !! 3: TERMINATE: tracking stops for a particle + !! 4: WEAKSINK: particle exits a weak sink + !! 5: USERTIME: user-specified tracking time + !! + !! An arbitrary number of files can be managed. internal arrays + !! are resized as needed. + !< + type :: TrackFileControlType + private + type(TrackFileType), public, allocatable :: trackfiles(:) !< output files + integer(I4B), public :: ntrackfiles !< number of output files + logical(LGP), public :: trackrelease !< track release events + logical(LGP), public :: tracktransit !< track cell-to-cell transitions + logical(LGP), public :: tracktimestep !< track timestep ends + logical(LGP), public :: trackterminate !< track termination events + logical(LGP), public :: trackweaksink !< track weak sink exit events + logical(LGP), public :: trackusertime !< track user-selected times + contains + procedure :: expand + procedure, public :: init_track_file + procedure, public :: save + procedure, public :: set_track_events + end type TrackFileControlType + + ! Track file header + character(len=*), parameter, public :: TRACKHEADER = & + 'kper,kstp,imdl,iprp,irpt,ilay,icell,izone,& + &istatus,ireason,trelease,t,x,y,z,name' + + ! Track file dtypes + character(len=*), parameter, public :: TRACKDTYPES = & + ' @brief Initialize a new track file + subroutine init_track_file(this, iun, csv, iprp) + ! -- dummy + class(TrackFileControlType) :: this + integer(I4B), intent(in) :: iun + logical(LGP), intent(in), optional :: csv + integer(I4B), intent(in), optional :: iprp + ! -- local + type(TrackFileType), pointer :: file + + ! -- allocate or expand array + if (.not. allocated(this%trackfiles)) then + allocate (this%trackfiles(1)) + else + call this%expand(increment=1) + end if + + ! -- setup new file + allocate (file) + file%iun = iun + if (present(csv)) file%csv = csv + if (present(iprp)) file%iprp = iprp + + ! -- update array and counter + this%ntrackfiles = size(this%trackfiles) + this%trackfiles(this%ntrackfiles) = file + + end subroutine init_track_file + + !> @brief Expand the trackfile array, internal use only + subroutine expand(this, increment) + ! -- dummy + class(TrackFileControlType) :: this + integer(I4B), optional, intent(in) :: increment + ! -- local + integer(I4B) :: inclocal + integer(I4B) :: isize + integer(I4B) :: newsize + type(TrackFileType), allocatable, dimension(:) :: temp + + ! -- initialize + if (present(increment)) then + inclocal = increment + else + inclocal = 1 + end if + + ! -- increase size of array + if (allocated(this%trackfiles)) then + isize = size(this%trackfiles) + newsize = isize + inclocal + allocate (temp(newsize)) + temp(1:isize) = this%trackfiles + deallocate (this%trackfiles) + call move_alloc(temp, this%trackfiles) + else + allocate (this%trackfiles(inclocal)) + end if + + end subroutine expand + + !> @brief Save record to binary or CSV file, internal use only + subroutine save_record(iun, particle, kper, kstp, reason, csv) + ! -- dummy + integer(I4B), intent(in) :: iun + type(ParticleType), pointer, intent(in) :: particle + integer(I4B), intent(in) :: kper + integer(I4B), intent(in) :: kstp + integer(I4B), intent(in) :: reason + logical(LGP), intent(in) :: csv + ! -- local + real(DP) :: x + real(DP) :: y + real(DP) :: z + integer(I4B) :: status + + ! -- Get model (global) coordinates + call particle%get_model_coords(x, y, z) + + ! -- Get status + if (particle%istatus .lt. 0) then + status = 1 + else + status = particle%istatus + end if + + if (csv) then + write (iun, '(*(G0,:,","))') & + kper, & + kstp, & + particle%imdl, & + particle%iprp, & + particle%irpt, & + particle%ilay, & + particle%icu, & + particle%izone, & + status, & + reason, & + particle%trelease, & + particle%ttrack, & + x, & + y, & + z, & + trim(adjustl(particle%name)) + else + write (iun) & + kper, & + kstp, & + particle%imdl, & + particle%iprp, & + particle%irpt, & + particle%ilay, & + particle%icu, & + particle%izone, & + status, & + reason, & + particle%trelease, & + particle%ttrack, & + x, & + y, & + z, & + particle%name + end if + + end subroutine + + !> @brief Save the particle's state to track output file(s). + !! + !! A record is saved to all enabled model-level files and to + !! any PRP-level files with PRP index matching the particle's + !! PRP index. + !< + subroutine save(this, particle, kper, kstp, reason, level) + ! -- dummy + class(TrackFileControlType), intent(inout) :: this + type(ParticleType), pointer, intent(in) :: particle + integer(I4B), intent(in) :: kper + integer(I4B), intent(in) :: kstp + integer(I4B), intent(in) :: reason + integer(I4B), intent(in), optional :: level + ! -- local + integer(I4B) :: i + type(TrackFileType) :: file + + ! -- Only save if reporting is enabled for specified event. + if (.not. ((this%trackrelease .and. reason == 0) .or. & + (this%tracktransit .and. reason == 1) .or. & + (this%tracktimestep .and. reason == 2) .or. & + (this%trackterminate .and. reason == 3) .or. & + (this%trackweaksink .and. reason == 4) .or. & + (this%trackusertime .and. reason == 5))) & + return + + ! -- For now, only allow reporting from outside the tracking + ! algorithm (e.g. release time), in which case level will + ! not be provided, or if within the tracking solution, in + ! subcells (level 3) only. This may change if the subcell + ! ever delegates tracking to even smaller subcomponents. + if (present(level)) then + if (level .ne. 3) return + end if + + ! -- Save to any enabled model-scoped or PRP-scoped files + do i = 1, this%ntrackfiles + file = this%trackfiles(i) + if (file%iun > 0 .and. & + (file%iprp == -1 .or. & + file%iprp == particle%iprp)) & + call save_record(file%iun, particle, & + kper, kstp, reason, csv=file%csv) + end do + + end subroutine save + + !> @brief Configure particle events to track. + !! + !! Each tracking event corresponds to an "ireason" code + !! as appears in each row of track output. + !< + subroutine set_track_events(this, & + release, & + transit, & + timestep, & + terminate, & + weaksink, & + usertime) + class(TrackFileControlType) :: this + logical(LGP), intent(in) :: release + logical(LGP), intent(in) :: transit + logical(LGP), intent(in) :: timestep + logical(LGP), intent(in) :: terminate + logical(LGP), intent(in) :: weaksink + logical(LGP), intent(in) :: usertime + this%trackrelease = release + this%tracktransit = transit + this%tracktimestep = timestep + this%trackterminate = terminate + this%trackweaksink = weaksink + this%trackusertime = usertime + end subroutine set_track_events + +end module TrackModule diff --git a/src/Model/NumericalModel.f90 b/src/Model/NumericalModel.f90 index b724e99643e..38a124592d5 100644 --- a/src/Model/NumericalModel.f90 +++ b/src/Model/NumericalModel.f90 @@ -50,6 +50,7 @@ module NumericalModelModule procedure :: model_rp procedure :: model_ad procedure :: model_reset + procedure :: model_solve procedure :: model_cf procedure :: model_fc procedure :: model_ptcchk @@ -123,6 +124,10 @@ subroutine model_reset(this) end subroutine model_reset + subroutine model_solve(this) + class(NumericalModelType) :: this + end subroutine model_solve + subroutine model_cf(this, kiter) class(NumericalModelType) :: this integer(I4B), intent(in) :: kiter diff --git a/src/Model/ParticleTracking/prt-fmi.f90 b/src/Model/ParticleTracking/prt-fmi.f90 new file mode 100644 index 00000000000..5fd7acb5f53 --- /dev/null +++ b/src/Model/ParticleTracking/prt-fmi.f90 @@ -0,0 +1,225 @@ +module PrtFmiModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: DZERO, LENAUXNAME, LENPACKAGENAME + use SimModule, only: store_error, store_error_unit + use SimVariablesModule, only: errmsg + use FlowModelInterfaceModule, only: FlowModelInterfaceType + use BaseDisModule, only: DisBaseType + use BudgetObjectModule, only: BudgetObjectType + + implicit none + private + public :: PrtFmiType + public :: fmi_cr + + character(len=LENPACKAGENAME) :: text = ' PRTFMI' + + type, extends(FlowModelInterfaceType) :: PrtFmiType + + double precision, allocatable, public :: SourceFlows(:) ! cell source flows array + double precision, allocatable, public :: SinkFlows(:) ! cell sink flows array + double precision, allocatable, public :: StorageFlows(:) ! cell storage flows array + double precision, allocatable, public :: BoundaryFlows(:) ! cell boundary flows array + + contains + + procedure :: fmi_ad + procedure :: fmi_df => prtfmi_df + procedure, private :: accumulate_flows + + end type PrtFmiType + +contains + + !> @brief Create a new PrtFmi object + subroutine fmi_cr(fmiobj, name_model, inunit, iout) + ! -- dummy + type(PrtFmiType), pointer :: fmiobj + character(len=*), intent(in) :: name_model + integer(I4B), intent(inout) :: 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') + 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 dependent variable label + fmiobj%depvartype = 'TRACKS ' + + end subroutine fmi_cr + + !> @brief Time step advance + subroutine fmi_ad(this) + ! -- modules + use ConstantsModule, only: DHDRY + ! -- dummy + class(PrtFmiType) :: this + ! -- local + integer(I4B) :: n + character(len=15) :: nodestr + character(len=*), parameter :: fmtdry = & + &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE')" + character(len=*), parameter :: fmtrewet = & + &"(/1X,'DRY CELL REACTIVATED AT ', a)" + ! + ! -- 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 + ! + ! -- Accumulate flows + call this%accumulate_flows() + ! + ! -- if flow cell is dry, then set this%ibound = 0 + 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 model cell is inactive for flow + if (this%ibound(n) > 0) then + if (this%gwfhead(n) == DHDRY) then + ! -- cell should be made inactive + this%ibound(n) = 0 + call this%dis%noder_to_string(n, nodestr) + write (this%iout, fmtdry) trim(nodestr) + end if + end if + ! + ! -- Convert dry model cell to active if flow has rewet + if (this%ibound(n) == 0) then + if (this%gwfhead(n) /= DHDRY) then + ! -- cell is now wet + this%ibound(n) = 1 + call this%dis%noder_to_string(n, nodestr) + write (this%iout, fmtrewet) trim(nodestr) + end if + end if + end do + + end subroutine fmi_ad + + !> @brief Define the flow model interface + subroutine prtfmi_df(this, dis, idryinactive) + ! -- modules + use SimModule, only: store_error + ! -- dummy + class(PrtFmiType) :: this + class(DisBaseType), pointer, intent(in) :: dis + integer(I4B), intent(in) :: idryinactive + ! + ! -- Call parent class define + call this%FlowModelInterfaceType%fmi_df(dis, idryinactive) + ! + ! -- Allocate arrays + allocate (this%StorageFlows(this%dis%nodes)) ! kluge note: need allocate_arrays subroutine + allocate (this%SourceFlows(this%dis%nodes)) + allocate (this%SinkFlows(this%dis%nodes)) + allocate (this%BoundaryFlows(this%dis%nodes * 10)) ! kluge note: hardwired to max 8 polygon faces plus top and bottom for now + + end subroutine prtfmi_df + + !> @brief Accumulate flows + subroutine accumulate_flows(this) + use GwfDisvModule ! kluge??? + implicit none + ! -- dummy + class(PrtFmiType) :: this + ! -- local + integer :: j, i, ip, ib + integer :: ioffset, iflowface, iauxiflowface !, iface + double precision :: qbnd + character(len=LENAUXNAME) :: auxname + integer(I4B) :: naux + ! + this%StorageFlows = 0d0 + if (this%igwfstrgss /= 0) & + this%StorageFlows = this%StorageFlows + & + this%gwfstrgss + if (this%igwfstrgsy /= 0) & + this%StorageFlows = this%StorageFlows + & + this%gwfstrgsy + ! kluge note: need separate SourceFlows and SinkFlows? just for budget-reporting? + ! kluge note: SinkFlows used to identify weak sinks + this%SourceFlows = 0d0 + this%SinkFlows = 0d0 + this%BoundaryFlows = 0d0 + do ip = 1, this%nflowpack + iauxiflowface = 0 + naux = this%gwfpackages(ip)%naux + if (naux > 0) then + do j = 1, naux + auxname = this%gwfpackages(ip)%auxname(j) + if (trim(adjustl(auxname)) == "IFLOWFACE") then + iauxiflowface = j + exit + ! else if (trim(adjustl(auxname)) == "IFACE") then ! kluge note: allow IFACE and do conversion??? + ! iauxiflowface = -j + ! exit + end if + end do + end if + do ib = 1, this%gwfpackages(ip)%nbound + i = this%gwfpackages(ip)%nodelist(ib) + ! if (this%gwfibound(i) <= 0) cycle + if (this%ibound(i) <= 0) cycle + qbnd = this%gwfpackages(ip)%get_flow(ib) + iflowface = 0 ! kluge note: eventually have default iflowface values for different packages + if (iauxiflowface > 0) then + ! expected int here... ok to round?? + iflowface = NINT(this%gwfpackages(ip)%auxvar(iauxiflowface, ib)) + if (iflowface < 0) iflowface = iflowface + 11 ! bot -> 9, top -> 10; see note re: max faces below + ! else if (iauxiflowface < 0) then ! kluge note: allow IFACE and do conversion??? + ! ! kluge note: is it possible to check for a rectangular-celled grid here??? + ! iface = this%gwfpackages(ip)%auxvar(-iauxiflowface, ib) + ! iflowface = iface ! kluge note: will need to convert + end if + if (iflowface .gt. 0) then + ioffset = (i - 1) * 10 ! kluge note: hardwired for max 8 polygon faces plus top and bottom for now + this%BoundaryFlows(ioffset + iflowface) = & + this%BoundaryFlows(ioffset + iflowface) + qbnd + else if (qbnd .gt. 0d0) then + this%SourceFlows(i) = this%SourceFlows(i) + qbnd + else if (qbnd .lt. 0d0) then + this%SinkFlows(i) = this%SinkFlows(i) + qbnd + end if + end do + end do + + end subroutine accumulate_flows + +end module PrtFmiModule diff --git a/src/Model/ParticleTracking/prt-mip.f90 b/src/Model/ParticleTracking/prt-mip.f90 new file mode 100644 index 00000000000..bb587adff56 --- /dev/null +++ b/src/Model/ParticleTracking/prt-mip.f90 @@ -0,0 +1,150 @@ +module PrtMipModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DONE, LINELENGTH + use NumericalPackageModule, only: NumericalPackageType + use BlockParserModule, only: BlockParserType + use BaseDisModule, only: DisBaseType + use MemoryManagerModule, only: mem_allocate, mem_deallocate + use MemoryManagerExtModule, only: mem_set_value, memorylist_remove + use SimVariablesModule, only: idm_context + use SimModule, only: store_error + use PrtMipInputModule, only: PrtMipParamFoundType + + implicit none + private + public :: PrtMipType + public :: mip_cr + + type, extends(NumericalPackageType) :: PrtMipType + real(DP), dimension(:), pointer, contiguous :: porosity => null() !< aquifer porosity + real(DP), dimension(:), pointer, contiguous :: retfactor => null() !< retardation factor + integer(I4B), dimension(:), pointer, contiguous :: izone => null() !< zone number + integer(I4B), pointer :: zeromethod + contains + procedure :: mip_ar + procedure :: mip_da + procedure :: allocate_scalars + procedure, private :: allocate_arrays + end type PrtMipType + +contains + + !> @brief Create a model input object + subroutine mip_cr(mip, name_model, input_mempath, inunit, iout, dis) + ! -- dummy + type(PrtMipType), pointer :: mip + 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 :: fmtheader = & + "(1x, /1x, 'MIP -- MODEL INPUT PACKAGE', & + &' INPUT READ FROM MEMPATH: ', A, /)" + ! + ! -- Create the object + allocate (mip) + ! + ! -- Create name and memory path + call mip%set_names(1, name_model, 'MIP', 'MIP', input_mempath) + ! + ! -- Allocate scalars + call mip%allocate_scalars() + ! + ! -- Set variables + mip%inunit = inunit + mip%iout = iout + ! + ! -- Set pointers + mip%dis => dis + ! + ! -- Print a message identifying the package if enabled + if (inunit > 0) & + write (iout, fmtheader) input_mempath + + end subroutine mip_cr + + !> @brief Deallocate memory + subroutine mip_da(this) + class(PrtMipType) :: this + ! + ! -- Deallocate input memory + call memorylist_remove(this%name_model, 'MIP', idm_context) + ! + ! -- Deallocate parent package + call this%NumericalPackageType%da() + ! + ! -- Deallocate arrays + call mem_deallocate(this%porosity) + call mem_deallocate(this%retfactor) + call mem_deallocate(this%izone) + ! + ! -- Deallocate scalars + call mem_deallocate(this%zeromethod) + end subroutine mip_da + + subroutine allocate_scalars(this) + class(PrtMipType) :: this + call this%NumericalPackageType%allocate_scalars() + call mem_allocate(this%zeromethod, 'IZEROMETHOD', this%memoryPath) + end subroutine allocate_scalars + + !> @brief Allocate arrays + subroutine allocate_arrays(this, nodes) + class(PrtMipType) :: this + integer(I4B), intent(in) :: nodes + ! -- local + integer(I4B) :: i + ! + ! -- Allocate + call mem_allocate(this%porosity, nodes, 'POROSITY', this%memoryPath) + call mem_allocate(this%retfactor, nodes, 'RETFACTOR', this%memoryPath) + call mem_allocate(this%izone, nodes, 'IZONE', this%memoryPath) + ! + do i = 1, nodes + this%porosity(i) = DZERO + this%retfactor(i) = DONE + this%izone(i) = 0 + end do + + end subroutine allocate_arrays + + !> @ brief Initialize package inputs + subroutine mip_ar(this) + ! -- dummy variables + class(PrtMipType), intent(inout) :: this !< PrtMipType object + ! -- local variables + character(len=LINELENGTH) :: errmsg + type(PrtMipParamFoundType) :: found + integer(I4B), dimension(:), pointer, contiguous :: map => null() + ! + ! -- set map to convert user input data into reduced data + if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser + ! + ! -- Allocate arrays + call this%allocate_arrays(this%dis%nodes) + ! + ! -- Source array inputs from IDM + call mem_set_value(this%porosity, 'POROSITY', this%input_mempath, & + map, found%porosity) + call mem_set_value(this%retfactor, 'RETFACTOR', this%input_mempath, & + map, found%retfactor) + call mem_set_value(this%izone, 'IZONE', this%input_mempath, map, & + found%izone) + ! + ! -- Source scalars + call mem_set_value(this%zeromethod, 'ZERO_METHOD', this%input_mempath, & + found%zero_method) + if (.not. found%zero_method) this%zeromethod = 1 + ! + ! -- Ensure POROSITY was found + if (.not. found%porosity) then + write (errmsg, '(a)') 'Error in GRIDDATA block: POROSITY not found' + call store_error(errmsg) + end if + + end subroutine mip_ar + +end module PrtMipModule diff --git a/src/Model/ParticleTracking/prt-obs.f90 b/src/Model/ParticleTracking/prt-obs.f90 new file mode 100644 index 00000000000..b39beefa478 --- /dev/null +++ b/src/Model/ParticleTracking/prt-obs.f90 @@ -0,0 +1,235 @@ +module PrtObsModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: LINELENGTH, MAXOBSTYPES + use BaseDisModule, only: DisBaseType + use ObserveModule, only: ObserveType + use ObsModule, only: ObsType + use SimModule, only: count_errors, store_error, & + store_error_unit + implicit none + + private + public :: PrtObsType, prt_obs_cr + + type, extends(ObsType) :: PrtObsType + ! -- Private members + real(DP), dimension(:), pointer, contiguous, private :: x => null() !< concentration + real(DP), dimension(:), pointer, contiguous, private :: flowja => null() !< intercell flows + contains + ! -- Public procedures + procedure, public :: prt_obs_ar + procedure, public :: obs_bd => prt_obs_bd + procedure, public :: obs_df => prt_obs_df + procedure, public :: obs_rp => prt_obs_rp + procedure, public :: obs_da => prt_obs_da + ! -- Private procedures + procedure, private :: set_pointers + end type PrtObsType + +contains + + !> @brief Create a new PrtObsType object + subroutine prt_obs_cr(obs, inobs) + ! -- dummy + type(PrtObsType), pointer, intent(out) :: obs + integer(I4B), pointer, intent(in) :: inobs + ! + allocate (obs) + call obs%allocate_scalars() + obs%active = .false. + obs%inputFilename = '' + obs%inUnitObs => inobs + + end subroutine prt_obs_cr + + !> @brief Allocate and read + subroutine prt_obs_ar(this, x, flowja) + ! -- dummy + class(PrtObsType), intent(inout) :: this + 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() + ! + ! set pointers + call this%set_pointers(x, flowja) + + end subroutine prt_obs_ar + + !> @brief Define package + subroutine prt_obs_df(this, iout, pkgname, filtyp, dis) + ! -- dummy + class(PrtObsType), 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) + ! + ! -- StoreObsType arguments are: (ObserveType, cumulative, indx); + ! indx is returned. + ! + ! -- Store obs type and assign procedure pointer for head observation type + call this%StoreObsType('concentration', .false., indx) + this%obsData(indx)%ProcessIdPtr => prt_process_concentration_obs_id + ! + ! -- 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 => prt_process_intercell_obs_id + + end subroutine prt_obs_df + + !> @brief Save observations + subroutine prt_obs_bd(this) + ! -- dummy + class(PrtObsType), intent(inout) :: this + ! -- local + integer(I4B) :: i, jaindex, nodenumber + character(len=100) :: msg + class(ObserveType), pointer :: obsrv => null() + ! + call this%obs_bd_clear() + ! + ! -- iterate through all PRT observations + if (this%npakobs > 0) then + do i = 1, this%npakobs + obsrv => this%pakobs(i)%obsrv + nodenumber = obsrv%NodeNumber + jaindex = obsrv%JaIndex + select case (obsrv%ObsTypeId) + case ('CONCENTRATION') + call this%SaveOneSimval(obsrv, this%x(nodenumber)) + case ('FLOW-JA-FACE') + call this%SaveOneSimval(obsrv, this%flowja(jaindex)) + case default + msg = 'Error: Unrecognized observation type: '//trim(obsrv%ObsTypeId) + call store_error(msg) + call store_error_unit(this%inUnitObs) + end select + end do + end if + + end subroutine prt_obs_bd + + !> @brief Read and prepare + subroutine prt_obs_rp(this) + class(PrtObsType), intent(inout) :: this + ! Do PRT observations need any checking? If so, add checks here + end subroutine prt_obs_rp + + !> @brief Deallocate + subroutine prt_obs_da(this) + ! -- dummy + class(PrtObsType), intent(inout) :: this + ! + nullify (this%x) + nullify (this%flowja) + call this%ObsType%obs_da() + + end subroutine prt_obs_da + + !> @brief Set pointers + subroutine set_pointers(this, x, flowja) + ! -- dummy + class(PrtObsType), intent(inout) :: this + real(DP), dimension(:), pointer, contiguous, intent(in) :: x + real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja + ! + this%x => x + this%flowja => flowja + + end subroutine set_pointers + + ! -- Procedures related to GWF observations (NOT type-bound) + + subroutine prt_process_concentration_obs_id(obsrv, dis, inunitobs, iout) + ! -- dummy + type(ObserveType), intent(inout) :: obsrv + class(DisBaseType), intent(in) :: dis + integer(I4B), intent(in) :: inunitobs + integer(I4B), intent(in) :: iout + ! -- local + integer(I4B) :: nn1 + integer(I4B) :: icol, istart, istop + character(len=LINELENGTH) :: ermsg, strng + ! + ! -- Initialize variables + strng = obsrv%IDstring + icol = 1 + ! + ! Get node number, with option for ID string to be either node + ! number or lay, row, column (when dis is structured). + nn1 = dis%noder_from_string(icol, istart, istop, inunitobs, & + iout, strng, .false.) + ! + if (nn1 > 0) then + obsrv%NodeNumber = nn1 + else + ermsg = 'Error reading data from ID string' + call store_error(ermsg) + call store_error_unit(inunitobs) + end if + + end subroutine prt_process_concentration_obs_id + + subroutine prt_process_intercell_obs_id(obsrv, dis, inunitobs, iout) + ! -- dummy + type(ObserveType), intent(inout) :: obsrv + class(DisBaseType), intent(in) :: dis + integer(I4B), intent(in) :: inunitobs + integer(I4B), intent(in) :: iout + ! -- local + integer(I4B) :: nn1, nn2 + integer(I4B) :: icol, istart, istop, jaidx + character(len=LINELENGTH) :: ermsg, strng + ! formats +70 format('Error: No connection exists between cells identified in text: ', a) + ! + ! -- Initialize variables + strng = obsrv%IDstring + icol = 1 + ! + ! Get node number, with option for ID string to be either node + ! number or lay, row, column (when dis is structured). + nn1 = dis%noder_from_string(icol, istart, istop, inunitobs, & + iout, strng, .false.) + ! + if (nn1 > 0) then + obsrv%NodeNumber = nn1 + else + ermsg = 'Error reading data from ID string: '//strng(istart:istop) + call store_error(ermsg) + end if + ! + ! Get node number, with option for ID string to be either node + ! number or lay, row, column (when dis is structured). + nn2 = dis%noder_from_string(icol, istart, istop, inunitobs, & + iout, strng, .false.) + if (nn2 > 0) then + obsrv%NodeNumber2 = nn2 + else + ermsg = 'Error reading data from ID string: '//strng(istart:istop) + call store_error(ermsg) + end if + ! + ! -- store JA index + jaidx = dis%con%getjaindex(nn1, nn2) + if (jaidx == 0) then + write (ermsg, 70) trim(strng) + call store_error(ermsg) + end if + obsrv%JaIndex = jaidx + ! + if (count_errors() > 0) then + call store_error_unit(inunitobs) + end if + + end subroutine prt_process_intercell_obs_id + +end module PrtObsModule diff --git a/src/Model/ParticleTracking/prt-oc.f90 b/src/Model/ParticleTracking/prt-oc.f90 new file mode 100644 index 00000000000..5eabcc00c28 --- /dev/null +++ b/src/Model/ParticleTracking/prt-oc.f90 @@ -0,0 +1,376 @@ +module PrtOcModule + + use BaseDisModule, only: DisBaseType + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LENMODELNAME, MNORMAL + use OutputControlModule, only: OutputControlType + use OutputControlDataModule, only: OutputControlDataType, ocd_cr + use SimVariablesModule, only: errmsg, warnmsg + use MemoryManagerModule, only: mem_allocate, mem_deallocate, mem_reallocate + use MemoryHelperModule, only: create_mem_path + use ArrayHandlersModule, only: ExpandArray + use BlockParserModule, only: BlockParserType + use InputOutputModule, only: urword, openfile + use TimeSelectModule, only: TimeSelectType + + implicit none + private + public PrtOcType, oc_cr + + !> @ brief Output control for particle tracking models + type, extends(OutputControlType) :: PrtOcType + + integer(I4B), pointer :: itrkout => null() !< binary output file + integer(I4B), pointer :: itrkhdr => null() !< output header file + integer(I4B), pointer :: itrkcsv => null() !< CSV output file + integer(I4B), pointer :: itrktls => null() !< track time list input file + logical(LGP), pointer :: trackrelease => null() !< whether to track release events + logical(LGP), pointer :: tracktransit => null() !< whether to track cell transition events + logical(LGP), pointer :: tracktimestep => null() !< whether to track timestep events + logical(LGP), pointer :: trackterminate => null() !< whether to track termination events + logical(LGP), pointer :: trackweaksink => null() !< whether to track weak sink exit events + logical(LGP), pointer :: trackusertime => null() !< whether to track user-specified times + type(TimeSelectType), pointer :: tracktimes !< user-specified tracking times + + contains + procedure :: oc_ar + procedure :: oc_da => prt_oc_da + procedure :: allocate_scalars => prt_oc_allocate_scalars + procedure :: read_options => prt_oc_read_options + + end type PrtOcType + +contains + + !> @ brief Create an output control object + subroutine oc_cr(ocobj, name_model, inunit, iout) + type(PrtOcType), pointer :: ocobj !< PrtOcType 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 + + ! -- Create the object + allocate (ocobj) + + ! -- Allocate scalars + call ocobj%allocate_scalars(name_model) + + ! -- Save unit numbers + ocobj%inunit = inunit + ocobj%iout = iout + + ! -- Initialize block parser + call ocobj%parser%Initialize(inunit, iout) + end subroutine oc_cr + + subroutine prt_oc_allocate_scalars(this, name_model) + class(PrtOcType) :: this + character(len=*), intent(in) :: name_model !< name of model + + this%memoryPath = create_mem_path(name_model, 'OC') + + allocate (this%name_model) + call mem_allocate(this%inunit, 'INUNIT', this%memoryPath) + call mem_allocate(this%iout, 'IOUT', this%memoryPath) + call mem_allocate(this%ibudcsv, 'IBUDCSV', this%memoryPath) + call mem_allocate(this%iperoc, 'IPEROC', this%memoryPath) + call mem_allocate(this%iocrep, 'IOCREP', this%memoryPath) + call mem_allocate(this%itrkout, 'ITRKOUT', this%memoryPath) + call mem_allocate(this%itrkhdr, 'ITRKHDR', this%memoryPath) + call mem_allocate(this%itrkcsv, 'ITRKCSV', this%memoryPath) + call mem_allocate(this%itrktls, 'ITRKTLS', this%memoryPath) + call mem_allocate(this%trackrelease, 'ITRACKRLS', this%memoryPath) + call mem_allocate(this%tracktransit, 'ITRACKTRS', this%memoryPath) + call mem_allocate(this%tracktimestep, 'ITRACKTST', this%memoryPath) + call mem_allocate(this%trackterminate, 'ITRACKTER', this%memoryPath) + call mem_allocate(this%trackweaksink, 'ITRACKWSK', this%memoryPath) + call mem_allocate(this%trackusertime, 'ITRACKTLS', this%memoryPath) + + this%name_model = name_model + this%inunit = 0 + this%iout = 0 + this%ibudcsv = 0 + this%iperoc = 0 + this%iocrep = 0 + this%itrkout = 0 + this%itrkhdr = 0 + this%itrkcsv = 0 + this%itrktls = 0 + this%trackrelease = .false. + this%tracktransit = .false. + this%tracktimestep = .false. + this%trackterminate = .false. + this%trackweaksink = .false. + this%trackusertime = .false. + + end subroutine prt_oc_allocate_scalars + + !> @ brief Setup output control variables. + subroutine oc_ar(this, mass, dis, dnodata) + ! -- dummy + class(PrtOcType) :: this !< PrtOcType object + real(DP), dimension(:), pointer, contiguous, intent(in) :: mass !< particle mass + class(DisBaseType), pointer, intent(in) :: dis !< model discretization package + real(DP), intent(in) :: dnodata !< no data value + ! -- local + integer(I4B) :: i, nocdobj, inodata + type(OutputControlDataType), pointer :: ocdobjptr + real(DP), dimension(:), pointer, contiguous :: nullvec => null() + + ! -- Allocate and initialize variables + allocate (this%tracktimes) + call this%tracktimes%init() + inodata = 0 + nocdobj = 2 + allocate (this%ocdobj(nocdobj)) + do i = 1, nocdobj + call ocd_cr(ocdobjptr) + select case (i) + case (1) + call ocdobjptr%init_dbl('BUDGET', nullvec, dis, 'PRINT LAST ', & + 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', & + this%iout, dnodata) + case (2) + call ocdobjptr%init_dbl('MASS', mass, dis, 'PRINT LAST ', & + 'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', & + this%iout, dnodata) + end select + this%ocdobj(i) = ocdobjptr + deallocate (ocdobjptr) + end do + + ! -- Read options or set defaults if this package not on + if (this%inunit > 0) then + call this%read_options() + end if + end subroutine oc_ar + + subroutine prt_oc_da(this) + ! -- dummy + class(PrtOcType) :: this + ! -- local + integer(I4B) :: i + + call this%tracktimes%destroy() + + do i = 1, size(this%ocdobj) + call this%ocdobj(i)%ocd_da() + end do + deallocate (this%ocdobj) + + deallocate (this%name_model) + call mem_deallocate(this%inunit) + call mem_deallocate(this%iout) + call mem_deallocate(this%ibudcsv) + call mem_deallocate(this%iperoc) + call mem_deallocate(this%iocrep) + call mem_deallocate(this%itrkout) + call mem_deallocate(this%itrkhdr) + call mem_deallocate(this%itrkcsv) + call mem_deallocate(this%itrktls) + call mem_deallocate(this%trackrelease) + call mem_deallocate(this%tracktransit) + call mem_deallocate(this%tracktimestep) + call mem_deallocate(this%trackterminate) + call mem_deallocate(this%trackweaksink) + call mem_deallocate(this%trackusertime) + + end subroutine prt_oc_da + + subroutine prt_oc_read_options(this) + ! -- modules + use OpenSpecModule, only: access, form + use InputOutputModule, only: getunit, openfile, lowcase + use ConstantsModule, only: LINELENGTH + use TrackModule, only: TRACKHEADER, TRACKDTYPES + use SimModule, only: store_error, store_error_unit + use InputOutputModule, only: openfile, getunit + ! -- dummy + class(PrtOcType) :: this + ! -- local + character(len=LINELENGTH) :: keyword + character(len=LINELENGTH) :: keyword2 + character(len=LINELENGTH) :: fname + character(len=:), allocatable :: line + integer(I4B) :: i, ierr, ipos, ios, nlines + real(DP) :: dval + logical(LGP) :: isfound, found, endOfBlock, eventFound, success + type(OutputControlDataType), pointer :: ocdobjptr + ! -- formats + character(len=*), parameter :: fmttrkbin = & + "(4x, 'PARTICLE TRACKS WILL BE SAVED TO BINARY FILE: ', a, /4x, & + &'OPENED ON UNIT: ', I0)" + character(len=*), parameter :: fmttrkcsv = & + "(4x, 'PARTICLE TRACKS WILL BE SAVED TO CSV FILE: ', a, /4x, & + &'OPENED ON UNIT: ', I0)" + + ! -- 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 OC OPTIONS' + eventFound = .false. + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + found = .false. + select case (keyword) + case ('BUDGETCSV') + call this%parser%GetStringCaps(keyword2) + if (keyword2 /= 'FILEOUT') then + errmsg = "BUDGETCSV must be followed by FILEOUT and then budget & + &csv file name. Found '"//trim(keyword2)//"'." + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if + call this%parser%GetString(fname) + this%ibudcsv = GetUnit() + call openfile(this%ibudcsv, this%iout, fname, 'CSV', & + filstat_opt='REPLACE') + found = .true. + case ('TRACK') + call this%parser%GetStringCaps(keyword) + if (keyword == 'FILEOUT') then + ! parse filename + call this%parser%GetString(fname) + ! open binary track output file + this%itrkout = getunit() + call openfile(this%itrkout, this%iout, fname, 'DATA(BINARY)', & + form, access, filstat_opt='REPLACE', & + mode_opt=MNORMAL) + write (this%iout, fmttrkbin) trim(adjustl(fname)), this%itrkout + ! open and write ascii track header file + this%itrkhdr = getunit() + fname = trim(fname)//'.hdr' + call openfile(this%itrkhdr, this%iout, fname, 'CSV', & + filstat_opt='REPLACE', mode_opt=MNORMAL) + write (this%itrkhdr, '(a,/,a)') TRACKHEADER, TRACKDTYPES + else + call store_error('OPTIONAL TRACK KEYWORD MUST BE '// & + 'FOLLOWED BY FILEOUT') + end if + found = .true. + case ('TRACKCSV') + call this%parser%GetStringCaps(keyword) + if (keyword == 'FILEOUT') then + ! parse filename + call this%parser%GetString(fname) + ! open CSV track output file and write headers + this%itrkcsv = getunit() + call openfile(this%itrkcsv, this%iout, fname, 'CSV', & + filstat_opt='REPLACE') + write (this%iout, fmttrkcsv) trim(adjustl(fname)), this%itrkcsv + write (this%itrkcsv, '(a)') TRACKHEADER + else + call store_error('OPTIONAL TRACKCSV KEYWORD MUST BE & + &FOLLOWED BY FILEOUT') + end if + found = .true. + case ('TRACK_ALL') + eventFound = .false. ! defaults set below + found = .true. + case ('TRACK_RELEASE') + this%trackrelease = .true. + eventFound = .true. + found = .true. + case ('TRACK_TRANSIT') + this%tracktransit = .true. + eventFound = .true. + found = .true. + case ('TRACK_TIMESTEP') + this%tracktimestep = .true. + eventFound = .true. + found = .true. + case ('TRACK_TERMINATE') + this%trackterminate = .true. + eventFound = .true. + found = .true. + case ('TRACK_WEAKSINK') + this%trackweaksink = .true. + eventFound = .true. + found = .true. + case ('TRACK_USERTIME') + this%trackusertime = .true. + eventFound = .true. + found = .true. + case ('TRACK_TIMES') + ttloop: do + success = .false. + call this%parser%TryGetDouble(dval, success) + if (.not. success) exit ttloop + call this%tracktimes%expand() + this%tracktimes%times(size(this%tracktimes%times)) = dval + end do ttloop + if (.not. this%tracktimes%increasing()) then + errmsg = "TRACK TIMES MUST STRICTLY INCREASE" + call store_error(errmsg) + call this%parser%StoreErrorUnit(terminate=.true.) + end if + this%trackusertime = .true. + found = .true. + case ('TRACK_TIMESFILE') + call this%parser%GetString(fname) + call openfile(this%itrktls, this%iout, fname, 'TLS') + nlines = 0 + ttfloop: do + read (this%itrktls, '(A)', iostat=ios) line + if (ios /= 0) exit ttfloop + nlines = nlines + 1 + end do ttfloop + call this%tracktimes%expand(nlines) + rewind (this%itrktls) + allocate (character(len=LINELENGTH) :: line) + do i = 1, nlines + read (this%itrktls, '(A)') line + read (line, '(f30.0)') dval + this%tracktimes%times(i) = dval + end do + if (.not. this%tracktimes%increasing()) then + errmsg = "TRACK TIMES MUST STRICTLY INCREASE" + call store_error(errmsg) + call this%parser%StoreErrorUnit(terminate=.true.) + end if + this%trackusertime = .true. + found = .true. + case default + found = .false. + end select + + ! -- check if we're done + if (.not. found) then + do ipos = 1, size(this%ocdobj) + ocdobjptr => this%ocdobj(ipos) + if (keyword == trim(ocdobjptr%cname)) then + found = .true. + exit + end if + end do + if (.not. found) then + errmsg = "UNKNOWN OC OPTION '"//trim(keyword)//"'." + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if + call this%parser%GetRemainingLine(line) + call ocdobjptr%set_option(line, this%parser%iuactive, this%iout) + end if + end do + + ! -- default to all events + if (.not. eventFound) then + this%trackrelease = .true. + this%tracktransit = .true. + this%tracktimestep = .true. + this%trackterminate = .true. + this%trackweaksink = .true. + this%trackusertime = .true. + end if + + ! -- logging + write (this%iout, '(1x,a)') 'END OF OC OPTIONS' + end if + end subroutine prt_oc_read_options + +end module PrtOcModule diff --git a/src/Model/ParticleTracking/prt-prp.f90 b/src/Model/ParticleTracking/prt-prp.f90 new file mode 100644 index 00000000000..eb7c60e14a7 --- /dev/null +++ b/src/Model/ParticleTracking/prt-prp.f90 @@ -0,0 +1,984 @@ +module PrtPrpModule + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, LINELENGTH, & + LENBOUNDNAME, LENPAKLOC, TABLEFT, TABCENTER, & + MNORMAL + use BndModule, only: BndType + use ObsModule, only: DefaultObsIdProcessor + use TableModule, only: TableType, table_cr + use TimeSeriesModule, only: TimeSeriesType + use TimeSeriesRecordModule, only: TimeSeriesRecordType + use TimeSeriesLinkModule, only: TimeSeriesLinkType, & + GetTimeSeriesLinkFromList + use BlockParserModule, only: BlockParserType + use PrtFmiModule, only: PrtFmiType + use ParticleModule, only: ParticleType, ParticleStoreType, & + create_particle, create_particle_store + use SimModule, only: count_errors, store_error, store_error_unit, & + store_warning + use SimVariablesModule, only: errmsg, warnmsg + use TrackModule, only: TrackFileControlType + use GeomUtilModule, only: point_in_polygon, get_ijk, get_jk + use MemoryManagerModule, only: mem_allocate, mem_deallocate, & + mem_reallocate + use TimeSelectModule, only: TimeSelectType + + implicit none + + private + public :: PrtPrpType + public :: prp_create + + character(len=LENFTYPE) :: ftype = 'PRP' + character(len=16) :: text = ' PRP' + + !> @brief Particle release point (PRP) package + type, extends(BndType) :: PrtPrpType + type(PrtFmiType), pointer :: fmi => null() !< flow model interface + type(ParticleStoreType), pointer :: particles => null() !< particle store + type(TrackFileControlType), pointer :: trackfilectl => null() !< track file control + integer(I4B), pointer :: nreleasepts => null() !< number of release points + integer(I4B), pointer :: nparticles => null() !< number of particles released + integer(I4B), pointer :: istopweaksink => null() !< weak sink option: 0 = no stop, 1 = stop + integer(I4B), pointer :: istopzone => null() !< optional stop zone number: 0 = no stop zone + integer(I4B), pointer :: idrape => null() !< drape option: 0 = do not drape, 1 = drape to topmost active cell + integer(I4B), pointer :: itrkout => null() !< binary track file + integer(I4B), pointer :: itrkhdr => null() !< track header file + integer(I4B), pointer :: itrkcsv => null() !< CSV track file + integer(I4B), pointer :: irlstls => null() !< release time file + logical(LGP), pointer :: rlsall => null() !< release in all time step + logical(LGP), pointer :: rlsfirst => null() !< release in first time step + logical(LGP), pointer :: rlstimelist => null() !< use global release time + real(DP), pointer :: offset => null() !< release time offset + real(DP), pointer :: stoptime => null() !< stop time for all release points + real(DP), pointer :: stoptraveltime => null() !< stop travel time for all points + integer(I4B), pointer, contiguous :: rlskstp(:) !< time steps selected for release + integer(I4B), pointer, contiguous :: rptnode(:) => null() !< release point reduced nns + integer(I4B), pointer, contiguous :: rptzone(:) => null() !< release point zone numbers + real(DP), pointer, contiguous :: rptx(:) => null() !< release point x coordinates + real(DP), pointer, contiguous :: rpty(:) => null() !< release point y coordinates + real(DP), pointer, contiguous :: rptz(:) => null() !< release point z coordinates + real(DP), pointer, contiguous :: rptmass(:) => null() !< total mass released from point + character(len=LENBOUNDNAME), pointer, contiguous :: rptname(:) => null() !< release point names + type(TimeSelectType), pointer :: releasetimes + + contains + procedure :: prp_allocate_arrays + procedure :: prp_allocate_scalars + procedure :: bnd_ar => prp_ar + procedure :: bnd_ad => prp_ad + procedure :: bnd_rp => prp_rp + procedure :: bnd_cq_simrate => prp_cq_simrate + procedure :: bnd_da => prp_da + procedure :: define_listlabel + procedure :: prp_set_pointers + procedure :: bnd_options => prp_options + procedure :: read_dimensions => prp_read_dimensions + procedure :: prp_read_packagedata + procedure, public :: bnd_obs_supported => prp_obs_supported + procedure, public :: bnd_df_obs => prp_df_obs + end type PrtPrpType + +contains + + !> @brief Create a new particle release point package + subroutine prp_create(packobj, id, ibcnum, inunit, iout, namemodel, & + pakname, mempath, fmi) + ! -- dummy + class(BndType), pointer :: packobj + integer(I4B), intent(in) :: id + integer(I4B), intent(in) :: ibcnum + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + character(len=*), intent(in) :: namemodel + character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath + type(PrtFmiType), pointer :: fmi + ! -- local + type(PrtPrpType), pointer :: prpobj + ! -- formats + character(len=*), parameter :: fmtheader = & + "(1x, /1x, 'PRP -- PARTICLE RELEASE POINT PACKAGE', & + &' INPUT READ FROM MEMPATH: ', A, /)" + + ! -- allocate the object and assign values to object variables + allocate (prpobj) + packobj => prpobj + + ! -- create name and memory path + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) + prpobj%text = text + + ! -- allocate scalars + call prpobj%prp_allocate_scalars() + + ! -- initialize package + call packobj%pack_initialize() + + packobj%inunit = inunit + packobj%iout = iout + packobj%id = id + packobj%ibcnum = ibcnum + packobj%ncolbnd = 4 + packobj%iscloc = 1 + + ! -- store pointer to flow model interface + prpobj%fmi => fmi + + ! -- if prp is enabled, print a message identifying it + if (inunit > 0) write (iout, fmtheader) mempath + end subroutine prp_create + + !> @brief Deallocate memory + subroutine prp_da(this) + class(PrtPrpType) :: this + + ! -- deallocate parent + call this%BndType%bnd_da() + + ! -- deallocate scalars + call mem_deallocate(this%rlsall) + call mem_deallocate(this%rlsfirst) + call mem_deallocate(this%rlstimelist) + call mem_deallocate(this%offset) + call mem_deallocate(this%stoptime) + call mem_deallocate(this%stoptraveltime) + call mem_deallocate(this%istopweaksink) + call mem_deallocate(this%istopzone) + call mem_deallocate(this%idrape) + call mem_deallocate(this%nreleasepts) + call mem_deallocate(this%nparticles) + call mem_deallocate(this%itrkout) + call mem_deallocate(this%itrkhdr) + call mem_deallocate(this%itrkcsv) + call mem_deallocate(this%irlstls) + + ! -- deallocate arrays + call mem_deallocate(this%rptx) + call mem_deallocate(this%rpty) + call mem_deallocate(this%rptz) + call mem_deallocate(this%rptnode) + call mem_deallocate(this%rptmass) + call mem_deallocate(this%rlskstp) + call mem_deallocate(this%rptname, 'RPTNAME', this%memoryPath) + + ! -- deallocate particle store + call this%particles%destroy(this%memoryPath) + deallocate (this%particles) + + ! -- deallocate release time selection + call this%releasetimes%destroy() + deallocate (this%releasetimes) + end subroutine prp_da + + !> @ brief Set pointers to model variables + subroutine prp_set_pointers(this, ibound, izone, trackfilectl) + ! -- dummy variables + class(PrtPrpType) :: this + integer(I4B), dimension(:), pointer, contiguous :: ibound + integer(I4B), dimension(:), pointer, contiguous :: izone + type(TrackFileControlType), pointer :: trackfilectl + + this%ibound => ibound + this%rptzone => izone + this%trackfilectl => trackfilectl + end subroutine prp_set_pointers + + !> @brief Allocate arrays + subroutine prp_allocate_arrays(this, nodelist, auxvar) + ! -- dummy + class(PrtPrpType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + ! -- local + integer(I4B) :: nps + + ! -- Allocate particle store, starting with the number + ! of release points (arrays resized if/when needed) + call create_particle_store(this%particles, this%nreleasepts, this%memoryPath) + + ! -- Allocate arrays + call mem_allocate(this%rptx, this%nreleasepts, 'RPTX', this%memoryPath) + call mem_allocate(this%rpty, this%nreleasepts, 'RPTY', this%memoryPath) + call mem_allocate(this%rptz, this%nreleasepts, 'RPTZ', this%memoryPath) + call mem_allocate(this%rptmass, this%nreleasepts, 'RPTMASS', this%memoryPath) + call mem_allocate(this%rptnode, this%nreleasepts, 'RPTNODER', & + this%memoryPath) + call mem_allocate(this%rlskstp, 1, 'RLSKSTP', this%memoryPath) + call mem_allocate(this%rptname, LENBOUNDNAME, this%nreleasepts, & + 'RPTNAME', this%memoryPath) + + ! -- Initialize arrays + this%rlskstp(1) = 1 ! single release in first time step by default + do nps = 1, this%nreleasepts + this%rptmass(nps) = DZERO + end do + end subroutine prp_allocate_arrays + + !> @brief Allocate scalars + subroutine prp_allocate_scalars(this) + class(PrtPrpType) :: this + + ! -- Allocate release time selection + allocate (this%releasetimes) + call this%releasetimes%init() + + ! -- call standard BndType allocate scalars + call this%BndType%allocate_scalars() + + ! -- Allocate scalars for this type + call mem_allocate(this%rlsall, 'RLSALL', this%memoryPath) + call mem_allocate(this%rlsfirst, 'RLSFIRST', this%memoryPath) + call mem_allocate(this%rlstimelist, 'RELEASETIME', this%memoryPath) + call mem_allocate(this%offset, 'OFFSET', this%memoryPath) + call mem_allocate(this%stoptime, 'STOPTIME', this%memoryPath) + call mem_allocate(this%stoptraveltime, 'STOPTRAVELTIME', this%memoryPath) + call mem_allocate(this%istopweaksink, 'ISTOPWEAKSINK', this%memoryPath) + call mem_allocate(this%istopzone, 'ISTOPZONE', this%memoryPath) + call mem_allocate(this%idrape, 'IDRAPE', this%memoryPath) + call mem_allocate(this%nreleasepts, 'NRELEASEPTS', this%memoryPath) + call mem_allocate(this%nparticles, 'NPART', this%memoryPath) + call mem_allocate(this%itrkout, 'ITRKOUT', this%memoryPath) + call mem_allocate(this%itrkhdr, 'ITRKHDR', this%memoryPath) + call mem_allocate(this%itrkcsv, 'ITRKCSV', this%memoryPath) + call mem_allocate(this%irlstls, 'IRLSTLS', this%memoryPath) + + ! -- Set values + this%rlsall = .false. + this%rlsfirst = .false. + this%rlstimelist = .false. + this%offset = DZERO + this%stoptime = huge(1d0) + this%stoptraveltime = huge(1d0) + this%istopweaksink = 0 + this%istopzone = 0 + this%idrape = 0 + this%nreleasepts = 0 + this%nparticles = 0 + this%itrkout = 0 + this%itrkhdr = 0 + this%itrkcsv = 0 + this%irlstls = 0 + end subroutine prp_allocate_scalars + + !> @ brief Allocate and read period data + subroutine prp_ar(this) + ! -- dummy variables + class(PrtPrpType), intent(inout) :: this + ! -- local variables + integer(I4B) :: n + + call this%obs%obs_ar() + call this%BndType%allocate_arrays() + if (this%inamedbound /= 0) then + do n = 1, this%nreleasepts + this%boundname(n) = this%rptname(n) + end do + end if + do n = 1, this%nreleasepts + this%nodelist(n) = this%rptnode(n) + end do + ! if (this%imover /= 0) then + ! allocate(this%pakmvrobj) + ! call this%pakmvrobj%ar(this%maxbound, this%maxbound, this%memoryPath) + ! endif + end subroutine prp_ar + + !> @brief Advance a time step and release particles if appropriate. + !! + !! Releases may be scheduled via a global RELEASETIME, or within a + !! stress period via ALL, FIRST, FREQUENCY or STEPS (with optional + !! FRACTION). If no release option is specified, a single release + !! is conducted at the first moment of the first time step of the + !! first stress period. + !< + subroutine prp_ad(this) + ! -- modules + use TdisModule, only: totimc, delt, kstp + use GwfDisModule, only: GwfDisType + use GwfDisvModule, only: GwfDisvType + ! -- dummy + class(PrtPrpType) :: this + ! -- local + character(len=LINELENGTH) :: errmsg + integer(I4B) :: ic, icu, nps, nts, nrel, & + nreleasets, np, irow, icol, ilay, icpl + real(DP) :: x, y, z, trelease, tend + real(DP), allocatable :: polyverts(:, :) + type(ParticleType), pointer :: particle + + ! -- Check if there's a release to make + if (.not. ( & + ! all time steps? + this%rlsall .or. & + ! first time step? + (this%rlsfirst .and. kstp == 1) .or. & + ! specified time steps? + any(this%rlskstp == kstp) .or. & + ! specified release times? + this%rlstimelist)) return + + if (this%rlstimelist) then + nreleasets = size(this%releasetimes%times) + else + nreleasets = 1 + end if + nrel = this%nreleasepts * nreleasets + + ! -- Reset mass release for time step + do nps = 1, this%nreleasepts + this%rptmass(nps) = DZERO + end do + + ! -- Resize particle store if another set + ! of particles will exceed its capacity + if ((this%nparticles + nrel) > size(this%particles%irpt)) & + call this%particles%resize( & + size(this%particles%irpt) + nrel, & + this%memoryPath) + + ! -- Release a particle from each point... + do nps = 1, this%nreleasepts + ic = this%rptnode(nps) + icu = this%dis%get_nodeuser(ic) + ! -- ...for each release time in the current time step + tsloop: do nts = 1, nreleasets + if (this%rlstimelist) then + trelease = this%releasetimes%times(nts) + tend = totimc + delt + if (trelease < totimc .or. trelease >= tend) cycle tsloop + else + trelease = totimc + this%offset * delt + end if + + np = this%nparticles + 1 + this%nparticles = np + + ! -- Check release point is within the specified cell + ! and not above/below grid top/bottom respectively + x = this%rptx(nps) + y = this%rpty(nps) + z = this%rptz(nps) + call this%dis%get_polyverts(ic, polyverts) + if (.not. point_in_polygon(x, y, polyverts)) then + write (errmsg, '(a,g0,a,g0,a,i0)') & + 'Error: release point (x=', x, ', y=', y, ') is not in cell ', icu + call store_error(errmsg, terminate=.false.) + call store_error_unit(this%inunit, terminate=.true.) + end if + if (z > maxval(this%dis%top)) then + write (errmsg, '(a,g0,a,g0,a,i0)') & + 'Error: release point (z=', z, ') is above grid top ', & + maxval(this%dis%top) + call store_error(errmsg, terminate=.false.) + call store_error_unit(this%inunit, terminate=.true.) + else if (z < minval(this%dis%bot)) then + write (errmsg, '(a,g0,a,g0,a,i0)') & + 'Error: release point (z=', z, ') is below grid bottom ', & + minval(this%dis%bot) + call store_error(errmsg, terminate=.false.) + call store_error_unit(this%inunit, terminate=.true.) + end if + + ! -- Initialize particle and add it to particle store + ! -- Todo: branch depending on exchange PRP or a normal PRP. + ! if exchange PRP, particle identity properties should be + ! passed in (e.g. imdl, iprp, irpt, trelease, name). + ! if normal PRP, imdl and iprp should be set from pointers + ! provided to PRP by PRT model; irpt and trelease as below. + allocate (particle) + call create_particle(particle) + if (size(this%boundname) /= 0) then + particle%name = this%boundname(nps) + else + particle%name = '' + end if + particle%irpt = nps + particle%istopweaksink = this%istopweaksink + particle%istopzone = this%istopzone + particle%icu = icu + select type (dis => this%dis) + type is (GwfDisType) + call get_ijk(icu, dis%nrow, dis%ncol, dis%nlay, irow, icol, ilay) + type is (GwfDisvType) + call get_jk(icu, dis%ncpl, dis%nlay, icpl, ilay) + end select + particle%ilay = ilay + particle%izone = this%rptzone(ic) + particle%istatus = 0 + ! Handle inactive cells + if (this%ibound(ic) == 0) then + ! -- If drape option activated, release in highest active + ! cell vertically below release point. + if (this%idrape /= 0) & + call this%dis%highest_active(ic, this%ibound) + ! -- If returned cell is inactive, do not release particle + if (this%ibound(ic) == 0) & + particle%istatus = 8 ! permanently unreleased + end if + particle%x = x + particle%y = y + particle%z = this%rptz(nps) + particle%trelease = trelease + ! Set stopping time to earlier of times specified by STOPTIME and STOPTRAVELTIME + if (this%stoptraveltime == huge(1d0)) then + particle%tstop = this%stoptime + else + particle%tstop = particle%trelease + this%stoptraveltime + if (this%stoptime < particle%tstop) particle%tstop = this%stoptime + end if + particle%ttrack = particle%trelease + particle%idomain(0) = 0 + particle%iboundary(0) = 0 + particle%idomain(1) = 0 + particle%iboundary(1) = 0 + particle%idomain(2) = ic + particle%iboundary(2) = 0 + particle%idomain(3) = 0 + particle%iboundary(3) = 0 + call this%particles%load_from_particle(particle, np) + + ! -- Accumulate mass release from this point + this%rptmass(nps) = this%rptmass(nps) + DONE + end do tsloop + end do + end subroutine prp_ad + + !> @ brief Read and prepare period data for particle input + subroutine prp_rp(this) + ! -- modules + use TdisModule, only: kper, nper, nstp + use InputOutputModule, only: urword + ! -- dummy variables + class(PrtPrpType), intent(inout) :: this + ! -- local variables + integer(I4B) :: ierr + integer(I4B) :: n, i + integer(I4B) :: lloc, istart, istop, ival + real(DP) :: dval + logical(LGP) :: isfound + logical(LGP) :: endOfBlock + logical(LGP) :: use_last + logical(LGP) :: noperiodblocks + character(len=LINELENGTH) :: keyword + character(len=:), allocatable :: line + ! -- formats + character(len=*), parameter :: fmtblkerr = & + "('Looking for BEGIN PERIOD iper. & + &Found ', a, ' instead.')" + character(len=*), parameter :: fmt_steps = & + "(6x,'TIME STEP(S) ',50(I0,' '))" ! kluge 50 (similar to STEPS in OC)? + character(len=*), parameter :: fmt_freq = & + "(6x,'EVERY ',I0,' TIME STEP(S)')" + character(len=*), parameter :: fmt_fracs = & + "(6x,50(f10.3,' '))" + + ! -- 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 + noperiodblocks = .false. + if (this%ionper < kper) then + ! -- get period block + call this%parser%GetBlock('PERIOD', isfound, ierr, & + supportOpenClose=.true., & + 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 + if (kper == 1) then + ! -- End of file found; no period data for the simulation. + noperiodblocks = .true. + else + ! -- End of file found; no more period data. + this%ionper = nper + 1 + end if + else + ! -- Found invalid block + call this%parser%GetCurrentLine(line) + write (errmsg, fmtblkerr) adjustl(trim(line)) + call store_error(errmsg, terminate=.TRUE.) + end if + end if + end if + + ! -- If no period data for the simulation default to single + ! release at beginning of first period's first time step. + ! Otherwise read release timing settings from the period + ! data block of the package input file. + if (noperiodblocks) then + if (kper == 1) then + call mem_reallocate(this%rlskstp, 1, & + "RLSKSTP", this%memoryPath) + this%rlsfirst = .true. + use_last = .false. + end if + ! -- If the current stress period matches the + ! block we are reading continue parsing it + else if (this%ionper == kper) then + use_last = .false. + recordloop: do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('ALL') + this%rlsall = .true. + case ('STEPS') + call mem_reallocate(this%rlskstp, 0, & + "RLSKSTP", this%memoryPath) + call this%parser%GetRemainingLine(line) + lloc = 1 + stepslistsearch: do + call urword(line, lloc, istart, istop, 2, ival, dval, -1, 0) + if (ival > 0) then + n = size(this%rlskstp) + call mem_reallocate(this%rlskstp, n + 1, & + 'RLSKSTP', this%memoryPath) + this%rlskstp(n + 1) = ival + cycle stepslistsearch + end if + exit stepslistsearch + end do stepslistsearch + case ('FIRST') + this%rlsfirst = .true. + case ('FREQUENCY') + ival = this%parser%GetInteger() + if (ival < 0) then + errmsg = "FREQUENCY must be non-negative" + call store_error(errmsg) + call this%parser%StoreErrorUnit(terminate=.true.) + end if + do i = 1, nstp(this%ionper) + if (mod(i, ival) == 0) then + n = size(this%rlskstp) + call mem_reallocate(this%rlskstp, n + 1, & + 'RLSKSTP', this%memoryPath) + this%rlskstp(n + 1) = i + end if + end do + case ('FRACTION') + dval = this%parser%GetDouble() + this%offset = dval + case default + write (errmsg, '(2a)') & + 'Looking for ALL, STEPS, FIRST, FREQUENCY, or FRACTION. Found: ', & + trim(adjustl(keyword)) + call store_error(errmsg, terminate=.TRUE.) + end select + end do recordloop + else + ! -- else repeat period settings + use_last = .true. + end if + + ! -- write settings to list file + if (.not. any(this%rlskstp > 0)) then + write (this%iout, "(1x,/1x,a)") 'NO PARTICLE RELEASES IN THIS STRESS '// & + 'PERIOD' + else if (use_last) then + write (this%iout, "(1x,/1x,a)") 'REUSING PARTICLE RELEASE SETTINGS '// & + 'FROM LAST STRESS PERIOD' + else + ! -- write particle release setting + write (this%iout, "(1x,/1x,a)", advance='no') 'PARTICLE RELEASE:' + if (any(this%rlskstp > 0)) then + n = size(this%rlskstp) + if (n > 0) write (this%iout, fmt_steps, advance='no') this%rlskstp + end if + write (this%iout, "(1x,a)", advance='no') 'AT OFFSET' + write (this%iout, fmt_fracs) (/this%offset/) + write (this%iout, '(A)') + end if + end subroutine prp_rp + + !> @ brief Calculate flow between package and model. + subroutine prp_cq_simrate(this, hnew, flowja, imover) + ! -- modules + use TdisModule, only: delt + ! -- dummy variables + class(PrtPrpType) :: this + real(DP), dimension(:), intent(in) :: hnew !< todo: mass concentration? + real(DP), dimension(:), intent(inout) :: flowja !< flow between package and model + integer(I4B), intent(in) :: imover !< flag indicating if the mover package is active + ! -- local variables + integer(I4B) :: i + integer(I4B) :: node + integer(I4B) :: idiag + real(DP) :: rrate + + ! -- If no boundaries, skip flow calculations. + if (this%nbound <= 0) return + + ! -- Loop through each boundary calculating flow. + do i = 1, this%nbound + node = this%nodelist(i) + rrate = DZERO + ! -- If cell is no-flow or constant-head, then ignore it. + ! todo: think about condition(s) under which to ignore cell + if (node > 0) then + idiag = this%dis%con%ia(node) + ! todo: think about condition(s) under which to ignore cell + ! -- Calculate the flow rate into the cell. + rrate = this%rptmass(i) * (DONE / delt) ! reciprocal of tstp length + flowja(idiag) = flowja(idiag) + rrate + end if + + ! -- Save simulated value to simvals array. + this%simvals(i) = rrate + end do + end subroutine prp_cq_simrate + + !> @ brief Define list heading written with PRINT_INPUT option + subroutine define_listlabel(this) ! kluge note: update for PRT? + class(PrtPrpType), intent(inout) :: this + + ! -- create the header list label + this%listlabel = trim(this%filtyp)//' NO.' + if (this%dis%ndim == 3) then + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL' + elseif (this%dis%ndim == 2) then + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D' + else + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE' + end if + write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STRESS RATE' + if (this%inamedbound == 1) then + write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' + end if + end subroutine define_listlabel + + !> @brief Indicates whether observations are supported. + logical function prp_obs_supported(this) + class(PrtPrpType) :: this + prp_obs_supported = .true. + end function prp_obs_supported + + !> @brief Store supported observations + subroutine prp_df_obs(this) + ! -- dummy + class(PrtPrpType) :: this + ! -- local + integer(I4B) :: indx + call this%obs%StoreObsType('prp', .true., indx) + this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor + + ! -- Store obs type and assign procedure pointer + ! for to-mvr observation type. + call this%obs%StoreObsType('to-mvr', .true., indx) + this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor + end subroutine prp_df_obs + + !> @brief Set options specific to PrtPrpType + subroutine prp_options(this, option, found) + use OpenSpecModule, only: access, form + use ConstantsModule, only: MAXCHARLEN, DZERO + use InputOutputModule, only: urword, getunit, openfile + use TrackModule, only: TRACKHEADER, TRACKDTYPES + ! -- dummy + class(PrtPrpType), intent(inout) :: this + character(len=*), intent(inout) :: option + logical, intent(inout) :: found + ! -- locals + real(DP) :: dval + integer(I4B) :: i, ios, nlines + logical(LGP) :: success + character(len=MAXCHARLEN) :: fname + character(len=MAXCHARLEN) :: keyword + character(len=:), allocatable :: line + ! -- formats + character(len=*), parameter :: fmttrkbin = & + "(4x, 'PARTICLE TRACKS WILL BE SAVED TO BINARY FILE: ', a, /4x, & + &'OPENED ON UNIT: ', I0)" + character(len=*), parameter :: fmttrkcsv = & + "(4x, 'PARTICLE TRACKS WILL BE SAVED TO CSV FILE: ', a, /4x, & + &'OPENED ON UNIT: ', I0)" + + select case (option) + case ('STOPTIME') + this%stoptime = this%parser%GetDouble() + found = .true. + case ('STOPTRAVELTIME') + this%stoptraveltime = this%parser%GetDouble() + found = .true. + case ('STOP_AT_WEAK_SINK') + this%istopweaksink = 1 + found = .true. + case ('ISTOPZONE') + this%istopzone = this%parser%GetInteger() + found = .true. + case ('DRAPE') + this%idrape = 1 + found = .true. + case ('RELEASE_TIMES') + rtloop: do + success = .false. + call this%parser%TryGetDouble(dval, success) + if (.not. success) exit rtloop + call this%releasetimes%expand() + this%releasetimes%times(size(this%releasetimes%times)) = dval + end do rtloop + if (.not. this%releasetimes%increasing()) then + errmsg = "RELEASE TIMES MUST STRICTLY INCREASE" + call store_error(errmsg) + call this%parser%StoreErrorUnit(terminate=.true.) + end if + this%rlstimelist = .true. + found = .true. + case ('RELEASE_TIMESFILE') + call this%parser%GetString(fname) + call openfile(this%irlstls, this%iout, fname, 'TLS') + nlines = 0 + rtfloop: do + read (this%irlstls, '(A)', iostat=ios) line + if (ios /= 0) exit rtfloop + nlines = nlines + 1 + end do rtfloop + call this%releasetimes%expand(nlines) + rewind (this%irlstls) + allocate (character(len=LINELENGTH) :: line) + do i = 1, nlines + read (this%irlstls, '(A)') line + read (line, '(f30.0)') dval + this%releasetimes%times(i) = dval + end do + if (.not. this%releasetimes%increasing()) then + errmsg = "RELEASE TIMES MUST STRICTLY INCREASE" + call store_error(errmsg) + call this%parser%StoreErrorUnit(terminate=.true.) + end if + this%rlstimelist = .true. + found = .true. + case ('TRACK') + call this%parser%GetStringCaps(keyword) + if (keyword == 'FILEOUT') then + ! parse filename + call this%parser%GetString(fname) + ! open binary output file + this%itrkout = getunit() + call openfile(this%itrkout, this%iout, fname, 'DATA(BINARY)', & + form, access, filstat_opt='REPLACE', & + mode_opt=MNORMAL) + write (this%iout, fmttrkbin) trim(adjustl(fname)), this%itrkout + ! open and write ascii header spec file + this%itrkhdr = getunit() + fname = trim(fname)//'.hdr' + call openfile(this%itrkhdr, this%iout, fname, 'CSV', & + filstat_opt='REPLACE', mode_opt=MNORMAL) + write (this%itrkhdr, '(a,/,a)') TRACKHEADER, TRACKDTYPES + else + call store_error('OPTIONAL TRACK KEYWORD MUST BE '// & + 'FOLLOWED BY FILEOUT') + end if + found = .true. + case ('TRACKCSV') + call this%parser%GetStringCaps(keyword) + if (keyword == 'FILEOUT') then + ! parse filename + call this%parser%GetString(fname) + ! open CSV output file and write headers + this%itrkcsv = getunit() + call openfile(this%itrkcsv, this%iout, fname, 'CSV', & + filstat_opt='REPLACE') + write (this%iout, fmttrkcsv) trim(adjustl(fname)), this%itrkcsv + write (this%itrkcsv, '(a)') TRACKHEADER + else + call store_error('OPTIONAL TRACKCSV KEYWORD MUST BE & + &FOLLOWED BY FILEOUT') + end if + found = .true. + case default + found = .false. + end select + end subroutine prp_options + + !> @brief Read the packagedata for this package + subroutine prp_read_packagedata(this) + ! -- dummy + class(PrtPrpType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: cellid + character(len=LENBOUNDNAME) :: bndName, bndNameTemp + character(len=9) :: cno + logical :: isfound + logical :: endOfBlock + integer(I4B) :: ival + integer(I4B) :: n + integer(I4B) :: ierr + character(len=LENBOUNDNAME), dimension(:), allocatable :: nametxt + integer(I4B), dimension(:), allocatable :: nboundchk + integer(I4B), dimension(:), allocatable :: noder + real(DP), dimension(:), allocatable :: x + real(DP), dimension(:), allocatable :: y + real(DP), dimension(:), allocatable :: z + real(DP), dimension(:), allocatable :: tstop + ! -- format + character(len=*), parameter :: fmttend = & + "('end time (', G0, ') must be greater than or equal to the & + &begin time (', G0, ').')" + + ! -- allocate and initialize temporary variables + allocate (noder(this%nreleasepts)) + allocate (x(this%nreleasepts)) + allocate (y(this%nreleasepts)) + allocate (z(this%nreleasepts)) + allocate (tstop(this%nreleasepts)) + allocate (nametxt(this%nreleasepts)) + allocate (nboundchk(this%nreleasepts)) + + ! -- initialize temporary variables + do n = 1, this%nreleasepts + nboundchk(n) = 0 + end do + + ! -- read particle release point data + ! -- get particle release points block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + supportopenclose=.true.) + + ! -- parse block if detected + if (isfound) then + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%packName)) & + //' PACKAGEDATA' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + ival = this%parser%GetInteger() + n = ival + + if (n < 1 .or. n > this%nreleasepts) then + write (errmsg, '(a,1x,i0,a)') & + 'Release point number must be greater than 0 and less than ', & + 'or equal to', this%nreleasepts, '.' + call store_error(errmsg) + cycle + end if + + ! -- increment nboundchk + nboundchk(n) = nboundchk(n) + 1 + + ! -- node number + call this%parser%GetCellid(this%dis%ndim, cellid) + noder(n) = this%dis%noder_from_cellid(cellid, this%inunit, this%iout) + + ! -- x, y, z coordinates + x(n) = this%parser%GetDouble() + y(n) = this%parser%GetDouble() + z(n) = this%parser%GetDouble() + + ! -- set default boundname + write (cno, '(i9.9)') n + bndName = 'PRP'//cno + + ! -- read boundnames from file, if provided + if (this%inamedbound /= 0) then + call this%parser%GetStringCaps(bndNameTemp) + if (bndNameTemp /= '') & + bndName = bndNameTemp + else + bndName = '' + end if + + ! -- store temp boundnames + nametxt(n) = bndName + end do + + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%packName))//' PACKAGEDATA' + + ! -- check for duplicate or missing particle release points + do n = 1, this%nreleasepts + if (nboundchk(n) == 0) then + write (errmsg, '(a,a,1x,i0,a)') 'No data specified for particle ', & + 'release point', n, '.' + call store_error(errmsg) + else if (nboundchk(n) > 1) then + write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & + 'Data for particle release point', n, 'specified', nboundchk(n), & + 'times.' + call store_error(errmsg) + end if + end do + else + call store_error('Required packagedata block not found.') + end if + + ! -- terminate if any errors were detected + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + + ! -- fill particle release point data with data stored in temporary local arrays + do n = 1, this%nreleasepts + this%rptnode(n) = noder(n) + this%rptx(n) = x(n) + this%rpty(n) = y(n) + this%rptz(n) = z(n) + this%rptname(n) = nametxt(n) + end do + + ! -- deallocate local storage + deallocate (noder) + deallocate (x) + deallocate (y) + deallocate (z) + deallocate (tstop) + deallocate (nametxt) + deallocate (nboundchk) + end subroutine prp_read_packagedata + + !> @brief Read package dimensions + subroutine prp_read_dimensions(this) + ! -- dummy + class(PrtPrpType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: errmsg, keyword + integer(I4B) :: ierr + logical :: isfound, endOfBlock + + ! -- get dimension block + call this%parser%GetBlock('DIMENSIONS', isfound, ierr, & + supportOpenClose=.true.) + + ! -- parse dimension block if detected + if (isfound) then + write (this%iout, '(1x,a)') 'PROCESSING PARTICLE INPUT DIMENSIONS' + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + call this%parser%GetStringCaps(keyword) + select case (keyword) + case ('NRELEASEPTS') + this%nreleasepts = this%parser%GetInteger() + case default + write (errmsg, & + '(4x,a,a)') '****ERROR. UNKNOWN PARTICLE INPUT DIMENSION: ', & + trim(keyword) + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end select + end do + write (this%iout, '(1x,a)') 'END OF PARTICLE INPUT DIMENSIONS' + else + call store_error('ERROR. REQUIRED DIMENSIONS BLOCK NOT FOUND.') + end if + + ! -- set maxbound and nbound to nreleasepts + this%maxbound = this%nreleasepts + this%nbound = this%nreleasepts + + ! -- allocate arrays for prp package + call this%prp_allocate_arrays() + + ! -- read packagedata + call this%prp_read_packagedata() + end subroutine prp_read_dimensions + +end module PrtPrpModule diff --git a/src/Model/ParticleTracking/prt.f90 b/src/Model/ParticleTracking/prt.f90 new file mode 100644 index 00000000000..91c98536dec --- /dev/null +++ b/src/Model/ParticleTracking/prt.f90 @@ -0,0 +1,1202 @@ +module PrtModule + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use InputOutputModule, only: ParseLine, upcase, lowcase + use ConstantsModule, only: LENFTYPE, LENMEMPATH, DZERO, DONE, & + LENPAKLOC, LENPACKAGETYPE, LENBUDTXT, MNORMAL, & + LINELENGTH + use VersionModule, only: write_listfile_header + use NumericalModelModule, only: NumericalModelType + use BaseModelModule, only: BaseModelType + use BndModule, only: BndType, AddBndToList, GetBndFromList + use GwfDisModule, only: GwfDisType + use GwfDisvModule, only: GwfDisvType + use PrtPrpModule, only: PrtPrpType + use PrtFmiModule, only: PrtFmiType + use PrtMipModule, only: PrtMipType + use PrtOcModule, only: PrtOcType + use PrtObsModule, only: PrtObsType + use BudgetModule, only: BudgetType + use ListModule, only: ListType + use ParticleModule, only: ParticleType, create_particle + use TrackModule, only: TrackFileControlType, TrackFileType + use SimModule, only: count_errors, store_error, store_error_filename + use MemoryManagerModule, only: mem_allocate + use MethodModule, only: MethodType + + implicit none + + private + public :: prt_cr + public :: PrtModelType + public :: PRT_NBASEPKG, PRT_NMULTIPKG + public :: PRT_BASEPKG, PRT_MULTIPKG + + integer(I4B), parameter :: NBDITEMS = 1 + character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt + data budtxt/' STORAGE'/ + + !> @brief Particle tracking (PRT) model + type, extends(NumericalModelType) :: PrtModelType + type(PrtFmiType), pointer :: fmi => null() ! flow model interface + type(PrtMipType), pointer :: mip => null() ! model input package + type(PrtOcType), pointer :: oc => null() ! output control package + type(PrtObsType), pointer :: obs => null() ! observation package + type(BudgetType), pointer :: budget => null() ! budget object + class(MethodType), pointer :: method => null() ! tracking method + type(TrackFileControlType), pointer :: trackfilectl ! track file control + integer(I4B), pointer :: infmi => null() ! unit number FMI + integer(I4B), pointer :: inmip => null() ! unit number MIP + 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() ! unit number DSP + integer(I4B), pointer :: inssm => null() ! unit number SSM + integer(I4B), pointer :: inoc => null() ! unit number OC + integer(I4B), pointer :: inobs => null() ! unit number OBS + integer(I4B), pointer :: nprp => null() ! number of PRP packages in the model + real(DP), dimension(:), pointer, contiguous :: masssto => null() !< particle mass storage in cells, new value + real(DP), dimension(:), pointer, contiguous :: massstoold => null() !< particle mass storage in cells, old value + real(DP), dimension(:), pointer, contiguous :: ratesto => null() !< particle mass storage rate in cells + contains + ! -- Override BaseModelType procs + procedure :: model_df => prt_df + procedure :: model_ar => prt_ar + procedure :: model_rp => prt_rp + procedure :: model_ad => prt_ad + procedure :: model_cq => prt_cq + procedure :: model_bd => prt_bd + procedure :: model_ot => prt_ot + procedure :: model_da => prt_da + procedure :: model_solve => prt_solve + + ! -- Private utilities + procedure :: allocate_scalars + procedure :: allocate_arrays + procedure, private :: package_create + procedure, private :: ftype_check + procedure, private :: prt_ot_flow + procedure, private :: prt_ot_saveflow + procedure, private :: prt_ot_printflow + procedure, private :: prt_ot_dv + procedure, private :: prt_ot_bdsummary + procedure, private :: prt_ot_obs + procedure, private :: prt_cq_sto + procedure, private :: create_packages + procedure, private :: create_bndpkgs + procedure, private :: log_namfile_options + + end type PrtModelType + + !> @brief PRT base package array descriptors + !! + !! PRT6 model base package types. Only listed packages are candidates + !! for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: PRT_NBASEPKG = 50 + character(len=LENPACKAGETYPE), dimension(PRT_NBASEPKG) :: PRT_BASEPKG + data PRT_BASEPKG/'DIS6 ', 'DISV6', 'DISU6', 'IC6 ', 'MST6 ', & ! 5 + &'ADV6 ', 'DSP6 ', 'SSM6 ', 'MIP6 ', 'CNC6 ', & ! 10 + &'OC6 ', 'OBS6 ', 'FMI6 ', ' ', 'IST6 ', & ! 15 + &'LKT6 ', 'SFT6 ', 'MWT6 ', 'UZT6 ', 'MVT6 ', & ! 20 + &'API6 ', ' ', ' ', ' ', ' ', & ! 25 + 25*' '/ ! 50 + + !> @brief PRT multi package array descriptors + !! + !! PRT6 model multi-instance package types. Only listed packages are + !! candidates for input and these will be loaded in the order specified. + !< + integer(I4B), parameter :: PRT_NMULTIPKG = 50 + character(len=LENPACKAGETYPE), dimension(PRT_NMULTIPKG) :: PRT_MULTIPKG + data PRT_MULTIPKG/'PRP6 ', ' ', ' ', ' ', ' ', & ! 5 + &45*' '/ ! 50 + + ! -- size of supported model package arrays + integer(I4B), parameter :: NIUNIT_PRT = PRT_NBASEPKG + PRT_NMULTIPKG + +contains + + !> @brief Create a new particle tracking model object + subroutine prt_cr(filename, id, modelname) + ! -- modules + use ListsModule, only: basemodellist + use BaseModelModule, only: AddBaseModelToList + use ConstantsModule, only: LINELENGTH, LENPACKAGENAME + use CompilerVersion + use MemoryHelperModule, only: create_mem_path + use MemoryManagerExtModule, only: mem_set_value + use SimVariablesModule, only: idm_context + use GwfNamInputModule, only: GwfNamParamFoundType + ! -- dummy + character(len=*), intent(in) :: filename + integer(I4B), intent(in) :: id + character(len=*), intent(in) :: modelname + ! -- local + type(PrtModelType), pointer :: this + class(BaseModelType), pointer :: model + character(len=LENMEMPATH) :: input_mempath + character(len=LINELENGTH) :: lst_fname + type(GwfNamParamFoundType) :: found + + ! -- Allocate a new PRT Model (this) + allocate (this) + + ! -- Set this before any allocs in the memory manager can be done + this%memoryPath = create_mem_path(modelname) + + ! -- Allocate track control object + allocate (this%trackfilectl) + + ! -- Allocate scalars and add model to basemodellist + call this%allocate_scalars(modelname) + model => this + call AddBaseModelToList(basemodellist, model) + + ! -- Assign variables + this%filename = filename + this%name = modelname + this%macronym = 'PRT' + this%id = id + + ! -- Set input model namfile memory path + input_mempath = create_mem_path(modelname, 'NAM', idm_context) + + ! -- Copy options from input context + 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, & + 'PARTICLE TRACKING MODEL (PRT)') + + ! -- Activate save_flows if found + if (found%save_flows) then + this%ipakcb = -1 + end if + + ! -- Log options + if (this%iout > 0) then + call this%log_namfile_options(found) + end if + + ! -- Create model packages + call this%create_packages() + end subroutine prt_cr + + !> @brief Define packages + !! + !! (1) call df routines for each package + !! (2) set variables and pointers + !< + subroutine prt_df(this) + ! -- modules + use PrtPrpModule, only: PrtPrpType + ! -- dummy + class(PrtModelType) :: 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, 1) + call this%oc%oc_df() + call this%budget%budget_df(NIUNIT_PRT, 'MASS', 'M') + + ! -- Define packages and assign iout for time series managers + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_df(this%dis%nodes, this%dis) + packobj%TsManager%iout = this%iout + packobj%TasManager%iout = this%iout + end do + + ! -- Allocate model arrays + call this%allocate_arrays() + + ! -- Store information needed for observations + call this%obs%obs_df(this%iout, this%name, 'PRT', this%dis) + end subroutine prt_df + + !> @brief Allocate and read + !! + !! (1) allocates and reads packages part of this model, + !! (2) allocates memory for arrays part of this model object + !< + subroutine prt_ar(this) + ! -- modules + use ConstantsModule, only: DHNOFLO + use PrtPrpModule, only: PrtPrpType + use PrtMipModule, only: PrtMipType + use MethodPoolModule, only: method_dis, method_disv + ! -- dummy + class(PrtModelType) :: this + ! -- locals + integer(I4B) :: ip + class(BndType), pointer :: packobj + + ! -- Allocate and read modules attached to model + call this%fmi%fmi_ar(this%ibound) + if (this%inmip > 0) call this%mip%mip_ar() + + ! -- set up output control + call this%oc%oc_ar(this%masssto, this%dis, DHNOFLO) + call this%budget%set_ibudcsv(this%oc%ibudcsv) + + ! -- Package input files now open, so allocate and read + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + select type (packobj) + type is (PrtPrpType) + call packobj%prp_set_pointers(this%ibound, this%mip%izone, & + this%trackfilectl) + end select + ! -- Read and allocate package + call packobj%bnd_ar() + end do + + ! -- Initialize tracking method + select type (dis => this%dis) + type is (GwfDisType) + call method_dis%init( & + fmi=this%fmi, & + trackfilectl=this%trackfilectl, & + izone=this%mip%izone, & + flowja=this%flowja, & + porosity=this%mip%porosity, & + retfactor=this%mip%retfactor, & + tracktimes=this%oc%tracktimes) + this%method => method_dis + type is (GwfDisvType) + call method_disv%init( & + fmi=this%fmi, & + trackfilectl=this%trackfilectl, & + izone=this%mip%izone, & + flowja=this%flowja, & + porosity=this%mip%porosity, & + retfactor=this%mip%retfactor, & + tracktimes=this%oc%tracktimes) + this%method => method_disv + method_disv%zeromethod = this%mip%zeromethod + end select + + ! -- Initialize track output files and reporting options + if (this%oc%itrkout > 0) & + call this%trackfilectl%init_track_file(this%oc%itrkout) + if (this%oc%itrkcsv > 0) & + call this%trackfilectl%init_track_file(this%oc%itrkcsv, csv=.true.) + call this%trackfilectl%set_track_events( & + this%oc%trackrelease, & + this%oc%tracktransit, & + this%oc%tracktimestep, & + this%oc%trackterminate, & + this%oc%trackweaksink, & + this%oc%trackusertime) + end subroutine prt_ar + + !> @brief Read and prepare (calls package read and prepare routines) + subroutine prt_rp(this) + use TdisModule, only: readnewdata + ! -- dummy + class(PrtModelType) :: this + ! -- local + class(BndType), pointer :: packobj + integer(I4B) :: ip + + ! -- Check with TDIS on whether or not it is time to RP + if (.not. readnewdata) return + + ! -- Read and prepare + if (this%inoc > 0) call this%oc%oc_rp() + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_rp() + call packobj%bnd_rp_obs() + end do + end subroutine prt_rp + + !> @brief Time step advance (calls package advance subroutines) + subroutine prt_ad(this) + ! -- modules + use SimVariablesModule, only: isimcheck, iFailedStepRetry + ! -- dummy + class(PrtModelType) :: this + class(BndType), pointer :: packobj + ! -- local + integer(I4B) :: irestore + integer(I4B) :: ip, n, i + + ! -- Reset state variable + irestore = 0 + if (iFailedStepRetry > 0) irestore = 1 + + ! -- Copy masssto into massstoold + do n = 1, this%dis%nodes + this%massstoold(n) = this%masssto(n) + end do + + ! -- Advance fmi + call this%fmi%fmi_ad() + + ! -- Advance + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_ad() + if (isimcheck > 0) then + call packobj%bnd_ck() + end if + end do + + ! -- Push simulated values to preceding time/subtime step + call this%obs%obs_ad() + ! + ! -- Initialize the flowja array. Flowja is calculated each time, + ! even if output is suppressed. (Flowja represents flow of particle + ! mass and is positive into a cell. Currently, each particle is assigned + ! unit mass.) Flowja is updated continually as particles are tracked + ! over the time step and at the end of the time step. The diagonal + ! position of the flowja array will contain the flow residual. + do i = 1, this%dis%nja + this%flowja(i) = DZERO + end do + end subroutine prt_ad + + !> @brief Calculate intercell flow (flowja) + subroutine prt_cq(this, icnvg, isuppress_output) + ! -- modules + use SparseModule, only: csr_diagsum + use TdisModule, only: delt + use PrtPrpModule, only: PrtPrpType + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: icnvg + integer(I4B), intent(in) :: isuppress_output + ! -- local + integer(I4B) :: i + integer(I4B) :: ip + class(BndType), pointer :: packobj + real(DP) :: tled + + ! -- Flowja is calculated each time, even if output is suppressed. + ! Flowja represents flow of particle mass and is positive into a cell. + ! Currently, each particle is assigned unit mass. + ! + ! -- Reciprocal of time step size. + tled = DONE / delt + ! + ! -- Flowja was updated continually as particles were tracked over the + ! time step. At this point, flowja contains the net particle mass + ! exchanged between cells during the time step. To convert these to + ! flow rates (particle mass per time), divide by the time step size. + do i = 1, this%dis%nja + this%flowja(i) = this%flowja(i) * tled + end do + + ! -- Particle mass storage + call this%prt_cq_sto() + + ! -- Go through packages and call cq routines. Just a formality. + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_cq(this%masssto, this%flowja) + end do + + ! -- Finalize calculation of flowja by adding face flows to the diagonal. + ! This results in the flow residual being stored in the diagonal + ! position for each cell. + call csr_diagsum(this%dis%con%ia, this%flowja) + end subroutine prt_cq + + !> @brief Calculate particle mass storage + subroutine prt_cq_sto(this) + ! -- modules + use TdisModule, only: delt + use PrtPrpModule, only: PrtPrpType + ! -- dummy + class(PrtModelType) :: this + ! -- local + integer(I4B) :: ip + class(BndType), pointer :: packobj + integer(I4B) :: n + integer(I4B) :: np + integer(I4B) :: idiag + integer(I4B) :: istatus + real(DP) :: tled + real(DP) :: rate + + ! -- Reciprocal of time step size. + tled = DONE / delt + + ! -- Particle mass storage rate + do n = 1, this%dis%nodes + this%masssto(n) = DZERO + this%ratesto(n) = DZERO + end do + do ip = 1, this%bndlist%Count() ! kluge note: could accumulate masssto on the fly in prt_solve instead + packobj => GetBndFromList(this%bndlist, ip) + select type (packobj) + type is (PrtPrpType) + do np = 1, packobj%nparticles + istatus = packobj%particles%istatus(np) + ! refine these conditions as necessary + ! (status 8 is permanently unreleased) + if ((istatus > 0) .and. (istatus /= 8)) then + n = packobj%particles%idomain(np, 2) + ! -- Each particle currently assigned unit mass + this%masssto(n) = this%masssto(n) + DONE + end if + end do + end select + end do + do n = 1, this%dis%nodes ! kluge note: set rate to zero and skip inactive nodes? + rate = -(this%masssto(n) - this%massstoold(n)) * tled + this%ratesto(n) = rate + idiag = this%dis%con%ia(n) + this%flowja(idiag) = this%flowja(idiag) + rate + end do + end subroutine prt_cq_sto + + !> @brief Calculate flows and budget + !! + !! (1) Calculate intercell flows (flowja) + !! (2) Calculate package contributions to model budget + !! + !< + subroutine prt_bd(this, icnvg, isuppress_output) + ! -- modules + use TdisModule, only: delt + use BudgetModule, only: rate_accumulator + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: icnvg + integer(I4B), intent(in) :: isuppress_output + ! -- local + integer(I4B) :: ip + class(BndType), pointer :: packobj + real(DP) :: rin + real(DP) :: rout + + ! -- Budget routines (start by resetting). Sole purpose of this section + ! is to add in and outs to model budget. All ins and out for a model + ! should be added here to this%budget. In a subsequent exchange call, + ! exchange flows might also be added. + call this%budget%reset() + call rate_accumulator(this%ratesto, rin, rout) + call this%budget%addentry(rin, rout, delt, budtxt(1), & + isuppress_output, ' PRT') + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_bd(this%budget) + end do + end subroutine prt_bd + + !> @brief Print and/or save model output + subroutine prt_ot(this) + use TdisModule, only: tdis_ot, endofperiod + ! -- dummy + class(PrtModelType) :: this + ! -- local + integer(I4B) :: idvsave + integer(I4B) :: idvprint + integer(I4B) :: icbcfl + integer(I4B) :: icbcun + integer(I4B) :: ibudfl + integer(I4B) :: ipflag + + ! -- Note: particle tracking output is handled elsewhere + + ! -- 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', 1, endofperiod) + idvprint = this%oc%set_print_flag('CONCENTRATION', 1, endofperiod) + + ! -- Calculate and save observations + call this%prt_ot_obs() + + ! -- Save and print flows + call this%prt_ot_flow(icbcfl, ibudfl, icbcun) + + ! -- Save and print dependent variables + call this%prt_ot_dv(idvsave, idvprint, ipflag) + + ! -- Print budget summaries + call this%prt_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) + end subroutine prt_ot + + !> @brief Calculate and save observations + subroutine prt_ot_obs(this) + class(PrtModelType) :: 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 prt_ot_obs + + !> @brief Save flows + subroutine prt_ot_flow(this, icbcfl, ibudfl, icbcun) + use PrtPrpModule, only: PrtPrpType + class(PrtModelType) :: this + integer(I4B), intent(in) :: icbcfl + integer(I4B), intent(in) :: ibudfl + integer(I4B), intent(in) :: icbcun + class(BndType), pointer :: packobj + integer(I4B) :: ip + + ! -- Save PRT flows + call this%prt_ot_saveflow(this%dis%nja, this%flowja, icbcfl, icbcun) + 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 + + ! -- Print PRT flows + call this%prt_ot_printflow(ibudfl, this%flowja) + 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 + end subroutine prt_ot_flow + + !> @brief Save intercell flows + subroutine prt_ot_saveflow(this, nja, flowja, icbcfl, icbcun) + ! -- dummy + class(PrtModelType) :: 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 + + ! -- 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 + end subroutine prt_ot_saveflow + + !> @brief Print intercell flows + subroutine prt_ot_printflow(this, ibudfl, flowja) + ! -- modules + use TdisModule, only: kper, kstp + use ConstantsModule, only: LENBIGLINE + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: ibudfl + real(DP), intent(inout), dimension(:) :: flowja + ! -- local + character(len=LENBIGLINE) :: line + character(len=30) :: tempstr + integer(I4B) :: n, ipos, m + real(DP) :: qnm + ! -- 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 + write (this%iout, fmtiprflow) kper, kstp + do n = 1, this%dis%nodes + line = '' + call this%dis%noder_to_string(n, tempstr) + line = trim(tempstr)//':' + do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 + m = this%dis%con%ja(ipos) + call this%dis%noder_to_string(m, tempstr) + line = trim(line)//' '//trim(tempstr) + qnm = flowja(ipos) + write (tempstr, '(1pg15.6)') qnm + line = trim(line)//' '//trim(adjustl(tempstr)) + end do + write (this%iout, '(a)') trim(line) + end do + end if + end subroutine prt_ot_printflow + + !> @brief Print dependent variables + subroutine prt_ot_dv(this, idvsave, idvprint, ipflag) + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: idvsave + integer(I4B), intent(in) :: idvprint + integer(I4B), intent(inout) :: ipflag + ! -- local + 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 prt_ot_dv + + !> @brief Print budget summary + subroutine prt_ot_bdsummary(this, ibudfl, ipflag) + ! -- modules + use TdisModule, only: kstp, kper, totim + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: ibudfl + integer(I4B), intent(inout) :: ipflag + ! -- local + 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 + + ! -- model budget summary + if (ibudfl /= 0) then + ipflag = 1 + ! -- model budget summary + call this%budget%budget_ot(kstp, kper, this%iout) + end if + + ! -- Write to budget csv + call this%budget%writecsv(totim) + end subroutine prt_ot_bdsummary + + !> @brief Deallocate + subroutine prt_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + use MemoryManagerExtModule, only: memorylist_remove + use SimVariablesModule, only: idm_context + use MethodPoolModule, only: destroy_method_pool + use MethodCellPoolModule, only: destroy_method_cell_pool + use MethodSubcellPoolModule, only: destroy_method_subcell_pool + ! -- dummy + class(PrtModelType) :: this + ! -- local + integer(I4B) :: ip + class(BndType), pointer :: packobj + + ! -- Deallocate idm memory + call memorylist_remove(this%name, 'NAM', idm_context) + call memorylist_remove(component=this%name, context=idm_context) + + ! -- Internal packages + call this%dis%dis_da() + call this%fmi%fmi_da() + call this%mip%mip_da() + call this%budget%budget_da() + call this%oc%oc_da() + call this%obs%obs_da() + deallocate (this%dis) + deallocate (this%fmi) + deallocate (this%mip) + deallocate (this%budget) + deallocate (this%oc) + deallocate (this%obs) + + ! -- Method objects + call destroy_method_subcell_pool() + call destroy_method_cell_pool() + call destroy_method_pool() + + ! -- Boundary packages + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_da() + deallocate (packobj) + end do + + ! -- Scalars + call mem_deallocate(this%infmi) + call mem_deallocate(this%inmip) + 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) + call mem_deallocate(this%nprp) + + ! -- Arrays + call mem_deallocate(this%masssto) + call mem_deallocate(this%massstoold) + call mem_deallocate(this%ratesto) + + ! -- Track file control + deallocate (this%trackfilectl) + + ! -- Parent type + call this%NumericalModelType%model_da() + end subroutine prt_da + + !> @brief Allocate memory for non-allocatable members + subroutine allocate_scalars(this, modelname) + ! -- dummy + class(PrtModelType) :: this + character(len=*), intent(in) :: modelname + + ! -- allocate members from parent class + call this%NumericalModelType%allocate_scalars(modelname) + + ! -- allocate members that are part of model class + call mem_allocate(this%infmi, 'INFMI', this%memoryPath) + call mem_allocate(this%inmip, 'INMIP', this%memoryPath) + call mem_allocate(this%inmvt, 'INMVT', this%memoryPath) + 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) + call mem_allocate(this%nprp, 'NPRP', this%memoryPath) ! kluge? + + this%infmi = 0 + this%inmip = 0 + this%inmvt = 0 + this%inmst = 0 + this%inadv = 0 + this%indsp = 0 + this%inssm = 0 + this%inoc = 0 + this%inobs = 0 + this%nprp = 0 + end subroutine allocate_scalars + + !> @brief Allocate arrays + subroutine allocate_arrays(this) + use MemoryManagerModule, only: mem_allocate + class(PrtModelType) :: this + integer(I4B) :: n + + ! -- Allocate arrays in parent type + this%nja = this%dis%nja + call this%NumericalModelType%allocate_arrays() + + ! -- Allocate and initialize arrays + call mem_allocate(this%masssto, this%dis%nodes, & + 'MASSSTO', this%memoryPath) + call mem_allocate(this%massstoold, this%dis%nodes, & + 'MASSSTOOLD', this%memoryPath) + call mem_allocate(this%ratesto, this%dis%nodes, & + 'RATESTO', this%memoryPath) + ! -- explicit model, so these must be manually allocated + call mem_allocate(this%x, this%dis%nodes, 'X', this%memoryPath) + call mem_allocate(this%rhs, this%dis%nodes, 'RHS', this%memoryPath) + call mem_allocate(this%ibound, this%dis%nodes, 'IBOUND', this%memoryPath) + do n = 1, this%dis%nodes + this%masssto(n) = DZERO + this%massstoold(n) = DZERO + this%ratesto(n) = DZERO + this%x(n) = DZERO + this%rhs(n) = DZERO + this%ibound(n) = 1 + end do + end subroutine allocate_arrays + + !> @brief Create boundary condition packages for this model + subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & + inunit, iout) + ! -- modules + use ConstantsModule, only: LINELENGTH + use PrtPrpModule, only: prp_create + use ApiModule, only: api_create + ! -- dummy + class(PrtModelType) :: this + character(len=*), intent(in) :: filtyp + character(len=LINELENGTH) :: errmsg + 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 ('PRP6') + this%nprp = this%nprp + 1 + call prp_create(packobj, ipakid, ipaknum, inunit, iout, & + this%name, pakname, mempath, this%fmi) + case ('API6') + call api_create(packobj, ipakid, ipaknum, inunit, iout, & + this%name, pakname) + case default + write (errmsg, *) 'Invalid package type: ', filtyp + call store_error(errmsg, terminate=.TRUE.) + end select + + ! -- Packages is the bndlist that is associated with the parent model + ! -- The following statement puts a pointer to this package in the ipakid + ! -- position of packages. + do ip = 1, this%bndlist%Count() + packobj2 => GetBndFromList(this%bndlist, ip) + if (packobj2%packName == pakname) then + write (errmsg, '(a,a)') 'Cannot create package. Package name '// & + 'already exists: ', trim(pakname) + call store_error(errmsg, terminate=.TRUE.) + end if + end do + call AddBndToList(this%bndlist, packobj) + end subroutine package_create + + !> @brief Check to make sure required input files have been specified + subroutine ftype_check(this, indis) + ! -- dummy + class(PrtModelType) :: this + integer(I4B), intent(in) :: indis + ! -- local + character(len=LINELENGTH) :: errmsg + + ! -- Check for DIS(u) and MIP. Stop if not present. + if (indis == 0) then + write (errmsg, '(1x,a)') & + 'Discretization (DIS6, DISV6, or DISU6) package not specified.' + call store_error(errmsg) + end if + if (this%inmip == 0) then + write (errmsg, '(1x,a)') & + 'Model input (MIP6) package not specified.' + call store_error(errmsg) + end if + + if (count_errors() > 0) then + write (errmsg, '(1x,a)') 'One or more required package(s) not specified.' + call store_error(errmsg) + call store_error_filename(this%filename) + end if + end subroutine ftype_check + + !> @brief Solve the model + subroutine prt_solve(this) + ! -- modules + use TdisModule, only: kper, kstp, totimc, totim, nper, nstp + use PrtPrpModule, only: PrtPrpType + ! -- dummy variables + class(PrtModelType) :: this + ! -- local variables + integer(I4B) :: np, ip + class(BndType), pointer :: packobj + type(ParticleType), pointer :: particle + real(DP) :: tmax + integer(I4B) :: iprp + + ! -- Initialize particle + call create_particle(particle) + + ! -- Loop over PRP packages + iprp = 0 + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + select type (packobj) + type is (PrtPrpType) + ! -- Update PRP index + iprp = iprp + 1 + + ! -- Initialize PRP-specific track files, if enabled + if (packobj%itrkout > 0) then + call this%trackfilectl%init_track_file( & + packobj%itrkout, & + iprp=iprp) + end if + if (packobj%itrkcsv > 0) then + call this%trackfilectl%init_track_file( & + packobj%itrkcsv, & + csv=.true., & + iprp=iprp) + end if + + ! -- Loop over particles in package + do np = 1, packobj%nparticles + ! -- Load particle from storage + call particle%load_from_store(packobj%particles, & + this%id, iprp, np) + + ! -- If particle is permanently unreleased, record its initial/terminal state + if (particle%istatus == 8) & + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + + ! -- If particle is inactive or not yet to be released, cycle + if (particle%istatus > 1) cycle + + ! -- If particle released this time step, record its initial state + particle%istatus = 1 + if (particle%trelease >= totimc) & + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=0) ! reason=0: release + + ! -- Unless in last stress period and it has only one time step, + ! -- limit max time to no later than end of time step + tmax = particle%tstop + if (kper == nper .and. nstp(kper) /= 1 .and. totim < particle%tstop) & + tmax = totim + + ! -- Get and apply the tracking method + call this%method%apply(particle, tmax) + + ! -- Update particle storage + call packobj%particles%load_from_particle(particle, np) + end do + end select + end do + + ! -- Destroy particle + call particle%destroy() + deallocate (particle) + end subroutine prt_solve + + !> @brief Source package info and begin to process + subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, & + mempaths, inunits) + ! -- modules + use ConstantsModule, only: LINELENGTH, LENPACKAGENAME + use CharacterStringModule, only: CharacterStringType + ! -- dummy + class(PrtModelType) :: this + integer(I4B), dimension(:), allocatable, intent(inout) :: bndpkgs + type(CharacterStringType), dimension(:), contiguous, & + pointer, intent(inout) :: pkgtypes + type(CharacterStringType), dimension(:), contiguous, & + pointer, intent(inout) :: pkgnames + type(CharacterStringType), dimension(:), contiguous, & + pointer, intent(inout) :: mempaths + integer(I4B), dimension(:), contiguous, & + pointer, intent(inout) :: inunits + ! -- local + integer(I4B) :: ipakid, ipaknum + character(len=LENFTYPE) :: pkgtype, bndptype + character(len=LENPACKAGENAME) :: pkgname + character(len=LENMEMPATH) :: mempath + integer(I4B), pointer :: inunit + integer(I4B) :: n + + if (allocated(bndpkgs)) then + ! + ! -- create stress packages + ipakid = 1 + bndptype = '' + do n = 1, size(bndpkgs) + ! + pkgtype = pkgtypes(bndpkgs(n)) + pkgname = pkgnames(bndpkgs(n)) + mempath = mempaths(bndpkgs(n)) + inunit => inunits(bndpkgs(n)) + ! + if (bndptype /= pkgtype) then + ipaknum = 1 + bndptype = pkgtype + end if + ! + call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, & + inunit, this%iout) + ipakid = ipakid + 1 + ipaknum = ipaknum + 1 + end do + ! + ! -- cleanup + deallocate (bndpkgs) + end if + + end subroutine create_bndpkgs + + !> @brief Source package info and begin to process + subroutine create_packages(this) + ! -- 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 BudgetModule, only: budget_cr + use MethodPoolModule, only: create_method_pool + use MethodCellPoolModule, only: create_method_cell_pool + use MethodSubcellPoolModule, only: create_method_subcell_pool + use PrtMipModule, only: mip_cr + use PrtFmiModule, only: fmi_cr + use PrtOcModule, only: oc_cr + use PrtObsModule, only: prt_obs_cr + ! -- dummy + class(PrtModelType) :: this + ! -- 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), dimension(:), allocatable :: bndpkgs + integer(I4B) :: n + integer(I4B) :: indis = 0 ! DIS enabled flag + character(len=LENMEMPATH) :: mempathmip = '' + + ! -- 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 first 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 ('MIP6') + this%inmip = 1 + mempathmip = mempath + case ('FMI6') + this%infmi = inunit + case ('OC6') + this%inoc = inunit + case ('OBS6') + this%inobs = inunit + case ('PRP6') + call expandarray(bndpkgs) + bndpkgs(size(bndpkgs)) = n + case default + call pstop(1, "Unrecognized package type: "//pkgtype) + end select + end do + + ! -- Create budget manager + call budget_cr(this%budget, this%name) + + ! -- Create tracking method pools + call create_method_pool() + call create_method_cell_pool() + call create_method_subcell_pool() + + ! -- Create packages that are tied directly to model + call mip_cr(this%mip, this%name, mempathmip, this%inmip, this%iout, this%dis) + call fmi_cr(this%fmi, this%name, this%infmi, this%iout) + call oc_cr(this%oc, this%name, this%inoc, this%iout) + call prt_obs_cr(this%obs, this%inobs) + + ! -- Check to make sure that required ftype's have been specified + call this%ftype_check(indis) + + ! -- Create boundary packages + call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits) + end subroutine create_packages + + !> @brief Write model namfile options to list file + subroutine log_namfile_options(this, found) + use GwfNamInputModule, only: GwfNamParamFoundType + class(PrtModelType) :: 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 module PrtModule diff --git a/src/Model/TransportModel/tsp-mvt.f90 b/src/Model/TransportModel/tsp-mvt.f90 index a0b1530dc80..f16961666b2 100644 --- a/src/Model/TransportModel/tsp-mvt.f90 +++ b/src/Model/TransportModel/tsp-mvt.f90 @@ -478,7 +478,6 @@ end subroutine mvt_ot_printflow subroutine mvt_ot_bdsummary(this, ibudfl) ! -- modules use TdisModule, only: kstp, kper, delt, totim - use ArrayHandlersModule, only: ifind, expandarray ! -- dummy class(TspMvtType) :: this integer(I4B), intent(in) :: ibudfl diff --git a/src/Model/TransportModel/tsp.f90 b/src/Model/TransportModel/tsp.f90 index 2f2eb9f70a6..82d49c1dd67 100644 --- a/src/Model/TransportModel/tsp.f90 +++ b/src/Model/TransportModel/tsp.f90 @@ -721,7 +721,6 @@ 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 diff --git a/src/SimulationCreate.f90 b/src/SimulationCreate.f90 index 81451c187ee..c25c11a9920 100644 --- a/src/SimulationCreate.f90 +++ b/src/SimulationCreate.f90 @@ -1,9 +1,9 @@ module SimulationCreateModule use KindModule, only: DP, I4B, LGP, write_kindinfo + use DevFeatureModule, only: dev_feature use ConstantsModule, only: LINELENGTH, LENMODELNAME, LENBIGLINE, & DZERO, LENEXCHANGENAME, LENMEMPATH, LENPACKAGETYPE - use CharacterStringModule, only: CharacterStringType use SimVariablesModule, only: iout, simulation_mode, proc_id, & nr_procs, model_names, model_ranks, & @@ -215,10 +215,12 @@ subroutine models_create() use GwtModule, only: gwt_cr use GweModule, only: gwe_cr use SwfModule, only: swf_cr + use PrtModule, only: prt_cr use NumericalModelModule, only: NumericalModelType, GetNumericalModelFromList use VirtualGwfModelModule, only: add_virtual_gwf_model use VirtualGwtModelModule, only: add_virtual_gwt_model use VirtualGweModelModule, only: add_virtual_gwe_model + ! use VirtualPrtModelModule, only: add_virtual_prt_model use ConstantsModule, only: LENMODELNAME ! -- dummy ! -- locals @@ -314,7 +316,15 @@ subroutine models_create() num_model => GetNumericalModelFromList(basemodellist, im) model_loc_idx(n) = im end if - !todo call add_virtual_gwt_model(n, model_names(n), num_model) + case ('PRT6') + im = im + 1 + write (iout, '(4x,2a,i0,a)') trim(model_type), ' model ', & + n, ' will be created' + call prt_cr(fname, n, model_names(n)) + call dev_feature("PRT is still under development, install the' & + &nightly build or compile from source with IDEVELOPMODE = 1.") + num_model => GetNumericalModelFromList(basemodellist, im) + model_loc_idx(n) = im case default write (errmsg, '(a,a)') & 'Unknown simulation model type: ', trim(model_type) @@ -346,12 +356,14 @@ subroutine exchanges_create() use GwfGwfExchangeModule, only: gwfexchange_create use GwfGwtExchangeModule, only: gwfgwt_cr use GwfGweExchangeModule, only: gwfgwe_cr + use GwfPrtExchangeModule, only: gwfprt_cr use GwtGwtExchangeModule, only: gwtexchange_create use GweGweExchangeModule, only: gweexchange_create use SwfGwfExchangeModule, only: swfgwf_cr use VirtualGwfExchangeModule, only: add_virtual_gwf_exchange use VirtualGwtExchangeModule, only: add_virtual_gwt_exchange use VirtualGweExchangeModule, only: add_virtual_gwe_exchange + ! use VirtualPrtExchangeModule, only: add_virtual_prt_exchange ! -- dummy ! -- locals character(len=LENMEMPATH) :: input_mempath @@ -446,6 +458,8 @@ subroutine exchanges_create() if (both_local) then call gwfgwe_cr(fname, exg_id, m1_id, m2_id) end if + case ('GWF6-PRT6') + call gwfprt_cr(fname, exg_id, m1_id, m2_id) case ('GWT6-GWT6') write (exg_name, '(a,i0)') 'GWT-GWT_', exg_id if (.not. both_remote) then diff --git a/src/Solution/ExplicitSolution.f90 b/src/Solution/ExplicitSolution.f90 index d40a2fe4046..35fa3ee1f6f 100644 --- a/src/Solution/ExplicitSolution.f90 +++ b/src/Solution/ExplicitSolution.f90 @@ -1,4 +1,11 @@ -!> @brief Explicit model solution +!> @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. +!! +!< module ExplicitSolutionModule use KindModule, only: I4B, DP use TimerModule, only: code_timer @@ -6,9 +13,9 @@ module ExplicitSolutionModule MNORMAL, LINELENGTH, DZERO use MemoryHelperModule, only: create_mem_path use BaseModelModule, only: BaseModelType - use ExplicitModelModule, only: ExplicitModelType, & - AddExplicitModelToList, & - GetExplicitModelFromList + use NumericalModelModule, only: NumericalModelType, & + AddNumericalModelToList, & + GetNumericalModelFromList use BaseExchangeModule, only: BaseExchangeType use BaseSolutionModule, only: BaseSolutionType, AddBaseSolutionToList use ListModule, only: ListType @@ -187,7 +194,7 @@ subroutine sln_ca(this, isgcnvg, isuppress_output) integer(I4B), intent(inout) :: isgcnvg !< solution group convergence flag integer(I4B), intent(in) :: isuppress_output !< flag for suppressing output ! -- local variables - class(ExplicitModelType), pointer :: mp => null() + class(NumericalModelType), pointer :: mp => null() character(len=LINELENGTH) :: line character(len=LINELENGTH) :: fmt integer(I4B) :: im @@ -200,7 +207,7 @@ subroutine sln_ca(this, isgcnvg, isuppress_output) line = 'mode="validation" -- Skipping assembly and solution.' fmt = "(/,1x,a,/)" do im = 1, this%modellist%Count() - mp => GetExplicitModelFromList(this%modellist, im) + mp => GetNumericalModelFromList(this%modellist, im) call mp%model_message(line, fmt=fmt) end do case (MNORMAL) @@ -220,11 +227,11 @@ subroutine prepareSolve(this) class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance ! -- local variables integer(I4B) :: im - class(ExplicitModelType), pointer :: mp => null() + class(NumericalModelType), pointer :: mp => null() ! -- Model advance do im = 1, this%modellist%Count() - mp => GetExplicitModelFromList(this%modellist, im) + mp => GetNumericalModelFromList(this%modellist, im) call mp%model_ad() end do @@ -238,13 +245,13 @@ subroutine solve(this) ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance ! -- local variables - class(ExplicitModelType), pointer :: mp => null() + class(NumericalModelType), pointer :: mp => null() integer(I4B) :: im real(DP) :: ttsoln call code_timer(0, ttsoln, this%ttsoln) do im = 1, this%modellist%Count() - mp => GetExplicitModelFromList(this%modellist, im) + mp => GetNumericalModelFromList(this%modellist, im) call mp%model_solve() end do call code_timer(1, ttsoln, this%ttsoln) @@ -260,17 +267,17 @@ subroutine finalizeSolve(this, isgcnvg, isuppress_output) integer(I4B), intent(in) :: isuppress_output !< flag for suppressing output ! -- local variables integer(I4B) :: im - class(ExplicitModelType), pointer :: mp => null() + class(NumericalModelType), pointer :: mp => null() ! -- Calculate flow for each model do im = 1, this%modellist%Count() - mp => GetExplicitModelFromList(this%modellist, im) + mp => GetNumericalModelFromList(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) + mp => GetNumericalModelFromList(this%modellist, im) call mp%model_bd(this%icnvg, isuppress_output) end do end subroutine finalizeSolve @@ -297,13 +304,13 @@ subroutine add_model(this, mp) class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance class(BaseModelType), pointer, intent(in) :: mp !< model instance ! -- local variables - class(ExplicitModelType), pointer :: m => null() + class(NumericalModelType), pointer :: m => null() ! -- add a model select type (mp) - class is (ExplicitModelType) + class is (NumericalModelType) m => mp - call AddExplicitModelToList(this%modellist, m) + call AddNumericalModelToList(this%modellist, m) end select end subroutine add_model diff --git a/src/Solution/ParticleTracker/Cell.f90 b/src/Solution/ParticleTracker/Cell.f90 new file mode 100644 index 00000000000..00aee613d48 --- /dev/null +++ b/src/Solution/ParticleTracker/Cell.f90 @@ -0,0 +1,24 @@ +module CellModule + + use CellDefnModule, only: CellDefnType + implicit none + private + public :: CellType + + !> @brief Base type for grid cells of a concrete type. Contains + !! a cell-definition which is information shared by cell types. + type, abstract :: CellType + character(len=40), pointer :: type ! tracking domain type + type(CellDefnType), pointer :: defn => null() ! cell defn + contains + procedure(destroy), deferred :: destroy !< destroy the cell + end type CellType + + abstract interface + subroutine destroy(this) + import CellType + class(CellType), intent(inout) :: this + end subroutine + end interface + +end module CellModule diff --git a/src/Solution/ParticleTracker/CellDefn.f90 b/src/Solution/ParticleTracker/CellDefn.f90 new file mode 100644 index 00000000000..82db0209cb0 --- /dev/null +++ b/src/Solution/ParticleTracker/CellDefn.f90 @@ -0,0 +1,90 @@ +module CellDefnModule + use KindModule, only: DP, I4B, LGP + implicit none + + private + public :: CellDefnType + public :: create_defn + + !> @brief Base grid cell definition. + type CellDefnType + private + integer(I4B), public :: icell !< index of cell in source grid + logical(LGP), public :: can_be_rect !< whether cell is representable as a rectangular cell + logical(LGP), public :: can_be_quad !< whether cell is representable as a rectangular quad cell + integer(I4B), public :: npolyverts !< number of vertices for cell polygon + real(DP), public :: porosity !< cell porosity + real(DP), public :: retfactor !< cell retardation factor + integer(I4B), public :: izone !< cell zone number + integer(I4B), public :: iweaksink !< weak sink indicator + integer(I4B), public :: inoexitface !< no exit face indicator + integer(I4B), public :: iatop !< index of cell top in grid's top/bot arrays (<0 => top array) + real(DP), public :: top, bot !< top and bottom elevations of cell + real(DP), public :: sat !< cell saturation + real(DP), allocatable, public :: polyvert(:, :) !< vertices for cell polygon + logical(LGP), allocatable, public :: ispv180(:) !< indicator of 180-degree vertices (.true. = 180-degree angle at vertex) + integer(I4B), allocatable, public :: facenbr(:) !< neighbors that correspond to faces(/vertices) + real(DP), allocatable, public :: faceflow(:) !< flows that correspond to faces(/vertices) + real(DP), public :: distflow !< net distributed flow into cell + contains + procedure, public :: get_npolyverts !< returns the number of polygon vertices + procedure, public :: get_ispv180 !< returns 180-degree indicator for a vertex + procedure, public :: get_botflow !< returns bottom flow + procedure, public :: get_topflow !< returns top flow + procedure, public :: get_distflow !< returns distributed flow + procedure, public :: get_faceflow !< returns a face flow + end type CellDefnType + +contains + + !> @brief Create a new cell definition object + subroutine create_defn(cellDefn) + type(CellDefnType), pointer :: cellDefn + allocate (cellDefn) + end subroutine create_defn + + !> @brief Return the number of polygon vertices + function get_npolyverts(this) result(npolyverts) + class(CellDefnType), intent(inout) :: this + integer :: npolyverts + npolyverts = this%npolyverts + end function get_npolyverts + + !> @brief Return 180-degree indicator for a vertex + function get_ispv180(this, m) result(ispv180) + class(CellDefnType), intent(inout) :: this + integer :: m + logical :: ispv180 + ispv180 = this%ispv180(m) + end function get_ispv180 + + !> @brief Return the bottom flow + function get_botflow(this) result(botflow) + class(CellDefnType), intent(inout) :: this + double precision :: botflow + botflow = this%faceflow(this%npolyverts + 2) + end function get_botflow + + !> @brief Return the top flow + function get_topflow(this) result(topflow) + class(CellDefnType), intent(inout) :: this + double precision :: topflow + topflow = this%faceflow(this%npolyverts + 3) + end function get_topflow + + !> @brief Return the distributed flow + function get_distflow(this) result(distflow) + class(CellDefnType), intent(inout) :: this + double precision :: distflow + distflow = this%distflow + end function get_distflow + + !> @brief Return a face flow + function get_faceflow(this, m) result(faceflow) + class(CellDefnType), intent(inout) :: this + integer :: m + double precision :: faceflow + faceflow = this%faceflow(m) + end function get_faceflow + +end module CellDefnModule diff --git a/src/Solution/ParticleTracker/CellPoly.f90 b/src/Solution/ParticleTracker/CellPoly.f90 new file mode 100644 index 00000000000..2f83e508aae --- /dev/null +++ b/src/Solution/ParticleTracker/CellPoly.f90 @@ -0,0 +1,34 @@ +module CellPolyModule + + use CellModule, only: CellType + use CellDefnModule, only: CellDefnType + implicit none + + private + public :: CellPolyType + public :: create_cell_poly + + type, extends(CellType) :: CellPolyType + contains + procedure :: destroy => destroy_cell_poly + end type CellPolyType + +contains + + !> @brief Create a new polygonal cell + subroutine create_cell_poly(cell) + type(CellPolyType), pointer :: cell + allocate (cell) + allocate (cell%defn) + allocate (cell%type) + cell%type = 'poly' + end subroutine create_cell_poly + + !> @brief Destroy the polygonal cell + subroutine destroy_cell_poly(this) + class(CellPolyType), intent(inout) :: this + deallocate (this%defn) + deallocate (this%type) + end subroutine destroy_cell_poly + +end module CellPolyModule diff --git a/src/Solution/ParticleTracker/CellRect.f90 b/src/Solution/ParticleTracker/CellRect.f90 new file mode 100644 index 00000000000..b359135917f --- /dev/null +++ b/src/Solution/ParticleTracker/CellRect.f90 @@ -0,0 +1,54 @@ +module CellRectModule + + use CellModule, only: CellType + use CellDefnModule, only: CellDefnType + implicit none + + private + public :: CellRectType + public :: create_cell_rect + + type, extends(CellType) :: CellRectType + private + double precision, public :: dx ! dimension of cell in local x direction + double precision, public :: dy ! dimension of cell in local y direction + double precision, public :: dz ! dimension of cell in z direction + + double precision, public :: sinrot ! sine of rotation angle for local (x, y) + double precision, public :: cosrot ! cosine of rotation angle for local (x, y) + + double precision, public :: vx1 ! west-boundary local-x velocity + double precision, public :: vx2 ! east-boundary local-x velocity + double precision, public :: vy1 ! south-boundary local-y velocity + double precision, public :: vy2 ! north-boundary local-y velocity + double precision, public :: vz1 ! bottom-boundary z velocity + double precision, public :: vz2 ! top-boundary z velocity + + integer, public :: ipvOrigin ! origin vertex + double precision, public :: xOrigin ! model x origin for local (x, y) + double precision, public :: yOrigin ! model y origin for local (x, y) + double precision, public :: zOrigin ! model z origin for local z + + contains + procedure :: destroy => destroy_rect ! destructor for the cell + end type CellRectType + +contains + + !> @brief Create a new rectangular cell + subroutine create_cell_rect(cell) + type(CellRectType), pointer :: cell + allocate (cell) + allocate (cell%defn) + allocate (cell%type) + cell%type = 'rect' + end subroutine create_cell_rect + + !> @brief Destroy the rectangular cell + subroutine destroy_rect(this) + class(CellRectType), intent(inout) :: this + deallocate (this%defn) + deallocate (this%type) + end subroutine destroy_rect + +end module CellRectModule diff --git a/src/Solution/ParticleTracker/CellRectQuad.f90 b/src/Solution/ParticleTracker/CellRectQuad.f90 new file mode 100644 index 00000000000..b8dc00c3020 --- /dev/null +++ b/src/Solution/ParticleTracker/CellRectQuad.f90 @@ -0,0 +1,220 @@ +module CellRectQuadModule + + use CellModule, only: CellType + use CellDefnModule, only: CellDefnType + implicit none + + private + public :: CellRectQuadType + public :: create_cell_rect_quad + + type, extends(CellType) :: CellRectQuadType + double precision :: dx ! dimension of cell in local x direction + double precision :: dy ! dimension of cell in local y direction + double precision :: dz ! dimension of cell in z direction + + double precision :: sinrot ! sine of rotation angle for local (x, y) + double precision :: cosrot ! cosine of rotation angle for local (x, y) + + integer :: irvOrigin ! origin rectangle vertex + double precision :: xOrigin ! model x origin for local (x, y) + double precision :: yOrigin ! model y origin for local (x, y) + double precision :: zOrigin ! model z origin for local z + + double precision :: qextl1(4), qextl2(4), qintl(5) ! external and internal subcell flows for the cell + integer, allocatable :: irectvert(:) ! list of indices of the rectangle vertices + integer, allocatable :: ipv4irv(:, :) ! list of the polygon vertex indices that correspond to the rectangle vertex indices + double precision, allocatable :: rectflow(:, :) ! flow(s) for each rectangle face + contains + procedure :: destroy => destroy_cell_rect_quad ! destructor for the cell + procedure :: init_from ! initializes the cell from an existing cell + + procedure :: load_irectvert ! loads list of indices of the rectangle vertices + procedure :: get_irectvertSW ! gets index of southwest rectangle vertex + procedure :: get_rectDimensionsRotation ! gets rectangular dimensions and rotation + + procedure :: get_rectflow ! returns a rectangle face flow + procedure :: face_is_refined ! returns whether a rectangle face is refined + end type CellRectQuadType + +contains + + !> @brief Create a new rectangular-quad cell + subroutine create_cell_rect_quad(cell) + type(CellRectQuadType), pointer :: cell + allocate (cell) + allocate (cell%defn) + allocate (cell%irectvert(5)) + allocate (cell%ipv4irv(2, 4)) + allocate (cell%rectflow(2, 4)) + allocate (cell%type) + cell%type = 'rectquad' + end subroutine create_cell_rect_quad + + !> @brief Destroy the rectangular-quad cell + subroutine destroy_cell_rect_quad(this) + class(CellRectQuadType), intent(inout) :: this + deallocate (this%defn) + deallocate (this%irectvert) + deallocate (this%type) + end subroutine destroy_cell_rect_quad + + !> @brief Initialize a rectangular-quad cell from another cell + subroutine init_from(this, defn) + class(CellRectQuadType), intent(inout) :: this + type(CellDefnType), pointer :: defn + this%defn => defn + call this%load_irectvert() + end subroutine init_from + + !> @brief Load local polygon vertex indices + !! + !! Loads local polygon vertex indices of the four rectangle + !! vertices of a rectangular-quad cell. Todo: rename? + !< + subroutine load_irectvert(this) + ! -- dummy + class(CellRectQuadType), intent(inout) :: this + ! -- local + integer :: npolyverts, n, m + + npolyverts = this%defn%get_npolyverts() + + n = 0 + do m = 1, npolyverts + if (.not. this%defn%get_ispv180(m)) then + n = n + 1 + this%irectvert(n) = m + this%ipv4irv(1, n) = m + this%rectflow(1, n) = this%defn%get_faceflow(m) + this%ipv4irv(2, n) = 0 + this%rectflow(2, n) = 0d0 + else + if (n .ne. 0) then + this%ipv4irv(2, n) = m + this%rectflow(2, n) = this%defn%get_faceflow(m) + end if + end if + end do + + ! Wrap around for convenience + this%irectvert(5) = this%irectvert(1) + end subroutine load_irectvert + + !> @brief Get index of SW rectangle vertex + !! + !! Return the index (1, 2, 3, or 4) of the southwest + !! rectangle vertex of a rectangular-quad cell + !< + function get_irectvertSW(this) result(irv1) + ! -- dummy + class(CellRectQuadType), intent(inout) :: this + integer :: irv1 + ! -- local + integer :: irv, irv2, irv4, ipv1, ipv2, ipv4 + integer, dimension(4) :: irvnxt = (/2, 3, 4, 1/) ! kluge??? + double precision :: x1, y1, x2, y2, x4, y4 + + ! -- Find the "southwest" rectangle vertex by finding the vertex formed + ! -- either by (1) a rectangle edge over which x decreases (going + ! -- clockwise) followed by an edge over which x does not increase, or by + ! -- (2) a rectangle edge over which y does not decrease (again going + ! -- clockwise) followed by a rectangle edge over which y increases. In + ! -- the end, ipv1 is the index (1, 2, 3, or 4) of the southwest + ! -- rectangle vertex. + do irv = 1, 4 + irv4 = irv + irv1 = irvnxt(irv4) + ipv4 = this%irectvert(irv4) + ipv1 = this%irectvert(irv1) + x4 = this%defn%polyvert(1, ipv4) + y4 = this%defn%polyvert(2, ipv4) + x1 = this%defn%polyvert(1, ipv1) + y1 = this%defn%polyvert(2, ipv1) + if (x1 .lt. x4) then + irv2 = irvnxt(irv1) + ipv2 = this%irectvert(irv2) + x2 = this%defn%polyvert(1, ipv2) + if (x2 .le. x1) return + else if (y1 .ge. y4) then + irv2 = irvnxt(irv1) + ipv2 = this%irectvert(irv2) + y2 = this%defn%polyvert(2, ipv2) + if (y2 .gt. y1) return + end if + end do + end function get_irectvertSW + + !> @brief Get rectangular cell dimensions and rotation + !! + !! Compute rectangular dimensions and rotation of + !! the cell using the specified rectangle vertex + !! as the origin + !< + subroutine get_rectDimensionsRotation(this, irv1, xOrigin, yOrigin, zOrigin, & + dx, dy, dz, sinrot, cosrot) + ! -- dummy + class(CellRectQuadType), intent(inout) :: this + integer :: irv1 + double precision :: xOrigin, yOrigin, zOrigin, dx, dy, dz, sinrot, cosrot + ! -- local + integer :: irv2, irv4, ipv1, ipv2, ipv4 + integer, dimension(4) :: irvnxt = (/2, 3, 4, 1/) ! kluge??? + double precision :: x1, y1, x2, y2, x4, y4, dx2, dy2, dx4, dy4 + + ! -- Get rectangle vertex neighbors irv2 and irv4 + irv2 = irvnxt(irv1) + irv4 = irvnxt(irvnxt(irv2)) ! kluge + + ! -- Get model coordinates at irv1, irv2, and irv4 + ipv1 = this%irectvert(irv1) + x1 = this%defn%polyvert(1, ipv1) + y1 = this%defn%polyvert(2, ipv1) + ipv2 = this%irectvert(irv2) + x2 = this%defn%polyvert(1, ipv2) + y2 = this%defn%polyvert(2, ipv2) + ipv4 = this%irectvert(irv4) + x4 = this%defn%polyvert(1, ipv4) + y4 = this%defn%polyvert(2, ipv4) + + ! -- Compute rectangle dimensions + xOrigin = x1 + yOrigin = y1 + zOrigin = this%defn%bot + dx2 = x2 - xOrigin + dy2 = y2 - yOrigin + dx4 = x4 - xOrigin + dy4 = y4 - yOrigin + dx = dsqrt(dx4 * dx4 + dy4 * dy4) + dy = dsqrt(dx2 * dx2 + dy2 * dy2) + dz = this%defn%top - zOrigin ! kluge note: need to account for partial saturation + + ! -- Compute sine and cosine of rotation angle (angle between "southern" + ! -- rectangle side irv1-irv4 and the model x axis) + sinrot = dy4 / dx + cosrot = dx4 / dx + end subroutine get_rectDimensionsRotation + + !> @brief Return a rectangle face flow + function get_rectflow(this, iq, irv) result(rectflow) + class(CellRectQuadType), intent(inout) :: this + integer :: iq, irv + double precision :: rectflow + rectflow = this%rectflow(iq, irv) + end function get_rectflow + + !> @brief Return whether a rectangle face is refined + function face_is_refined(this, i) result(is_refined) + ! -- dummy + class(CellRectQuadType), intent(inout) :: this + integer :: i !< face index + logical :: is_refined + + if (this%ipv4irv(2, i) .ne. 0) then + is_refined = .true. + else + is_refined = .false. + end if + end function face_is_refined + +end module CellRectQuadModule diff --git a/src/Solution/ParticleTracker/CellUtil.f90 b/src/Solution/ParticleTracker/CellUtil.f90 new file mode 100644 index 00000000000..0e4eabcf170 --- /dev/null +++ b/src/Solution/ParticleTracker/CellUtil.f90 @@ -0,0 +1,169 @@ +module CellUtilModule + + implicit none + + private + public :: cell_poly_to_rect + public :: cell_poly_to_quad + +contains + + !> @brief Convert CellPoly representation to CellRect if possible + subroutine cell_poly_to_rect(poly, rect) + use ConstantsModule, only: DONE + use CellRectModule, only: CellRectType, create_cell_rect + use CellPolyModule, only: CellPolyType + use CellDefnModule, only: CellDefnType + ! -- dummy + type(CellPolyType), intent(in), pointer :: poly + type(CellRectType), intent(inout), pointer :: rect + ! -- local + type(CellDefnType), pointer :: defn + integer :: ipv, ipv1, ipv2, ipv3, ipv4 + integer, dimension(4) :: ipvnxt = (/2, 3, 4, 1/) + double precision :: x1, y1, x2, y2, x4, y4 + double precision :: dx2, dy2, dx4, dy4, areax, areay, areaz + double precision :: xOrigin, yOrigin, zOrigin, dx, dy, dz, sinrot, cosrot + double precision :: factor, term + + call create_cell_rect(rect) + defn => poly%defn + ! -- kluge note: no check whether conversion is possible; assumes it is + + ! -- Translate and rotate the rectangular cell into local coordinates + ! -- with x varying from 0 to dx and y varying from 0 to dy. Choose the + ! -- "south-west" vertex to be the local origin so that the rotation + ! -- angle is zero if the cell already aligns with the model x and y + ! -- coordinates. The "southwest" vertex is found by finding the vertex + ! -- formed either by (1) an edge over which x decreases (going + ! -- clockwise) followed by an edge over which x does not increase, or + ! -- by (2) an edge over which y does not decrease (again going + ! -- clockwise) followed by an edge over which y increases. In the end, + ! -- ipv1 is the local vertex number (within the cell, taking a value + ! -- of 1, 2, 3, or 4) of the southwest vertex, and ipv2, ipv3, and + ! -- ipv4 are the local vertex numbers of the remaining three vertices + ! -- going clockwise. + do ipv = 1, 4 + ipv4 = ipv + ipv1 = ipvnxt(ipv4) + x4 = defn%polyvert(1, ipv4) + y4 = defn%polyvert(2, ipv4) + x1 = defn%polyvert(1, ipv1) + y1 = defn%polyvert(2, ipv1) + if (x1 .lt. x4) then + ipv2 = ipvnxt(ipv1) + x2 = defn%polyvert(1, ipv2) + if (x2 .le. x1) then + y2 = defn%polyvert(2, ipv2) + exit + end if + else if (y1 .ge. y4) then + ipv2 = ipvnxt(ipv1) + y2 = defn%polyvert(2, ipv2) + if (y2 .gt. y1) then + x2 = defn%polyvert(1, ipv2) + exit + end if + end if + end do + ipv3 = ipvnxt(ipv2) + + ! -- Compute upper bounds on the local coordinates (the rectangular + ! -- dimensions of the cell) and the sine and cosine of the rotation + ! -- angle, and store local origin information + xOrigin = x1 + yOrigin = y1 + zOrigin = defn%bot + dx2 = x2 - xOrigin + dy2 = y2 - yOrigin + dx4 = x4 - xOrigin + dy4 = y4 - yOrigin + dx = dsqrt(dx4 * dx4 + dy4 * dy4) + dy = dsqrt(dx2 * dx2 + dy2 * dy2) + dz = defn%top - zOrigin ! todo: need to account for partial saturation + sinrot = dy4 / dx + cosrot = dx4 / dx + rect%defn = poly%defn + rect%dx = dx + rect%dy = dy + rect%dz = dz + rect%sinrot = sinrot + rect%cosrot = cosrot + rect%xOrigin = xOrigin + rect%yOrigin = yOrigin + rect%zOrigin = zOrigin + rect%ipvOrigin = ipv1 + + ! -- Compute (unscaled) cell edge velocities from face flows + areax = dx * dz + areay = dy * dz + areaz = dx * dy + factor = DONE / (defn%retfactor * defn%porosity) + term = factor / areax + rect%vx1 = defn%faceflow(ipv1) * term + rect%vx2 = -defn%faceflow(ipv3) * term + term = factor / areay + rect%vy1 = defn%faceflow(ipv4) * term + rect%vy2 = -defn%faceflow(ipv2) * term + term = factor / areaz + rect%vz1 = defn%faceflow(6) * term + rect%vz2 = -defn%faceflow(7) * term + end subroutine cell_poly_to_rect + + !> @brief Convert CellPoly representation to CellRectQuad if possible + subroutine cell_poly_to_quad(poly, quad) + use CellRectQuadModule, only: CellRectQuadType, create_cell_rect_quad + use CellPolyModule, only: CellPolyType + use MathUtilModule, only: mod_offset + ! -- dummy + type(CellPolyType), intent(in), pointer :: poly + type(CellRectQuadType), intent(inout), pointer :: quad + ! -- local + integer :: i, irv, isc + double precision :: qhalf, qdisttopbot, q1, q2, q4 + + call create_cell_rect_quad(quad) + call quad%init_from(poly%defn) + ! kluge note: no check whether conversion is possible; assumes it is + ! -- Translate and rotate the rect-quad cell into local coordinates with + ! -- x varying from 0 to dx and y varying from 0 to dy. Choose the "south- + ! -- west" rectangle vertex to be the local origin so that the rotation + ! -- angle is zero if the cell already aligns with the model x and y + ! -- coordinates. + quad%irvOrigin = quad%get_irectvertSW() ! kluge note: no need to pass all that stuff in call below -- set internally in CellRectQuad + call quad%get_rectDimensionsRotation( & + quad%irvOrigin, quad%xOrigin, & + quad%yOrigin, quad%zOrigin, & + quad%dx, quad%dy, & + quad%dz, quad%sinrot, & + quad%cosrot) + + ! -- Set the external and internal face flows used for subcells + do i = 0, 3 + irv = mod_offset(i + quad%irvOrigin, 4, 1) + isc = mod_offset(i + 3, 4, 1) + if (.not. quad%face_is_refined(irv)) then + qhalf = 5d-1 * quad%get_rectflow(1, irv) + quad%qextl2(isc) = qhalf + isc = mod_offset(isc + 1, 4, 1) + quad%qextl1(isc) = qhalf + else + quad%qextl2(isc) = quad%get_rectflow(1, irv) + isc = mod_offset(isc + 1, 4, 1) + quad%qextl1(isc) = quad%get_rectflow(2, irv) + end if + end do + qdisttopbot = 2.5d-1 * (quad%defn%get_distflow() & + + quad%defn%get_botflow() & + + quad%defn%get_topflow()) + q1 = qdisttopbot + quad%qextl1(1) + quad%qextl2(1) + q2 = qdisttopbot + quad%qextl1(2) + quad%qextl2(2) + q4 = qdisttopbot + quad%qextl1(4) + quad%qextl2(4) + quad%qintl(1) = -5d-1 * (q1 + 5d-1 * (q2 - q4)) + quad%qintl(2) = quad%qintl(1) + q1 + quad%qintl(3) = quad%qintl(2) + q2 + quad%qintl(4) = quad%qintl(1) - q4 + quad%qintl(5) = quad%qintl(1) + end subroutine cell_poly_to_quad + +end module CellUtilModule diff --git a/src/Solution/ParticleTracker/Method.f90 b/src/Solution/ParticleTracker/Method.f90 new file mode 100644 index 00000000000..5a0820bc11a --- /dev/null +++ b/src/Solution/ParticleTracker/Method.f90 @@ -0,0 +1,208 @@ +!> @brief Particle tracking strategies +module MethodModule + + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use SubcellModule, only: SubcellType + use ParticleModule + use BaseDisModule, only: DisBaseType + use PrtFmiModule, only: PrtFmiType + use CellModule, only: CellType + use CellDefnModule, only: CellDefnType + use TrackModule, only: TrackFileControlType + use TimeSelectModule, only: TimeSelectType + implicit none + + private + public :: MethodType, get_iatop + + !> @brief Base type for particle tracking methods. + !! + !! The PRT tracking algorithm invokes a "tracking method" for each + !! domain. A domain can be a model, cell in a model, or subcell in + !! a cell. Tracking proceeds recursively, delegating to a possibly + !! arbitrary number of subdomains (currently, only the three above + !! are recognized). A tracking method is responsible for advancing + !! a particle through a domain, delegating to subdomains as needed + !! depending on cell geometry (implementing the strategy pattern). + !< + type, abstract :: MethodType + character(len=40), pointer, public :: type ! method name + logical(LGP), public :: delegates ! whether the method delegates + type(PrtFmiType), pointer, public :: fmi => null() !< ptr to fmi + class(CellType), pointer, public :: cell => null() ! ptr to a cell + class(SubcellType), pointer, public :: subcell => null() ! ptr to a subcell + type(TrackFileControlType), pointer, public :: trackfilectl => null() ! ptr to track file control + type(TimeSelectType), pointer, public :: tracktimes => null() ! ptr to user-defined tracking times + integer(I4B), dimension(:), pointer, contiguous, public :: izone => null() !< pointer to zone numbers + real(DP), dimension(:), pointer, contiguous, public :: flowja => null() !< pointer to intercell flows + real(DP), dimension(:), pointer, contiguous, public :: porosity => null() !< pointer to aquifer porosity + real(DP), dimension(:), pointer, contiguous, public :: retfactor => null() !< pointer to retardation factor + contains + ! Implemented in all subtypes + procedure(apply), deferred :: apply + procedure(destroy), deferred :: destroy + ! Overridden in subtypes that delegate + procedure :: pass + procedure :: load + ! Implemented in this class + procedure :: init + procedure :: track + procedure :: try_pass + procedure :: update + end type MethodType + + abstract interface + subroutine apply(this, particle, tmax) + import DP + import MethodType + import ParticleType + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + end subroutine apply + subroutine destroy(this) + import MethodType + class(MethodType), intent(inout) :: this + end subroutine destroy + end interface + +contains + + subroutine init(this, fmi, cell, subcell, trackfilectl, tracktimes, & + izone, flowja, porosity, retfactor) + class(MethodType), intent(inout) :: this + type(PrtFmiType), intent(in), pointer, optional :: fmi + class(CellType), intent(in), pointer, optional :: cell + class(SubcellType), intent(in), pointer, optional :: subcell + type(TrackFileControlType), intent(in), pointer, optional :: trackfilectl + type(TimeSelectType), intent(in), pointer, optional :: tracktimes + integer(I4B), intent(in), pointer, optional :: izone(:) + real(DP), intent(in), pointer, optional :: flowja(:) + real(DP), intent(in), pointer, optional :: porosity(:) + real(DP), intent(in), pointer, optional :: retfactor(:) + + if (present(fmi)) this%fmi => fmi + if (present(cell)) this%cell => cell + if (present(subcell)) this%subcell => subcell + if (present(trackfilectl)) this%trackfilectl => trackfilectl + if (present(tracktimes)) this%tracktimes => tracktimes + if (present(izone)) this%izone => izone + if (present(flowja)) this%flowja => flowja + if (present(porosity)) this%porosity => porosity + if (present(retfactor)) this%retfactor => retfactor + end subroutine init + + !> @brief Track particle through subdomains + recursive subroutine track(this, particle, level, tmax) + ! dummy + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer(I4B) :: level + real(DP), intent(in) :: tmax + ! local + logical(LGP) :: advancing + integer(I4B) :: nextlevel + class(methodType), pointer :: submethod + + advancing = .true. + nextlevel = level + 1 + do while (advancing) + call this%load(particle, nextlevel, submethod) + call submethod%apply(particle, tmax) + call this%try_pass(particle, nextlevel, advancing) + end do + end subroutine track + + !> @brief Try passing the particle to the next subdomain + subroutine try_pass(this, particle, nextlevel, advancing) + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer(I4B) :: nextlevel + logical(LGP) :: advancing + + ! tracking submethod marked tracking complete? + ! reset domain boundary flag and don't advance + if (.not. particle%advancing) then + particle%iboundary = 0 + advancing = .false. + else + ! otherwise pass particle to next subdomain + ! and if it's on a boundary, stop advancing + call this%pass(particle) + if (particle%iboundary(nextlevel - 1) .ne. 0) & + advancing = .false. + end if + end subroutine try_pass + + !> @brief Load subdomain tracking method (submethod) + subroutine load(this, particle, next_level, submethod) + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer, intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + call pstop(1, "load must be overridden") + end subroutine load + + !> @brief Pass a particle to the next subdomain, internal use only + subroutine pass(this, particle) + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + call pstop(1, "pass must be overridden") + end subroutine pass + + !> @brief Update particle state and check termination conditions + !! + !! Update the particle's properties (e.g. advancing flag, zone number, + !! status). If any termination conditions apply, the particle's status + !! will be set to the appropriate termination value. If any reporting + !! conditions apply, save particle state with the proper reason code. + !< + subroutine update(this, particle, cell_defn) + ! -- modules + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + type(CellDefnType), pointer, intent(inout) :: cell_defn + + particle%izone = cell_defn%izone + if (cell_defn%izone .ne. 0) then + if (particle%istopzone .eq. cell_defn%izone) then + particle%advancing = .false. + particle%istatus = 6 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + end if + else if (cell_defn%inoexitface .ne. 0) then + particle%advancing = .false. + particle%istatus = 5 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + else if (cell_defn%iweaksink .ne. 0) then + if (particle%istopweaksink .ne. 0) then + particle%advancing = .false. + particle%istatus = 3 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + else + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=4) ! reason=4: exited weak sink + end if + end if + end subroutine update + + !> @brief Get the index corresponding to top elevation of a cell in the grid. + !! This is -1 if the cell is in the top layer and 1 otherwise. + function get_iatop(ncpl, icu) result(iatop) + integer(I4B), intent(in) :: ncpl, icu + integer(I4B) :: iatop + + if (icu .le. ncpl) then + iatop = -1 + else + iatop = 1 + end if + end function get_iatop + +end module MethodModule diff --git a/src/Solution/ParticleTracker/MethodCellPassToBot.f90 b/src/Solution/ParticleTracker/MethodCellPassToBot.f90 new file mode 100644 index 00000000000..ce28718113a --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPassToBot.f90 @@ -0,0 +1,61 @@ +module MethodCellPassToBotModule + + use KindModule, only: DP, I4B + use MethodModule, only: MethodType + use CellDefnModule, only: CellDefnType, create_defn + use PrtFmiModule, only: PrtFmiType + use BaseDisModule, only: DisBaseType + use ParticleModule + use CellModule, only: CellType + use SubcellModule, only: SubcellType + use TrackModule, only: TrackFileControlType + implicit none + + private + public :: MethodCellPassToBotType + public :: create_method_cell_ptb + + type, extends(MethodType) :: MethodCellPassToBotType + private + type(CellDefnType), pointer :: defn + contains + procedure, public :: apply => apply_ptb + procedure, public :: destroy + end type MethodCellPassToBotType + +contains + + !> @brief Create a new tracking method + subroutine create_method_cell_ptb(method) + type(MethodCellPassToBotType), pointer :: method + allocate (method) + allocate (method%type) + method%type = "passtobottom" + method%delegates = .false. + call create_defn(method%defn) + end subroutine create_method_cell_ptb + + !> @brief Destroy the tracking method + subroutine destroy(this) + class(MethodCellPassToBotType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy + + !> @brief Pass particle vertically and instantaneously to the cell bottom + subroutine apply_ptb(this, particle, tmax) + ! -- modules + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodCellPassToBotType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + + call this%update(particle, this%defn) + if (.not. particle%advancing) return + particle%z = this%defn%bot + particle%iboundary(2) = this%defn%npolyverts + 2 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=1) ! reason=1: cell transition + end subroutine apply_ptb + +end module MethodCellPassToBotModule diff --git a/src/Solution/ParticleTracker/MethodCellPollock.f90 b/src/Solution/ParticleTracker/MethodCellPollock.f90 new file mode 100644 index 00000000000..08cecf422a6 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPollock.f90 @@ -0,0 +1,201 @@ +module MethodCellPollockModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: DONE + use MethodModule, only: MethodType + use MethodSubcellPoolModule, only: method_subcell_plck, & + method_subcell_tern + use CellRectModule, only: CellRectType, create_cell_rect + use SubcellRectModule, only: SubcellRectType, create_subcell_rect + use ParticleModule, only: ParticleType + use TrackModule, only: TrackFileControlType + implicit none + + private + public :: MethodCellPollockType + public :: create_method_cell_pollock + + type, extends(MethodType) :: MethodCellPollockType + contains + procedure, public :: apply => apply_mcp + procedure, public :: destroy => destroy_mcp + procedure, public :: load => load_mcp + procedure, public :: load_subcell + procedure, public :: pass => pass_mcp + end type MethodCellPollockType + +contains + + !> @brief Create a tracking method + subroutine create_method_cell_pollock(method) + ! -- dummy + type(MethodCellPollockType), pointer :: method + ! -- local + type(CellRectType), pointer :: cell + type(SubcellRectType), pointer :: subcell + + allocate (method) + call create_cell_rect(cell) + method%cell => cell + method%type => method%cell%type + method%delegates = .true. + call create_subcell_rect(subcell) + method%subcell => subcell + end subroutine create_method_cell_pollock + + !> @brief Destroy the tracking method + subroutine destroy_mcp(this) + class(MethodCellPollockType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy_mcp + + !> @brief Load subcell tracking method + subroutine load_mcp(this, particle, next_level, submethod) + ! -- modules + use SubcellModule, only: SubcellType + ! -- dummy + class(MethodCellPollockType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer, intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + + select type (subcell => this%subcell) + type is (SubcellRectType) + call this%load_subcell(particle, subcell) + end select + call method_subcell_plck%init( & + subcell=this%subcell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_subcell_plck + particle%idomain(next_level) = 1 + end subroutine load_mcp + + !> @brief Having exited the lone subcell, pass the particle to the cell face + !! In this case the lone subcell is the cell. + subroutine pass_mcp(this, particle) + ! -- dummy + class(MethodCellPollockType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + ! -- local + integer(I4B) :: exitface + integer(I4B) :: entryface + + exitface = particle%iboundary(3) + ! -- Map subcell exit face to cell face + select case (exitface) ! note: exitFace uses Dave's iface convention + case (0) + entryface = -1 + case (1) + entryface = 1 + case (2) + entryface = 3 + case (3) + entryface = 4 + case (4) + entryface = 2 + case (5) + entryface = 6 ! note: inface=5 same as inface=1 due to wraparound + case (6) + entryface = 7 + end select + if (entryface .eq. -1) then + particle%iboundary(2) = 0 + else + if ((entryface .ge. 1) .and. (entryface .le. 4)) then + ! -- Account for local cell rotation + select type (cell => this%cell) + type is (CellRectType) + entryface = entryface + cell%ipvOrigin - 1 + end select + if (entryface .gt. 4) entryface = entryface - 4 + end if + particle%iboundary(2) = entryface + end if + end subroutine pass_mcp + + !> @brief Apply Pollock's method to a rectangular cell + subroutine apply_mcp(this, particle, tmax) + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodCellPollockType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! -- local + real(DP) :: xOrigin + real(DP) :: yOrigin + real(DP) :: zOrigin + real(DP) :: sinrot + real(DP) :: cosrot + + select type (cell => this%cell) + type is (CellRectType) + ! -- Update particle state, checking whether any reporting or + ! -- termination conditions apply + call this%update(particle, cell%defn) + + ! -- Return early if particle is done advancing + if (.not. particle%advancing) return + + ! -- If the particle is above the top of the cell (which is presumed to + ! -- represent a water table above the cell bottom), pass the particle + ! -- vertically and instantaneously to the cell top elevation and save + ! -- the particle state to output file(s). + if (particle%z > cell%defn%top) then + particle%z = cell%defn%top + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=1) ! reason=1: cell transition + end if + + ! Transform particle location into local cell coordinates + ! (translated and rotated but not scaled relative to model). + ! Transform particle location back to model coordinates, then + ! reset transformation and eliminate accumulated roundoff error. + xOrigin = cell%xOrigin + yOrigin = cell%yOrigin + zOrigin = cell%zOrigin + sinrot = cell%sinrot + cosrot = cell%cosrot + call particle%transform(xOrigin, yOrigin, zOrigin, & + sinrot, cosrot) + call this%track(particle, 2, tmax) ! kluge, hardwired to level 2 + call particle%transform(xOrigin, yOrigin, zOrigin, & + sinrot, cosrot, invert=.true.) + call particle%transform(reset=.true.) + end select + end subroutine apply_mcp + + !> @brief Loads the lone rectangular subcell from the rectangular cell + !! kluge note: is levelNext needed here and in similar "load" routines??? + subroutine load_subcell(this, particle, subcell) ! + ! -- dummy + class(MethodCellPollockType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + type(SubcellRectType), intent(inout) :: subcell + + select type (cell => this%cell) + type is (CellRectType) + ! -- Set subcell number to 1 + subcell%isubcell = 1 + + ! -- Subcell calculations will be done in local subcell coordinates + subcell%dx = cell%dx + subcell%dy = cell%dy + subcell%dz = cell%dz + subcell%sinrot = 0d0 + subcell%cosrot = 1d0 ! kluge note: rethink how/where to store subcell data??? + subcell%xOrigin = 0d0 + subcell%yOrigin = 0d0 + subcell%zOrigin = 0d0 + + ! -- Set subcell edge velocities + subcell%vx1 = cell%vx1 ! kluge note: cell velocities now already account for retfactor and porosity + subcell%vx2 = cell%vx2 + subcell%vy1 = cell%vy1 + subcell%vy2 = cell%vy2 + subcell%vz1 = cell%vz1 + subcell%vz2 = cell%vz2 + end select + end subroutine load_subcell + +end module MethodCellPollockModule diff --git a/src/Solution/ParticleTracker/MethodCellPollockQuad.f90 b/src/Solution/ParticleTracker/MethodCellPollockQuad.f90 new file mode 100644 index 00000000000..8834de4ed6f --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPollockQuad.f90 @@ -0,0 +1,363 @@ +module MethodCellPollockQuadModule + + use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop + use ConstantsModule, only: DONE + use MethodModule, only: MethodType + use MethodSubcellPoolModule, only: method_subcell_plck + use CellRectQuadModule, only: CellRectQuadType, create_cell_rect_quad + use CellDefnModule, only: CellDefnType + use SubcellRectModule, only: SubcellRectType, create_subcell_rect + use ParticleModule, only: ParticleType + use TrackModule, only: TrackFileControlType + implicit none + + private + public :: MethodCellPollockQuadType + public :: create_method_cell_quad + + type, extends(MethodType) :: MethodCellPollockQuadType + contains + procedure, public :: apply => apply_mcpq + procedure, public :: destroy + procedure, public :: load => load_mcpq + procedure, public :: load_subcell + procedure, public :: pass => pass_mcpq + end type MethodCellPollockQuadType + +contains + + !> @brief Create a new tracking method + subroutine create_method_cell_quad(method) + ! -- dummy + type(MethodCellPollockQuadType), pointer :: method + ! -- local + type(CellRectQuadType), pointer :: cell + type(SubcellRectType), pointer :: subcell + + allocate (method) + call create_cell_rect_quad(cell) + method%cell => cell + method%type => method%cell%type + method%delegates = .true. + call create_subcell_rect(subcell) + method%subcell => subcell + end subroutine create_method_cell_quad + + !> @brief Destroy the tracking method + subroutine destroy(this) + class(MethodCellPollockQuadType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy + + !> @brief Load subcell into tracking method + subroutine load_mcpq(this, particle, next_level, submethod) + class(MethodCellPollockQuadType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer, intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + + select type (subcell => this%subcell) + type is (SubcellRectType) + call this%load_subcell(particle, subcell) + end select + call method_subcell_plck%init( & + subcell=this%subcell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_subcell_plck + end subroutine load_mcpq + + !> @brief Pass particle to next subcell if there is one, or to the cell face + subroutine pass_mcpq(this, particle) + ! -- dummy + class(MethodCellPollockQuadType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + ! -- local + integer :: isc, exitFace, npolyverts, inface, infaceoff + + select type (cell => this%cell) + type is (CellRectQuadType) + exitFace = particle%iboundary(3) + isc = particle%idomain(3) + npolyverts = cell%defn%npolyverts + + select case (exitFace) ! kluge note: exitFace uses Dave's iface convention + case (0) + ! -- Subcell interior (cell interior) + inface = -1 + case (1) + select case (isc) + case (1) + ! -- W face, subcell 1 --> E face, subcell 4 (cell interior) + particle%idomain(3) = 4 + particle%iboundary(3) = 2 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (2) + ! -- W face, subcell 2 --> E face, subcell 3 (cell interior) + particle%idomain(3) = 3 + particle%iboundary(3) = 2 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (3) + ! -- W face, subcell 3 (cell face) + inface = 1 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = 0 + case (4) + ! -- W face, subcell 4 (cell face) + inface = 2 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = -1 + end select + case (2) + select case (isc) + case (1) + ! -- E face, subcell 1 (cell face) + inface = 3 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = 0 + case (2) + ! -- E face, subcell 2 (cell face) + inface = 4 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = -1 + case (3) + ! -- E face, subcell 3 --> W face, subcell 2 (cell interior) + particle%idomain(3) = 2 + particle%iboundary(3) = 1 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (4) + ! -- E face, subcell 4 --> W face subcell 1 (cell interior) + particle%idomain(3) = 1 + particle%iboundary(3) = 1 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + end select + case (3) + select case (isc) + case (1) + ! -- S face, subcell 1 --> N face, subcell 2 (cell interior) + particle%idomain(3) = 2 + particle%iboundary(3) = 4 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (2) + ! -- S face, subcell 2 (cell face) + inface = 4 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = 0 + case (3) + ! -- S face, subcell 3 (cell face) + inface = 1 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = -1 + case (4) + ! -- S face, subcell 4 --> N face, subcell 3 (cell interior) + particle%idomain(3) = 3 + particle%iboundary(3) = 4 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + end select + case (4) + select case (isc) + case (1) + ! -- N face, subcell 1 (cell face) + inface = 3 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = -1 + case (2) + ! -- N face, subcell 2 --> S face, subcell 1 (cell interior) + particle%idomain(3) = 1 + particle%iboundary(3) = 3 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (3) + ! -- N face, subcell 3 --> S face, subcell 4 (cell interior) + particle%idomain(3) = 4 + particle%iboundary(3) = 3 + inface = 0 ! kluge note: want Domain(2) unchanged; Boundary(2) = 0 + case (4) + ! -- N face, subcell 4 (cell face) + inface = 2 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + infaceoff = 0 + end select + case (5) + ! -- Subcell bottom (cell bottom) + inface = npolyverts + 2 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + case (6) + ! -- Subcell top (cell top) + inface = npolyverts + 3 ! kluge note: want Domain(2) = -Domain(2); Boundary(2) = inface + end select + if (inface .eq. -1) then + particle%iboundary(2) = 0 + else if (inface .eq. 0) then + particle%iboundary(2) = 0 + else + if ((inface .ge. 1) .and. (inface .le. 4)) then + ! -- Account for local cell rotation + inface = inface + cell%irvOrigin - 1 + if (inface .gt. 4) inface = inface - 4 + inface = cell%irectvert(inface) + infaceoff + if (inface .lt. 1) inface = inface + npolyverts + end if + particle%iboundary(2) = inface + end if + end select + end subroutine pass_mcpq + + !> @brief Solve the quad-rectangular cell via Pollock's method + subroutine apply_mcpq(this, particle, tmax) + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodCellPollockQuadType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! -- local + double precision :: xOrigin, yOrigin, zOrigin, sinrot, cosrot + + select type (cell => this%cell) + type is (CellRectQuadType) + ! -- Update particle state, terminate early if done advancing + call this%update(particle, cell%defn) + if (.not. particle%advancing) return + + ! -- If the particle is above the top of the cell (which is presumed to + ! -- represent a water table above the cell bottom), pass the particle + ! -- vertically and instantaneously to the cell top elevation and save + ! -- the particle state to output file(s). + if (particle%z > cell%defn%top) then + particle%z = cell%defn%top + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=1) ! reason=1: cell transition + end if + + ! -- Transform particle location into local cell coordinates, + ! translated and rotated but not scaled relative to model. + ! Then track particle, transform back to model coordinates, + ! and reset transformation (drop accumulated roundoff error) + xOrigin = cell%xOrigin + yOrigin = cell%yOrigin + zOrigin = cell%zOrigin + sinrot = cell%sinrot + cosrot = cell%cosrot + call particle%transform(xOrigin, yOrigin, zOrigin, & + sinrot, cosrot) + call this%track(particle, 2, tmax) ! kluge, hardwired to level 2 + call particle%transform(xOrigin, yOrigin, zOrigin, & + sinrot, cosrot, invert=.true.) + call particle%transform(reset=.true.) + end select + end subroutine apply_mcpq + + !> @brief Load the rectangular subcell from the rectangular cell + subroutine load_subcell(this, particle, subcell) + ! -- dummy + class(MethodCellPollockQuadType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + class(SubcellRectType), intent(inout) :: subcell + ! -- local + double precision :: dx, dy, dz, areax, areay, areaz + double precision :: dxprel, dyprel + integer :: isc, npolyverts, m1, m2 + double precision :: qextl1, qextl2, qintl1, qintl2 + double precision :: factor, term + + select type (cell => this%cell) + type is (CellRectQuadType) + factor = DONE / cell%defn%retfactor + factor = factor / cell%defn%porosity + npolyverts = cell%defn%npolyverts + + isc = particle%idomain(3) + ! -- Subcells 1, 2, 3, and 4 are Pollock's subcells A, B, C, and D, + ! -- respectively + + dx = cell%dx + dy = cell%dy + ! -- If not already known, determine subcell number + if (isc .le. 0) then + dxprel = particle%x / dx + dyprel = particle%y / dy + if (dxprel .lt. 5d-1) then + if (dyprel .lt. 5d-1) then + isc = 3 + else if (dyprel .gt. 5d-1) then + isc = 4 + else + ! kluge note: need to resolve this ambiguity based on flow direction + call pstop(1, "particle initially on shared subcell edge") + end if + else if (dxprel .gt. 5d-1) then + if (dyprel .lt. 5d-1) then + isc = 2 + else if (dyprel .gt. 5d-1) then + isc = 1 + else + ! kluge note: need to resolve this ambiguity based on flow direction + call pstop(1, "particle initially on shared subcell edge") + end if + else + ! kluge note: need to resolve this ambiguity based on flow direction + call pstop(1, "particle initially on shared subcell edge") + end if + subcell%isubcell = isc + ! kluge note: as a matter of form, do we want to allow + ! this subroutine to modify the particle??? + particle%idomain(3) = isc + ! kluge note: initial insubface is not currently being determined + end if + dx = 5d-1 * dx + dy = 5d-1 * dy + dz = cell%defn%top - & + cell%defn%bot ! kluge note: need to account for partial saturation + areax = dy * dz + areay = dx * dz + areaz = dx * dy + qintl1 = cell%qintl(isc) + ! qintl list wraps around, so isc+1=5 is ok + qintl2 = cell%qintl(isc + 1) + qextl1 = cell%qextl1(isc) + qextl2 = cell%qextl2(isc) + ! + subcell%dx = dx + subcell%dy = dy + subcell%dz = dz + subcell%sinrot = 0d0 + subcell%cosrot = 1d0 + subcell%zOrigin = 0d0 + select case (isc) + case (1) + subcell%xOrigin = dx + subcell%yOrigin = dy + term = factor / areax + subcell%vx1 = qintl1 * term + subcell%vx2 = -qextl2 * term + term = factor / areay + subcell%vy1 = -qintl2 * term + subcell%vy2 = -qextl1 * term + case (2) + subcell%xOrigin = dx + subcell%yOrigin = 0d0 + term = factor / areax + subcell%vx1 = -qintl2 * term + subcell%vx2 = -qextl1 * term + term = factor / areay + subcell%vy1 = qextl2 * term + subcell%vy2 = -qintl1 * term + case (3) + subcell%xOrigin = 0d0 + subcell%yOrigin = 0d0 + term = factor / areax + subcell%vx1 = qextl2 * term + subcell%vx2 = -qintl1 * term + term = factor / areay + subcell%vy1 = qextl1 * term + subcell%vy2 = qintl2 * term + case (4) + subcell%xOrigin = 0d0 + subcell%yOrigin = dy + term = factor / areax + subcell%vx1 = qextl1 * term + subcell%vx2 = qintl2 * term + term = factor / areay + subcell%vy1 = qintl1 * term + subcell%vy2 = -qextl2 * term + end select + m1 = npolyverts + 2 + m2 = m1 + 1 + term = factor / areaz + subcell%vz1 = 2.5d-1 * cell%defn%faceflow(m1) * term + subcell%vz2 = -2.5d-1 * cell%defn%faceflow(m2) * term + end select + end subroutine load_subcell + +end module MethodCellPollockQuadModule diff --git a/src/Solution/ParticleTracker/MethodCellPool.f90 b/src/Solution/ParticleTracker/MethodCellPool.f90 new file mode 100644 index 00000000000..88a34b710e5 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPool.f90 @@ -0,0 +1,41 @@ +!> @brief Cell-level tracking methods. +module MethodCellPoolModule + + use MethodCellPollockModule + use MethodCellPollockQuadModule + use MethodCellTernaryModule + use MethodCellPassToBotModule + implicit none + + private + public :: create_method_cell_pool + public :: destroy_method_cell_pool + + type(MethodCellPollockType), pointer, public :: method_cell_plck => null() + type(MethodCellPollockQuadType), pointer, public :: method_cell_quad => null() + type(MethodCellTernaryType), pointer, public :: method_cell_tern => null() + type(MethodCellPassToBotType), pointer, public :: method_cell_ptb => null() + +contains + + !> @brief Create the cell method pool + subroutine create_method_cell_pool() + call create_method_cell_pollock(method_cell_plck) + call create_method_cell_quad(method_cell_quad) + call create_method_cell_ternary(method_cell_tern) + call create_method_cell_ptb(method_cell_ptb) + end subroutine create_method_cell_pool + + !> @brief Destroy the cell method pool + subroutine destroy_method_cell_pool() + call method_cell_plck%destroy() + deallocate (method_cell_plck) + call method_cell_quad%destroy() + deallocate (method_cell_quad) + call method_cell_tern%destroy() + deallocate (method_cell_tern) + call method_cell_ptb%destroy() + deallocate (method_cell_ptb) + end subroutine destroy_method_cell_pool + +end module MethodCellPoolModule diff --git a/src/Solution/ParticleTracker/MethodCellTernary.f90 b/src/Solution/ParticleTracker/MethodCellTernary.f90 new file mode 100644 index 00000000000..b84a86d78d2 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellTernary.f90 @@ -0,0 +1,397 @@ +module MethodCellTernaryModule + + use KindModule, only: DP, I4B + use ErrorUtilModule, only: pstop + use MethodModule + use MethodSubcellPoolModule + use CellPolyModule + use CellDefnModule + use SubcellTriModule, only: SubcellTriType, create_subcell_tri + use ParticleModule + use TrackModule, only: TrackFileControlType + use ArrayHandlersModule, only: ExpandArray + implicit none + + private + public :: MethodCellTernaryType + public :: create_method_cell_ternary + + type, extends(MethodType) :: MethodCellTernaryType + private + real(DP), allocatable :: x_vert(:) + real(DP), allocatable :: y_vert(:) !< cell vertex coordinates + real(DP), allocatable :: vx_vert_polygon(:) + real(DP), allocatable :: vy_vert_polygon(:) !< cell vertex velocities + real(DP) :: xctr + real(DP) :: yctr !< cell center coordinates + real(DP) :: vxctr + real(DP) :: vyctr !< cell center velocities + real(DP) :: ztop + real(DP) :: zbot !< cell top and bottom elevations + real(DP) :: dz !< cell thickness + real(DP) :: vztop + real(DP) :: vzbot !< cell top and bottom velocities + integer(I4B), public, pointer :: zeromethod + contains + procedure, public :: apply => apply_mct + procedure, public :: destroy => destroy_mct + procedure, public :: load => load_mct + procedure, public :: load_subcell + procedure, public :: pass => pass_mct + end type MethodCellTernaryType + +contains + + !> @brief Create a tracking method + subroutine create_method_cell_ternary(method) + ! -- dummy + type(MethodCellTernaryType), pointer :: method + ! -- local + type(CellPolyType), pointer :: cell + type(SubcellTriType), pointer :: subcell + + allocate (method) + allocate (method%zeromethod) + call create_cell_poly(cell) + method%cell => cell + method%type => method%cell%type + method%delegates = .true. + call create_subcell_tri(subcell) + method%subcell => subcell + method%zeromethod = 0 + end subroutine create_method_cell_ternary + + !> @brief Destroy the tracking method + subroutine destroy_mct(this) + class(MethodCellTernaryType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy_mct + + !> @brief Load subcell into tracking method + subroutine load_mct(this, particle, next_level, submethod) + ! -- dummy + class(MethodCellTernaryType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer(I4B), intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + + select type (subcell => this%subcell) + type is (SubcellTriType) + call this%load_subcell(particle, subcell) + end select + call method_subcell_tern%init( & + subcell=this%subcell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_subcell_tern + method_subcell_tern%zeromethod = this%zeromethod + end subroutine load_mct + + !> @brief Pass particle to next subcell if there is one, or to the cell face + subroutine pass_mct(this, particle) + ! -- dummy + class(MethodCellTernaryType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + ! local + integer(I4B) :: isc + integer(I4B) :: exitFace + integer(I4B) :: inface + integer(I4B) :: npolyverts + + exitFace = particle%iboundary(3) + isc = particle%idomain(3) + select type (cell => this%cell) + type is (CellPolyType) + npolyverts = cell%defn%npolyverts + end select + + select case (exitFace) + case (0) + ! -- Subcell interior (cell interior) + inface = -1 + case (1) + ! -- Subcell face 1 (cell face) + inface = isc + if (inface .eq. 0) inface = npolyverts + case (2) + ! -- Subcell face --> next subcell in "cycle" (cell interior) + isc = isc + 1 + if (isc .gt. npolyverts) isc = 1 + particle%idomain(3) = isc + particle%iboundary(3) = 3 + inface = 0 + case (3) + ! -- Subcell face --> preceding subcell in "cycle" (cell interior) + isc = isc - 1 + if (isc .lt. 1) isc = npolyverts + particle%idomain(3) = isc + particle%iboundary(3) = 2 + inface = 0 + case (4) + ! -- Subcell bottom (cell bottom) + inface = npolyverts + 2 + case (5) + ! -- Subcell top (cell top) + inface = npolyverts + 3 + end select + if (inface .eq. -1) then + particle%iboundary(2) = 0 + else if (inface .eq. 0) then + particle%iboundary(2) = 0 + else + particle%iboundary(2) = inface + end if + end subroutine pass_mct + + !> @brief Apply the ternary method to a polygonal cell + subroutine apply_mct(this, particle, tmax) + use ConstantsModule, only: DZERO, DONE, DHALF + use TdisModule, only: kper, kstp + ! dummy + class(MethodCellTernaryType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! local + integer(I4B) :: npolyverts + integer(I4B) :: iv + integer(I4B) :: ivp1 + integer(I4B) :: ivm1 + real(DP) :: retfactor + real(DP) :: x0 + real(DP) :: y0 + real(DP) :: x1 + real(DP) :: y1 + real(DP) :: x2 + real(DP) :: y2 + real(DP) :: xsum + real(DP) :: ysum + real(DP) :: vxsum + real(DP) :: vysum + real(DP) :: flow0 + real(DP) :: flow1 + real(DP) :: v0x + real(DP) :: v0y + real(DP) :: d01x + real(DP) :: d01y + real(DP) :: d02x + real(DP) :: d02y + real(DP) :: det + real(DP) :: area + real(DP) :: term + + select type (cell => this%cell) + type is (CellPolyType) + ! -- Update particle state, checking whether any reporting or + ! -- termination conditions apply + call this%update(particle, cell%defn) + + ! -- Return early if particle is done advancing + if (.not. particle%advancing) return + + ! -- If the particle is above the top of the cell (presumed water table) + ! -- pass it vertically and instantaneously to the cell top and save the + ! -- particle state to file + if (particle%z > cell%defn%top) then + particle%z = cell%defn%top + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=1) ! reason=1: cell transition + end if + + npolyverts = cell%defn%npolyverts + if (allocated(this%x_vert)) then + deallocate (this%x_vert) + deallocate (this%y_vert) + deallocate (this%vx_vert_polygon) + deallocate (this%vy_vert_polygon) + end if + allocate (this%x_vert(npolyverts)) + allocate (this%y_vert(npolyverts)) + allocate (this%vx_vert_polygon(npolyverts)) + allocate (this%vy_vert_polygon(npolyverts)) + + xsum = DZERO + ysum = DZERO + vxsum = DZERO + vysum = DZERO + area = DZERO + this%ztop = cell%defn%top + this%zbot = cell%defn%bot + this%dz = this%ztop - this%zbot + do iv = 1, npolyverts + ivp1 = iv + 1 + if (ivp1 .gt. npolyverts) ivp1 = 1 + ivm1 = iv - 1 + if (ivm1 .lt. 1) ivm1 = npolyverts + x0 = cell%defn%polyvert(1, iv) + y0 = cell%defn%polyvert(2, iv) + x2 = cell%defn%polyvert(1, ivp1) + y2 = cell%defn%polyvert(2, ivp1) + x1 = cell%defn%polyvert(1, ivm1) + y1 = cell%defn%polyvert(2, ivm1) + term = DONE / (cell%defn%porosity * this%dz) + flow0 = cell%defn%faceflow(iv) * term + flow1 = cell%defn%faceflow(ivm1) * term + d01x = x1 - x0 ! kluge note: do this more efficiently, not recomputing things so much??? + d01y = y1 - y0 + d02x = x2 - x0 + d02y = y2 - y0 + ! kluge note: can det ever be zero, like maybe for a 180-deg vertex??? + ! oodet = DONE/(d01y*d02x - d02y*d01x) + ! velmult = particle%velmult + ! kluge note: "flow" is volumetric (face) flow rate per unit thickness, divided by porosity + ! v0x = -velmult*oodet*(d02x*flow1 + d01x*flow0) + ! v0y = -velmult*oodet*(d02y*flow1 + d01y*flow0) ! + det = d01y * d02x - d02y * d01x + retfactor = cell%defn%retfactor + ! kluge note: can det ever be zero, like maybe for a 180-deg vertex??? + ! term = velfactor/det + ! kluge note: can det ever be zero, like maybe for a 180-deg vertex??? + term = DONE / (retfactor * det) + ! kluge note: "flow" here is volumetric flow rate (MODFLOW face flow) + v0x = -term * (d02x * flow1 + d01x * flow0) + ! per unit thickness, divided by porosity + v0y = -term * (d02y * flow1 + d01y * flow0) + this%vx_vert_polygon(iv) = v0x + this%vy_vert_polygon(iv) = v0y + xsum = xsum + x0 + ysum = ysum + y0 + vxsum = vxsum + v0x + vysum = vysum + v0y + this%x_vert(iv) = x0 + this%y_vert(iv) = y0 + area = area + x0 * y1 - x1 * y0 + end do + area = area * DHALF + term = DONE / (retfactor * cell%defn%porosity * area) + this%vzbot = cell%defn%faceflow(npolyverts + 2) * term + this%vztop = -cell%defn%faceflow(npolyverts + 3) * term + this%xctr = xsum / dble(npolyverts) + this%yctr = ysum / dble(npolyverts) + this%vxctr = vxsum / dble(npolyverts) + this%vyctr = vysum / dble(npolyverts) + + ! -- Track across subcells + call this%track(particle, 2, tmax) ! kluge, hardwired to level 2 + end select + end subroutine apply_mct + + !> @brief Loads a triangular subcell from the polygonal cell + subroutine load_subcell(this, particle, subcell) + ! -- modules + use ParticleModule, only: get_particle_id + ! -- dummy + class(MethodCellTernaryType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + class(SubcellTriType), intent(inout) :: subcell + ! -- local + integer(I4B) :: ic + integer(I4B) :: isc + integer(I4B) :: npolyverts + integer(I4B) :: iv0 + integer(I4B) :: iv1 + integer(I4B) :: ipv0 + integer(I4B) :: ipv1 + integer(I4B) :: iv + real(DP) :: x0 + real(DP) :: y0 + real(DP) :: x1 + real(DP) :: y1 + real(DP) :: x2 + real(DP) :: y2 + real(DP) :: x1rel + real(DP) :: y1rel + real(DP) :: x2rel + real(DP) :: y2rel + real(DP) :: xi + real(DP) :: yi + real(DP) :: di2 + real(DP) :: d02 + real(DP) :: d12 + real(DP) :: di1 + real(DP) :: d01 + real(DP) :: alphai + real(DP) :: betai + real(DP) :: betatol + + select type (cell => this%cell) + type is (CellPolyType) + ic = cell%defn%icell + subcell%icell = ic + isc = particle%idomain(3) + npolyverts = cell%defn%npolyverts + if (isc .le. 0) then + xi = particle%x + yi = particle%y + do iv = 1, npolyverts + iv0 = iv + iv1 = iv + 1 + if (iv1 .gt. npolyverts) iv1 = 1 + ipv0 = iv0 + ipv1 = iv1 + x0 = this%x_vert(ipv0) + y0 = this%y_vert(ipv0) + x1 = this%x_vert(ipv1) + y1 = this%y_vert(ipv1) + x2 = this%xctr + y2 = this%yctr + x1rel = x1 - x0 + y1rel = y1 - y0 + x2rel = x2 - x0 + y2rel = y2 - y0 + di2 = xi * y2rel - yi * x2rel + d02 = x0 * y2rel - y0 * x2rel + d12 = x1rel * y2rel - y1rel * x2rel + di1 = xi * y1rel - yi * x1rel + d01 = x0 * y1rel - y0 * x1rel + alphai = (di2 - d02) / d12 + betai = -(di1 - d01) / d12 + ! kluge note: can iboundary(2) be used to identify the subcell? + betatol = -1e-7 ! kluge + ! kluge note: think this handles points on triangle boundaries ok + if ((alphai .ge. 0d0) .and. & + (betai .ge. betatol) .and. & + (alphai + betai .le. 1d0)) then + isc = iv ! but maybe not!!!!!!!!!!!! + exit ! kluge note: doesn't handle particle smack on cell center + end if + end do + if (isc .le. 0) then + print *, "error -- initial triangle not found for particle ", & + get_particle_id(particle), " in cell ", ic + call pstop(1) + else + ! subcellTri%isubcell = isc + ! kluge note: as a matter of form, do we want to allow + ! this subroutine to modify the particle??? + particle%idomain(3) = isc + end if + end if + subcell%isubcell = isc + + ! -- Set coordinates and velocities at vertices of triangular subcell + iv0 = isc + iv1 = isc + 1 + if (iv1 .gt. npolyverts) iv1 = 1 + ipv0 = iv0 + ipv1 = iv1 + subcell%x0 = this%x_vert(ipv0) + subcell%y0 = this%y_vert(ipv0) + subcell%x1 = this%x_vert(ipv1) + subcell%y1 = this%y_vert(ipv1) + subcell%x2 = this%xctr + subcell%y2 = this%yctr + subcell%v0x = this%vx_vert_polygon(iv0) + subcell%v0y = this%vy_vert_polygon(iv0) + subcell%v1x = this%vx_vert_polygon(iv1) + subcell%v1y = this%vy_vert_polygon(iv1) + subcell%v2x = this%vxctr + subcell%v2y = this%vyctr + subcell%ztop = this%ztop + subcell%zbot = this%zbot + subcell%dz = this%dz + subcell%vzbot = this%vzbot + subcell%vztop = this%vztop + end select + end subroutine load_subcell + +end module MethodCellTernaryModule diff --git a/src/Solution/ParticleTracker/MethodDis.f90 b/src/Solution/ParticleTracker/MethodDis.f90 new file mode 100644 index 00000000000..b1f9eb17119 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodDis.f90 @@ -0,0 +1,444 @@ +module MethodDisModule + + use KindModule, only: DP, I4B + use ConstantsModule, only: DONE, DZERO + use MethodModule, only: MethodType, get_iatop + use MethodCellPoolModule + use CellDefnModule + use CellRectModule + use ParticleModule + use PrtFmiModule, only: PrtFmiType + use GwfDisModule, only: GwfDisType + use TrackModule, only: TrackFileControlType + use GeomUtilModule, only: get_ijk, get_jk + use ArrayHandlersModule, only: ExpandArray + implicit none + + private + public :: MethodDisType + public :: create_method_dis + + type, extends(MethodType) :: MethodDisType + contains + procedure, public :: apply => apply_dis ! apply the method + procedure, public :: destroy !< destructor for the method + procedure, public :: load => load_dis ! load the method + procedure :: load_cell_defn !< load cell definition from the grid + procedure, public :: pass => pass_dis !< pass the particle to the next domain + procedure, private :: get_top ! get cell top elevation + procedure, private :: load_nbrs_to_defn ! load face neighbors + procedure, private :: load_flows_to_defn ! loads face flows + procedure, private :: load_boundary_flows_to_defn ! loads BoundaryFlows + end type MethodDisType + +contains + + !> @brief Create a new structured grid (DIS) tracking method + subroutine create_method_dis(method) + ! -- dummy + type(MethodDisType), pointer :: method + ! -- local + type(CellRectType), pointer :: cell + + allocate (method) + allocate (method%type) + call create_cell_rect(cell) + method%cell => cell + method%type = "dis" + method%delegates = .true. + end subroutine create_method_dis + + !> @brief Destructor the tracking method + subroutine destroy(this) + class(MethodDisType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy + + !> @brief Load the cell geometry and method (tracking strategy) + subroutine load_dis(this, particle, next_level, submethod) + ! -- dummy + class(MethodDisType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer(I4B), intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + ! -- local + integer(I4B) :: ic + integer(I4B) :: icu + integer(I4B) :: irow + integer(I4B) :: jcol + integer(I4B) :: klay + real(DP) :: areax + real(DP) :: areay + real(DP) :: areaz + real(DP) :: dx + real(DP) :: dy + real(DP) :: dz + real(DP) :: factor + real(DP) :: term + + select type (cell => this%cell) + type is (CellRectType) + select type (dis => this%fmi%dis) + type is (GwfDisType) + ic = particle%idomain(next_level) + call this%load_cell_defn(ic, cell%defn) + + ! -- If cell is active but dry, select and initialize + ! -- pass-to-bottom method and set cell method pointer + if (this%fmi%ibdgwfsat0(ic) == 0) then ! kluge note: use cellDefn%sat == DZERO here instead? + call method_cell_ptb%init( & + cell=this%cell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_ptb + else + ! -- load rectangular cell (todo: refactor into separate routine) + icu = dis%get_nodeuser(ic) + call get_ijk(icu, dis%nrow, dis%ncol, dis%nlay, & + irow, jcol, klay) + dx = dis%delr(jcol) + dy = dis%delc(irow) + dz = cell%defn%top - cell%defn%bot + cell%dx = dx + cell%dy = dy + cell%dz = dz + cell%sinrot = DZERO + cell%cosrot = DONE + cell%xOrigin = cell%defn%polyvert(1, 1) ! kluge note: could avoid using polyvert here + cell%yOrigin = cell%defn%polyvert(2, 1) + cell%zOrigin = cell%defn%bot + cell%ipvOrigin = 1 + areax = dy * dz + areay = dx * dz + areaz = dx * dy + factor = DONE / cell%defn%retfactor + factor = factor / cell%defn%porosity + term = factor / areax + cell%vx1 = cell%defn%faceflow(1) * term + cell%vx2 = -cell%defn%faceflow(3) * term + term = factor / areay + cell%vy1 = cell%defn%faceflow(4) * term + cell%vy2 = -cell%defn%faceflow(2) * term + term = factor / areaz + cell%vz1 = cell%defn%faceflow(6) * term + cell%vz2 = -cell%defn%faceflow(7) * term + + ! -- Select and initialize Pollock's method and set method pointer + call method_cell_plck%init( & + cell=this%cell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_plck + end if + end select + end select + end subroutine load_dis + + !> @brief Pass a particle to the next cell, if there is one + subroutine pass_dis(this, particle) + ! -- modules + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodDisType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + ! -- local + integer(I4B) :: inface + integer(I4B) :: ipos + integer(I4B) :: ic + integer(I4B) :: icu + integer(I4B) :: inbr + integer(I4B) :: idiag + integer(I4B) :: ilay + integer(I4B) :: irow + integer(I4B) :: icol + real(DP) :: z + real(DP) :: zrel + real(DP) :: topfrom + real(DP) :: botfrom + real(DP) :: top + real(DP) :: bot + real(DP) :: sat + + inface = particle%iboundary(2) + z = particle%z + + select type (cell => this%cell) + type is (CellRectType) + select type (dis => this%fmi%dis) + type is (GwfDisType) + inbr = cell%defn%facenbr(inface) + if (inbr .eq. 0) then + ! -- Exterior face; no neighbor to map to + ! particle%idomain(1) = 0 + ! particle%idomain(2) = 0 ! kluge note: set a "has_exited" attribute instead??? + ! particle%idomain(1) = -abs(particle%idomain(1)) ! kluge??? + ! particle%idomain(2) = -abs(particle%idomain(2)) ! kluge??? + particle%istatus = 2 ! kluge note: use -2 to allow check for transfer to another model??? + particle%advancing = .false. + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + ! particle%iboundary(2) = -1 + else + idiag = dis%con%ia(cell%defn%icell) + ipos = idiag + inbr + ic = dis%con%ja(ipos) ! kluge note: use PRT model's DIS instead of fmi's??? + particle%idomain(2) = ic + + ! compute and set user node number and layer on particle + icu = dis%get_nodeuser(ic) + call get_ijk(icu, dis%nrow, dis%ncol, dis%nlay, & + irow, icol, ilay) + particle%icu = icu + particle%ilay = ilay + + ! call this%mapToNbrCell(cellRect%cellDefn,inface,z) + if (inface .eq. 1) then + inface = 3 + else if (inface .eq. 2) then + inface = 4 + else if (inface .eq. 3) then + inface = 1 + else if (inface .eq. 4) then + inface = 2 + else if (inface .eq. 6) then + inface = 7 + else if (inface .eq. 7) then + inface = 6 + end if + particle%iboundary(2) = inface + if (inface < 5) then + ! -- Map z between cells + topfrom = cell%defn%top + botfrom = cell%defn%bot + zrel = (z - botfrom) / (topfrom - botfrom) + top = dis%top(ic) ! kluge note: use PRT model's DIS instead of fmi's??? + bot = dis%bot(ic) + sat = this%fmi%gwfsat(ic) + z = bot + zrel * sat * (top - bot) + end if + particle%z = z + ! -- Update cell-cell flows of particle mass. + ! Every particle is currently assigned unit mass. + ! -- leaving old cell + this%flowja(ipos) = this%flowja(ipos) - DONE + ! -- entering new cell + this%flowja(dis%con%isym(ipos)) & + = this%flowja(dis%con%isym(ipos)) + DONE + end if + end select + end select + end subroutine pass_dis + + !> @brief Apply the method to a particle + subroutine apply_dis(this, particle, tmax) + class(MethodDisType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + + call this%track(particle, 1, tmax) ! kluge, hardwired to level 1 + end subroutine apply_dis + + !> @brief Returns a top elevation based on index iatop + function get_top(this, iatop) result(top) + class(MethodDisType), intent(inout) :: this + integer, intent(in) :: iatop + double precision :: top + + if (iatop .lt. 0) then + top = this%fmi%dis%top(-iatop) + else + top = this%fmi%dis%bot(iatop) + end if + end function get_top + + !> @brief Loads cell definition from the grid + subroutine load_cell_defn(this, ic, defn) + ! -- dummy + class(MethodDisType), intent(inout) :: this + integer(I4B), intent(in) :: ic + type(CellDefnType), pointer, intent(inout) :: defn + + select type (dis => this%fmi%dis) + type is (GwfDisType) + ! -- Set basic cell properties + defn%icell = ic + defn%npolyverts = 4 ! rectangular cell always has 4 vertices + defn%iatop = get_iatop(dis%get_ncpl(), & + dis%get_nodeuser(ic)) + defn%top = dis%bot(ic) + & + this%fmi%gwfsat(ic) * (dis%top(ic) - dis%bot(ic)) + defn%bot = dis%bot(ic) + defn%sat = this%fmi%gwfsat(ic) + defn%porosity = this%porosity(ic) + defn%retfactor = this%retfactor(ic) + defn%izone = this%izone(ic) + defn%can_be_rect = .true. + defn%can_be_quad = .false. + + ! -- Load cell polygon vertices + call dis%get_polyverts( & + defn%icell, & + defn%polyvert, & + closed=.true.) + + ! -- Load face neighbors + call this%load_nbrs_to_defn(defn) + + ! -- Load 180 degree face indicators + call ExpandArray(defn%ispv180, defn%npolyverts + 1) + defn%ispv180(1:defn%npolyverts + 1) = .false. + + ! -- Load flows (assumes face neighbors already loaded) + call this%load_flows_to_defn(defn) + end select + end subroutine load_cell_defn + + !> @brief Loads face neighbors to cell definition from the grid. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_nbrs_to_defn(this, defn) + ! -- dummy + class(MethodDisType), intent(inout) :: this + type(CellDefnType), pointer, intent(inout) :: defn + ! -- local + integer(I4B) :: ic1 + integer(I4B) :: ic2 + integer(I4B) :: icu1 + integer(I4B) :: icu2 + integer(I4B) :: j1 + integer(I4B) :: iloc + integer(I4B) :: ipos + integer(I4B) :: irow1 + integer(I4B) :: irow2 + integer(I4B) :: jcol1 + integer(I4B) :: jcol2 + integer(I4B) :: klay1 + integer(I4B) :: klay2 + integer(I4B) :: iedgeface + + ! -- Allocate facenbr array + call ExpandArray(defn%facenbr, defn%npolyverts + 3) + + select type (dis => this%fmi%dis) + type is (GwfDisType) + ! -- Load face neighbors + defn%facenbr = 0 + ic1 = defn%icell + icu1 = dis%get_nodeuser(ic1) + call get_ijk(icu1, dis%nrow, dis%ncol, dis%nlay, & + irow1, jcol1, klay1) + call get_jk(icu1, dis%get_ncpl(), dis%nlay, j1, klay1) + do iloc = 1, dis%con%ia(ic1 + 1) - dis%con%ia(ic1) - 1 + ipos = dis%con%ia(ic1) + iloc + if (dis%con%mask(ipos) == 0) cycle ! kluge note: need mask here??? + ic2 = dis%con%ja(ipos) + icu2 = dis%get_nodeuser(ic2) + call get_ijk(icu2, dis%nrow, dis%ncol, dis%nlay, & + irow2, jcol2, klay2) + if (klay2 == klay1) then + ! -- Edge (polygon) face neighbor + if (irow2 > irow1) then + ! Neighbor to the S + iedgeface = 4 ! kluge note: make sure this numbering is consistent with numbering in cell method + else if (jcol2 > jcol1) then + ! Neighbor to the E + iedgeface = 3 + else if (irow2 < irow1) then + ! Neighbor to the N + iedgeface = 2 + else + ! Neighbor to the W + iedgeface = 1 + end if + defn%facenbr(iedgeface) = int(iloc, 1) + else if (klay2 > klay1) then + ! -- Bottom face neighbor + defn%facenbr(defn%npolyverts + 2) = int(iloc, 1) + else + ! -- Top face neighbor + defn%facenbr(defn%npolyverts + 3) = int(iloc, 1) + end if + end do + end select + ! -- List of edge (polygon) faces wraps around + ! todo: why need to wrap around? no analog to "closing" a polygon? + defn%facenbr(defn%npolyverts + 1) = defn%facenbr(1) + end subroutine load_nbrs_to_defn + + !> @brief Load flows into the cell definition. + !! These include face flows and net distributed flows. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_flows_to_defn(this, defn) + ! -- dummy + class(MethodDisType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: m + integer(I4B) :: n + integer(I4B) :: npolyverts + + ic = defn%icell + npolyverts = defn%npolyverts + + ! -- allocate faceflow array + call ExpandArray(defn%faceflow, npolyverts + 3) + + ! -- Load face flows. Note that the faceflow array + ! -- does not get reallocated if it is already allocated + ! -- to a size greater than or equal to npolyverts+3. + defn%faceflow = 0d0 ! kluge note: eventually use DZERO for 0d0 throughout + ! -- As with polygon nbrs, polygon face flows wrap around for + ! -- convenience at position npolyverts+1, and bot and top flows + ! -- are tacked on the end of the list + do m = 1, npolyverts + 3 + n = defn%facenbr(m) + if (n > 0) & + defn%faceflow(m) = this%fmi%gwfflowja(this%fmi%dis%con%ia(ic) + n) + ! if (cellDefn%faceflow(m) < 0d0) defn%inoexitface = 0 + end do + ! -- Add BoundaryFlows to face flows + call this%load_boundary_flows_to_defn(defn) + ! -- Set inoexitface flag + defn%inoexitface = 1 + do m = 1, npolyverts + 3 ! kluge note: can be streamlined with above code + if (defn%faceflow(m) < 0d0) defn%inoexitface = 0 + end do + + ! -- Add up net distributed flow + defn%distflow = this%fmi%SourceFlows(ic) + this%fmi%SinkFlows(ic) + & + this%fmi%StorageFlows(ic) + + ! -- Set weak sink flag + if (this%fmi%SinkFlows(ic) .ne. 0d0) then + defn%iweaksink = 1 + else + defn%iweaksink = 0 + end if + end subroutine load_flows_to_defn + + !> @brief Add boundary flows to the cell definition faceflow array. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_boundary_flows_to_defn(this, defn) + ! -- dummy + class(MethodDisType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ioffset + + ioffset = (defn%icell - 1) * 10 + defn%faceflow(1) = defn%faceflow(1) + & + this%fmi%BoundaryFlows(ioffset + 1) ! kluge note: should these be additive (seems so)??? + defn%faceflow(2) = defn%faceflow(2) + & + this%fmi%BoundaryFlows(ioffset + 2) + defn%faceflow(3) = defn%faceflow(3) + & + this%fmi%BoundaryFlows(ioffset + 3) + defn%faceflow(4) = defn%faceflow(4) + & + this%fmi%BoundaryFlows(ioffset + 4) + defn%faceflow(5) = defn%faceflow(1) + defn%faceflow(6) = defn%faceflow(6) + & + this%fmi%BoundaryFlows(ioffset + 9) + defn%faceflow(7) = defn%faceflow(7) + & + this%fmi%BoundaryFlows(ioffset + 10) + end subroutine load_boundary_flows_to_defn + +end module MethodDisModule diff --git a/src/Solution/ParticleTracker/MethodDisv.f90 b/src/Solution/ParticleTracker/MethodDisv.f90 new file mode 100644 index 00000000000..15781913592 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodDisv.f90 @@ -0,0 +1,786 @@ +module MethodDisvModule + + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use ConstantsModule, only: DONE + use MethodModule, only: MethodType, get_iatop + use MethodCellPoolModule + use CellDefnModule + use CellPolyModule + use ParticleModule + use PrtFmiModule, only: PrtFmiType + use GwfDisvModule, only: GwfDisvType + use ArrayHandlersModule, only: ExpandArray + use TrackModule, only: TrackFileControlType + use GeomUtilModule, only: get_jk + implicit none + + private + public :: MethodDisvType + public :: create_method_disv + + type, extends(MethodType) :: MethodDisvType + integer(I4B), pointer :: zeromethod + contains + procedure, public :: apply => apply_disv ! applies the DISV-grid method + procedure, public :: destroy ! destructor for the method + procedure, public :: load => load_disv ! loads the cell method + procedure, public :: load_cell_defn ! loads cell definition from the grid + procedure, public :: map_neighbor ! maps a location on the cell face to the shared face of a neighbor + procedure, public :: pass => pass_disv ! passes the particle to the next cell + procedure, private :: get_npolyverts ! returns the number of polygon vertices for a cell in the grid + procedure, private :: get_top ! returns top elevation based on index iatop + procedure, private :: load_nbrs_to_defn ! loads face neighbors to a cell object + procedure, private :: load_flags_to_defn ! loads 180-degree vertex indicator to a cell object + procedure, private :: load_flows_to_defn ! loads flows to a cell object + procedure, private :: load_boundary_flows_to_defn_rect ! adds BoundaryFlows from the grid to the faceflow array of a rectangular cell + procedure, private :: load_boundary_flows_to_defn_rect_quad ! adds BoundaryFlows from the grid to the faceflow array of a rectangular-quad cell + procedure, private :: load_boundary_flows_to_defn_poly ! adds BoundaryFlows from the grid to the faceflow array of a polygonal cell + end type MethodDisvType + +contains + + !> @brief Create a new vertex grid (DISV) tracking method + subroutine create_method_disv(method) + ! -- dummy + type(MethodDisvType), pointer :: method + ! -- local + type(CellPolyType), pointer :: cell + + allocate (method) + allocate (method%type) + allocate (method%zeromethod) + call create_cell_poly(cell) + method%cell => cell + method%type = "disv" + method%delegates = .true. + method%zeromethod = 0 + end subroutine create_method_disv + + !> @brief Destroy the tracking method + subroutine destroy(this) + class(MethodDisvType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy + + !> @brief Load the cell and the tracking method + subroutine load_disv(this, particle, next_level, submethod) + use CellModule + use CellRectModule + use CellRectQuadModule + use CellUtilModule + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer(I4B), intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + ! -- local + integer(I4B) :: ic + class(CellType), pointer :: base + type(CellRectType), pointer :: rect + type(CellRectQuadType), pointer :: quad + + select type (cell => this%cell) + type is (CellPolyType) + ! load cell definition + ic = particle%idomain(next_level) ! kluge note: is cell number always known coming in? + call this%load_cell_defn(ic, cell%defn) + if (this%fmi%ibdgwfsat0(ic) == 0) then ! kluge note: use cellDefn%sat == DZERO here instead? + ! -- Cell is active but dry, so select and initialize pass-to-bottom + ! -- cell method and set cell method pointer + call method_cell_ptb%init( & + cell=this%cell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_ptb + else + ! -- Select and initialize cell method and set cell method pointer + if (cell%defn%can_be_rect) then + call cell_poly_to_rect(cell, rect) + base => rect + call method_cell_plck%init( & + cell=base, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_plck + else if (cell%defn%can_be_quad) then + call cell_poly_to_quad(cell, quad) + base => quad + call method_cell_quad%init( & + cell=base, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_quad + else + call method_cell_tern%init( & + cell=this%cell, & + trackfilectl=this%trackfilectl, & + tracktimes=this%tracktimes) + submethod => method_cell_tern + method_cell_tern%zeromethod = this%zeromethod + end if + end if + end select + end subroutine load_disv + + !> @brief Pass a particle to the next cell, if there is one + subroutine pass_disv(this, particle) + ! -- modules + use GwfDisvModule, only: GwfDisvType + use TdisModule, only: kper, kstp + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + ! -- local + integer(I4B) :: inface + integer(I4B) :: ipos + integer(I4B) :: ic + integer(I4B) :: icu + integer(I4B) :: inbr + integer(I4B) :: idiag + integer(I4B) :: icpl + integer(I4B) :: ilay + real(DP) :: z + + inface = particle%iboundary(2) + z = particle%z + + select type (cell => this%cell) + type is (CellPolyType) + select type (dis => this%fmi%dis) + type is (GwfDisvType) + inbr = cell%defn%facenbr(inface) + if (inbr .eq. 0) then + ! -- Exterior face; no neighbor to map to + ! particle%idomain(1) = 0 + ! particle%idomain(2) = 0 ! kluge note: "has_exited" attribute instead??? + ! particle%idomain(1) = -abs(particle%idomain(1)) ! kluge??? + ! particle%idomain(2) = -abs(particle%idomain(2)) ! kluge??? + particle%istatus = 2 ! kluge note, todo: use -2 to check for transfer to another model??? + particle%advancing = .false. + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + ! particle%iboundary(2) = -1 + else + idiag = dis%con%ia(cell%defn%icell) + ipos = idiag + inbr + ic = dis%con%ja(ipos) ! kluge note, todo: use PRT model's DIS instead of fmi's?? + particle%idomain(2) = ic + + ! compute and set user node number and layer on particle + icu = dis%get_nodeuser(ic) + call get_jk(icu, dis%ncpl, dis%nlay, icpl, ilay) + particle%icu = icu + particle%ilay = ilay + + call this%map_neighbor(cell%defn, inface, z) + particle%iboundary(2) = inface + particle%idomain(3:) = 0 + particle%iboundary(3:) = 0 + particle%z = z + ! -- Update cell-cell flows of particle mass. + ! Every particle is currently assigned unit mass. + ! -- leaving old cell + this%flowja(ipos) = this%flowja(ipos) - DONE + ! -- entering new cell + this%flowja(dis%con%isym(ipos)) & + = this%flowja(dis%con%isym(ipos)) + DONE + end if + end select + end select + end subroutine pass_disv + + !> @brief Map location on cell face to shared cell face of neighbor + subroutine map_neighbor(this, defn, inface, z) + ! dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), pointer, intent(inout) :: defn + integer(I4B), intent(inout) :: inface + double precision, intent(inout) :: z + ! local + integer(I4B) :: icin + integer(I4B) :: npolyvertsin + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: inbr + integer(I4B) :: inbrnbr + integer(I4B) :: j + integer(I4B) :: m + real(DP) :: zrel + real(DP) :: topfrom + real(DP) :: botfrom + real(DP) :: top + real(DP) :: bot + real(DP) :: sat + type(CellDefnType), pointer :: cd + + ! -- Map to shared cell face of neighbor + inbr = defn%facenbr(inface) + if (inbr .eq. 0) then ! kluge note: redundant check + ! -- Exterior face; no neighbor to map to + inface = -1 ! kluge??? + else + ! -- Load definition for neighbor cell (neighbor with shared face) + icin = defn%icell + j = this%fmi%dis%con%ia(icin) + ic = this%fmi%dis%con%ja(j + inbr) + call create_defn(cd) + ! kluge note: really only need to load facenbr and npolyverts for this + call this%load_cell_defn(ic, cd) ! kluge + npolyvertsin = defn%npolyverts + npolyverts = cd%npolyverts + if (inface .eq. npolyvertsin + 2) then + ! -- Exits through bot, enters through top + inface = npolyverts + 3 + else if (inface .eq. npolyvertsin + 3) then + ! -- Exits through top, enters through bot + inface = npolyverts + 2 + else + ! -- Exits and enters through shared polygon face + j = this%fmi%dis%con%ia(ic) + ! kluge note: use shared_edge in DisvGeom to find shared polygon face??? + do m = 1, npolyverts + 3 + inbrnbr = cd%facenbr(m) + if (this%fmi%dis%con%ja(j + inbrnbr) .eq. icin) then + inface = m + exit + end if + end do + ! -- Map z between cells + topfrom = defn%top + botfrom = defn%bot + zrel = (z - botfrom) / (topfrom - botfrom) + ! kluge note: use PRT model's DIS instead of fmi's??? + top = this%fmi%dis%top(ic) + bot = this%fmi%dis%bot(ic) + sat = this%fmi%gwfsat(ic) + z = bot + zrel * sat * (top - bot) + end if + deallocate (cd) + end if + end subroutine map_neighbor + + !> @brief Apply the DISV-grid method + subroutine apply_disv(this, particle, tmax) + class(MethodDisvType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + call this%track(particle, 1, tmax) ! kluge, hardwired to level 1 + end subroutine apply_disv + + !> @brief Return the number of polygon vertices for a cell in the grid + function get_npolyverts(this, ic) result(npolyverts) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + integer(I4B), intent(in) :: ic + ! -- local + integer(I4B) :: icu + integer(I4B) :: icu2d + integer(I4B) :: ncpl + ! -- result + integer(I4B) :: npolyverts + + select type (dis => this%fmi%dis) + type is (GwfDisvType) + ncpl = dis%get_ncpl() + icu = dis%get_nodeuser(ic) + icu2d = icu - ((icu - 1) / ncpl) * ncpl ! kluge note: use MOD or MODULO??? + npolyverts = dis%iavert(icu2d + 1) - dis%iavert(icu2d) - 1 + if (npolyverts .le. 0) npolyverts = npolyverts + size(dis%javert) ! kluge??? + end select + end function get_npolyverts + + !> @brief Get top elevation based on index iatop + !! kluge note: not needed??? + function get_top(this, iatop) result(top) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + integer(I4B), intent(in) :: iatop + ! -- result + real(DP) :: top + + if (iatop .lt. 0) then + top = this%fmi%dis%top(-iatop) + else + top = this%fmi%dis%bot(iatop) + end if + end function get_top + + !> @brief Load cell definition from the grid + subroutine load_cell_defn(this, ic, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + integer(I4B), intent(in) :: ic + type(CellDefnType), pointer, intent(inout) :: defn + ! -- local + real(DP) :: top + real(DP) :: bot + real(DP) :: sat + + ! -- Load basic cell properties + defn%icell = ic + defn%npolyverts = this%get_npolyverts(ic) + defn%iatop = get_iatop(this%fmi%dis%get_ncpl(), & + this%fmi%dis%get_nodeuser(ic)) + top = this%fmi%dis%top(ic) + bot = this%fmi%dis%bot(ic) + sat = this%fmi%gwfsat(ic) + top = bot + sat * (top - bot) + defn%top = top + defn%bot = bot + defn%sat = sat + defn%porosity = this%porosity(ic) + defn%retfactor = this%retfactor(ic) + defn%izone = this%izone(ic) + + ! -- Load polygon vertices + call this%fmi%dis%get_polyverts( & + defn%icell, & + defn%polyvert, & + closed=.true.) + + ! -- Load face neighbors + call this%load_nbrs_to_defn(defn) + + ! -- Load 180-degree indicator + call this%load_flags_to_defn(defn) + + ! -- Load flows (assumes face neighbors already loaded) + call this%load_flows_to_defn(defn) + end subroutine load_cell_defn + + !> @brief Loads face neighbors to cell definition from the grid + !! Assumes cell index and number of vertices are already loaded. + subroutine load_nbrs_to_defn(this, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), pointer, intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: ic1 + integer(I4B) :: ic2 + integer(I4B) :: icu1 + integer(I4B) :: icu2 + integer(I4B) :: j1 + integer(I4B) :: j2 + integer(I4B) :: k1 + integer(I4B) :: k2 + integer(I4B) :: iloc + integer(I4B) :: ipos + integer(I4B) :: istart1 + integer(I4B) :: istart2 + integer(I4B) :: istop1 + integer(I4B) :: istop2 + integer(I4B) :: iedgeface + integer(I4B) :: ncpl + + ic = defn%icell + npolyverts = defn%npolyverts + + ! -- allocate facenbr array + call ExpandArray(defn%facenbr, npolyverts + 3) + + select type (dis => this%fmi%dis) + type is (GwfDisvType) + ! -- Load face neighbors. + defn%facenbr = 0 + ic1 = ic + icu1 = dis%get_nodeuser(ic1) + ncpl = dis%get_ncpl() + call get_jk(icu1, ncpl, dis%nlay, j1, k1) + istart1 = dis%iavert(j1) + istop1 = dis%iavert(j1 + 1) - 1 + do iloc = 1, dis%con%ia(ic1 + 1) - dis%con%ia(ic1) - 1 + ipos = dis%con%ia(ic1) + iloc + if (dis%con%mask(ipos) == 0) cycle ! kluge note: need mask here??? + ic2 = dis%con%ja(ipos) + icu2 = dis%get_nodeuser(ic2) + call get_jk(icu2, ncpl, dis%nlay, j2, k2) + istart2 = dis%iavert(j2) + istop2 = dis%iavert(j2 + 1) - 1 + call shared_edgeface(dis%javert(istart1:istop1), & + dis%javert(istart2:istop2), & + iedgeface) + if (iedgeface /= 0) then + ! -- Edge (polygon) face neighbor + defn%facenbr(iedgeface) = int(iloc, 1) + else + if (k2 > k1) then + ! -- Bottom face neighbor + defn%facenbr(npolyverts + 2) = int(iloc, 1) + else if (k2 < k1) then + ! -- Top face neighbor + defn%facenbr(npolyverts + 3) = int(iloc, 1) + else + call pstop(1, "k2 should be <> k1, since no shared edge face") + end if + end if + end do + end select + ! -- List of edge (polygon) faces wraps around + defn%facenbr(npolyverts + 1) = defn%facenbr(1) + + end subroutine load_nbrs_to_defn + + !> @brief Find the edge face shared by two cells + !! + !! Find the shared edge face of cell1 shared by cell1 and cell2. + !! isharedface will return with 0 if there is no shared edge + !! face. Proceed forward through ivlist1 and backward through + !! ivlist2 as a clockwise face in cell1 must correspond to a + !! counter clockwise face in cell2. + !! + !! kluge note: based on DisvGeom shared_edge + !< + subroutine shared_edgeface(ivlist1, ivlist2, iedgeface) + integer(I4B), dimension(:) :: ivlist1 + integer(I4B), dimension(:) :: ivlist2 + integer(I4B), intent(out) :: iedgeface + integer(I4B) :: nv1 + integer(I4B) :: nv2 + integer(I4B) :: il1 + integer(I4B) :: il2 + logical(LGP) :: found + + found = .false. + nv1 = size(ivlist1) + nv2 = size(ivlist2) + iedgeface = 0 + outerloop: do il1 = 1, nv1 - 1 + do il2 = nv2, 2, -1 + if (ivlist1(il1) == ivlist2(il2) .and. & + ivlist1(il1 + 1) == ivlist2(il2 - 1)) then + found = .true. + iedgeface = il1 + exit outerloop + end if + end do + if (found) exit + end do outerloop + end subroutine shared_edgeface + + !> @brief Load flows into the cell definition. + !! These include face flows and net distributed flows. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_flows_to_defn(this, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: m + integer(I4B) :: n + + ic = defn%icell + npolyverts = defn%npolyverts + + ! -- allocate faceflow array + call ExpandArray(defn%faceflow, npolyverts + 3) + + ! -- Load face flows. Note that the faceflow array + ! -- does not get reallocated if it is already allocated + ! -- to a size greater than or equal to npolyverts+3. + defn%faceflow = 0d0 + + ! -- As with polygon nbrs, polygon face flows wrap around for + ! -- convenience at position npolyverts+1, and bot and top flows + ! -- are tacked on the end of the list + do m = 1, npolyverts + 3 + n = defn%facenbr(m) + if (n > 0) & + defn%faceflow(m) = this%fmi%gwfflowja(this%fmi%dis%con%ia(ic) + n) + end do + call this%load_boundary_flows_to_defn_poly(defn) + ! -- Set inoexitface flag + defn%inoexitface = 1 + do m = 1, npolyverts + 3 ! kluge note: can be streamlined with above code + if (defn%faceflow(m) < 0d0) defn%inoexitface = 0 + end do + + ! -- Add up net distributed flow + defn%distflow = this%fmi%SourceFlows(ic) + this%fmi%SinkFlows(ic) + & + this%fmi%StorageFlows(ic) + + ! -- Set weak sink flag + if (this%fmi%SinkFlows(ic) .ne. 0d0) then + defn%iweaksink = 1 + else + defn%iweaksink = 0 + end if + + end subroutine load_flows_to_defn + + !> @brief Load boundary flows from the grid into a rectangular cell. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_boundary_flows_to_defn_rect(this, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: ioffset + + ic = defn%icell + npolyverts = defn%npolyverts + + ! kluge note - assignment of BoundaryFlows to faceflow below assumes vertex 1 + ! is at upper left of rectangular cell, and BoundaryFlows use old iface order + ! ioffset = (ic - 1)*6 + ioffset = (ic - 1) * 10 + ! kluge note: should these be additive (seems so)??? + defn%faceflow(1) = defn%faceflow(1) + & + this%fmi%BoundaryFlows(ioffset + 4) + defn%faceflow(2) = defn%faceflow(2) + & + this%fmi%BoundaryFlows(ioffset + 2) + defn%faceflow(3) = defn%faceflow(3) + & + this%fmi%BoundaryFlows(ioffset + 3) + defn%faceflow(4) = defn%faceflow(4) + & + this%fmi%BoundaryFlows(ioffset + 1) + defn%faceflow(5) = defn%faceflow(1) + defn%faceflow(6) = defn%faceflow(6) + & + this%fmi%BoundaryFlows(ioffset + 9) + defn%faceflow(7) = defn%faceflow(7) + & + this%fmi%BoundaryFlows(ioffset + 10) + + end subroutine load_boundary_flows_to_defn_rect + + !> @brief Load boundary flows from the grid into rectangular quadcell. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_boundary_flows_to_defn_rect_quad(this, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: m + integer(I4B) :: n + integer(I4B) :: nn + integer(I4B) :: ioffset + integer(I4B) :: nbf + integer(I4B) :: m1 + integer(I4B) :: m2 + integer(I4B) :: mdiff + real(DP) :: qbf + integer(I4B) :: irectvert(5) ! kluge + + ic = defn%icell + npolyverts = defn%npolyverts + + ! kluge note - assignment of BoundaryFlows to faceflow below assumes vertex 1 + ! is at upper left of rectangular cell, and BoundaryFlows use old iface order + ! ioffset = (ic - 1)*6 + ioffset = (ic - 1) * 10 + ! -- Polygon faces in positions 1 through npolyverts + do n = 1, 4 + if (n .eq. 2) then + nbf = 4 + else if (n .eq. 4) then + nbf = 1 + else + nbf = n + end if + qbf = this%fmi%BoundaryFlows(ioffset + nbf) + nn = 0 ! kluge ... + do m = 1, npolyverts + if (.not. defn%ispv180(m)) then + nn = nn + 1 + irectvert(nn) = m + end if + end do + irectvert(5) = irectvert(1) ! ... kluge + m1 = irectvert(n) + m2 = irectvert(n + 1) + if (m2 .lt. m1) m2 = m2 + npolyverts + mdiff = m2 - m1 + if (mdiff .eq. 1) then + ! -- Assign BoundaryFlow to corresponding polygon face + defn%faceflow(m1) = defn%faceflow(m1) + qbf + else + ! -- Split BoundaryFlow between two faces on quad-refined edge + qbf = 5d-1 * qbf + defn%faceflow(m1) = defn%faceflow(m1) + qbf + defn%faceflow(m1 + 1) = defn%faceflow(m1 + 1) + qbf + end if + end do + ! -- Wrap around to 1 in position npolyverts+1 + m = npolyverts + 1 + defn%faceflow(m) = defn%faceflow(1) + ! -- Bottom in position npolyverts+2 + m = m + 1 + defn%faceflow(m) = defn%faceflow(m) + & + this%fmi%BoundaryFlows(ioffset + 9) + ! -- Top in position npolyverts+3 + m = m + 1 + defn%faceflow(m) = defn%faceflow(m) + & + this%fmi%BoundaryFlows(ioffset + 10) + + end subroutine load_boundary_flows_to_defn_rect_quad + + !> @brief Load boundary flows from the grid into a polygonal cell. + !! Assumes cell index and number of vertices are already loaded. + subroutine load_boundary_flows_to_defn_poly(this, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), intent(inout) :: defn + ! -- local + integer(I4B) :: ic + integer(I4B) :: npolyverts + integer(I4B) :: ioffset + integer(I4B) :: iv + + ic = defn%icell + npolyverts = defn%npolyverts + + ! kluge note: hardwired for max 8 polygon faces plus top and bottom for now + ioffset = (ic - 1) * 10 + do iv = 1, npolyverts + ! kluge note: should these be additive (seems so)??? + defn%faceflow(iv) = & + defn%faceflow(iv) + & + this%fmi%BoundaryFlows(ioffset + iv) + end do + defn%faceflow(npolyverts + 1) = defn%faceflow(1) + defn%faceflow(npolyverts + 2) = & + defn%faceflow(npolyverts + 2) + & + this%fmi%BoundaryFlows(ioffset + 9) + defn%faceflow(npolyverts + 3) = & + defn%faceflow(npolyverts + 3) + & + this%fmi%BoundaryFlows(ioffset + 10) + + end subroutine load_boundary_flows_to_defn_poly + + !> @brief Load 180-degree vertex indicator array and set flags + !! indicating how cell can be represented (kluge: latter needed?). + !! Assumes cell index and number of vertices are already loaded. + subroutine load_flags_to_defn(this, defn) ! kluge note: rename??? + ! -- dummy + class(MethodDisvType), intent(inout) :: this + type(CellDefnType), pointer, intent(inout) :: defn + ! -- local + integer(I4B) :: npolyverts + integer(I4B) :: m + integer(I4B) :: m0 + integer(I4B) :: m1 + integer(I4B) :: m2 + integer(I4B) :: ic + integer(I4B) :: num90 + integer(I4B) :: num180 + integer(I4B) :: numacute + real(DP) :: x0 + real(DP) :: y0 + real(DP) :: x1 + real(DP) :: y1 + real(DP) :: x2 + real(DP) :: y2 + real(DP) :: epsang + real(DP) :: epslen + real(DP) :: s0x + real(DP) :: s0y + real(DP) :: & + s0mag, s2x, s2y, s2mag, sinang, dotprod + logical(LGP) last180 + + ic = defn%icell + npolyverts = defn%npolyverts + + ! -- allocate ispv180 array + call ExpandArray(defn%ispv180, npolyverts + 1) + + ! -- Load 180-degree indicator. + ! -- Also, set flags that indicate how cell can be represented. + defn%ispv180(1:npolyverts + 1) = .false. + defn%can_be_rect = .false. + defn%can_be_quad = .false. + epsang = 1d-3 ! kluge hardwire, and using one value for all angles + epslen = 1d-3 ! kluge hardwire + num90 = 0 + num180 = 0 + numacute = 0 + last180 = .false. + ! kluge note: assumes non-self-intersecting polygon; + ! no checks for self-intersection (e.g., star) + do m = 1, npolyverts + m1 = m + if (m1 .eq. 1) then + m0 = npolyverts + m2 = 2 + else if (m1 .eq. npolyverts) then + m0 = npolyverts - 1 + m2 = 1 + else + m0 = m1 - 1 + m2 = m1 + 1 + end if + x0 = defn%polyvert(1, m0) + y0 = defn%polyvert(2, m0) + x1 = defn%polyvert(1, m1) + y1 = defn%polyvert(2, m1) + x2 = defn%polyvert(1, m2) + y2 = defn%polyvert(2, m2) + s0x = x0 - x1 + s0y = y0 - y1 + s0mag = dsqrt(s0x * s0x + s0y * s0y) + s2x = x2 - x1 + s2y = y2 - y1 + s2mag = dsqrt(s2x * s2x + s2y * s2y) + sinang = (s0x * s2y - s0y * s2x) / (s0mag * s2mag) + ! kluge note: is it better to check in terms of angle rather than sin{angle}??? + if (dabs(sinang) .lt. epsang) then + dotprod = s0x * s2x + s0y * s2y + if (dotprod .gt. 0d0) then + print *, "Cell ", ic, " has a zero angle" ! kluge + print *, " (tolerance epsang = ", epsang, ")" + call pstop(1) + else + if (last180) then + print *, "Cell ", ic, & + " has consecutive 180-deg angles - not supported" ! kluge + print *, " (tolerance epsang = ", epsang, ")" + call pstop(1) + else if (dabs((s2mag - s0mag) / max(s2mag, s0mag)) .gt. epslen) then + print *, "Cell ", ic, & + " has a non-bisecting 180-deg vertex - not supported" ! kluge + print *, " (tolerance epslen = ", epslen, ")" + call pstop(1) + end if + ! kluge note: want to evaluate 180-deg vertex using one criterion implemented in + ! one place (procedure) to avoid potential disparities between multiple checks + num180 = num180 + 1 + last180 = .true. + defn%ispv180(m) = .true. + end if + else if (sinang .gt. 0d0) then + numacute = numacute + 1 + if (dabs(1d0 - sinang) .lt. epsang) num90 = num90 + 1 + last180 = .false. + else + print *, "Cell ", ic, & + " has an obtuse angle and so is nonconvex" ! kluge + print *, " (tolerance epsang = ", epsang, ")" + call pstop(1) + end if + end do + if ((num90 .ne. 4) .and. (num180 .ne. 0)) then + print *, "Cell ", ic, & + " is a non-rectangle with a 180-deg angle - not supported" ! kluge + print *, " (tolerance epsang = ", epsang, ")" + call pstop(1) + end if + ! -- List of 180-degree indicators wraps around for convenience + defn%ispv180(npolyverts + 1) = defn%ispv180(1) + ! + if (num90 .eq. 4) then + if (num180 .eq. 0) then + defn%can_be_rect = .true. + else + defn%can_be_quad = .true. + end if + end if + + end subroutine load_flags_to_defn + +end module MethodDisvModule diff --git a/src/Solution/ParticleTracker/MethodPool.f90 b/src/Solution/ParticleTracker/MethodPool.f90 new file mode 100644 index 00000000000..810bae266da --- /dev/null +++ b/src/Solution/ParticleTracker/MethodPool.f90 @@ -0,0 +1,30 @@ +!> @brief Model-level tracking methods. +module MethodPoolModule + use MethodModule, only: MethodType + use MethodDisModule, only: MethodDisType, create_method_dis + use MethodDisvModule, only: MethodDisvType, create_method_disv + implicit none + + private + public :: create_method_pool, destroy_method_pool + + type(MethodDisType), pointer, public :: method_dis => null() + type(MethodDisvType), pointer, public :: method_disv => null() + +contains + + !> @brief Create the method pool + subroutine create_method_pool() + call create_method_dis(method_dis) + call create_method_disv(method_disv) + end subroutine create_method_pool + + !> @brief Destroy the method pool + subroutine destroy_method_pool() + call method_dis%destroy() + deallocate (method_dis) + call method_disv%destroy() + deallocate (method_disv) + end subroutine destroy_method_pool + +end module MethodPoolModule diff --git a/src/Solution/ParticleTracker/MethodSubcellPollock.f90 b/src/Solution/ParticleTracker/MethodSubcellPollock.f90 new file mode 100644 index 00000000000..86d01e44ad2 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellPollock.f90 @@ -0,0 +1,452 @@ +module MethodSubcellPollockModule + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use MethodModule, only: MethodType + use SubcellRectModule, only: SubcellRectType, create_subcell_rect + use ParticleModule, only: ParticleType + use PrtFmiModule, only: PrtFmiType + use TrackModule, only: TrackFileControlType + use BaseDisModule, only: DisBaseType + use GwfDisModule, only: GwfDisType + use CellModule, only: CellType + implicit none + private + public :: MethodSubcellPollockType + public :: create_method_subcell_pollock + public :: calculate_dt + + !> @brief Rectangular subcell tracking method + type, extends(MethodType) :: MethodSubcellPollockType + private + real(DP), allocatable, public :: qextl1(:), qextl2(:), qintl(:) !< external and internal subcell flows + contains + procedure, public :: apply => apply_msp + procedure, public :: destroy => destroy_msp + procedure, private :: track_subcell + end type MethodSubcellPollockType + +contains + + !> @brief Create a new Pollock's subcell-method object + subroutine create_method_subcell_pollock(method) + ! -- dummy + type(MethodSubcellPollockType), pointer :: method + ! -- local + type(SubcellRectType), pointer :: subcell + + allocate (method) + call create_subcell_rect(subcell) + method%subcell => subcell + method%type => method%subcell%type + method%delegates = .false. + end subroutine create_method_subcell_pollock + + !> @brief Destructor for a Pollock's subcell-method object + subroutine destroy_msp(this) + class(MethodSubcellPollockType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy_msp + + !> @brief Apply Pollock's method to a rectangular subcell + subroutine apply_msp(this, particle, tmax) + ! -- dummy + class(MethodSubcellPollockType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! -- local + real(DP) :: xOrigin + real(DP) :: yOrigin + real(DP) :: zOrigin + real(DP) :: sinrot + real(DP) :: cosrot + + select type (subcell => this%subcell) + type is (SubcellRectType) + ! -- Transform particle position into local subcell coordinates, + ! track particle across subcell, convert back to model coords + ! (sinrot and cosrot should be 0 and 1, respectively, i.e. no + ! rotation, also no z translation; only x and y translations) + xOrigin = subcell%xOrigin + yOrigin = subcell%yOrigin + zOrigin = subcell%zOrigin + sinrot = subcell%sinrot + cosrot = subcell%cosrot + call particle%transform(xOrigin, yOrigin) + call this%track_subcell(subcell, particle, tmax) + call particle%transform(xOrigin, yOrigin, invert=.true.) + end select + end subroutine apply_msp + + !> @brief Track a particle across a rectangular subcell using Pollock's method + !! + !! This subroutine consists partly of code written by + !! David W. Pollock of the USGS for MODPATH 7. PRT's + !! authors take responsibility for its application in + !! this context and for any modifications or errors. + !< + subroutine track_subcell(this, subcell, particle, tmax) + ! modules + use ParticleModule, only: get_particle_id + use TdisModule, only: kper, kstp + ! dummy + class(MethodSubcellPollockType), intent(inout) :: this + class(SubcellRectType), intent(in) :: subcell + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! local + real(DP) :: vx + real(DP) :: dvxdx + real(DP) :: vy + real(DP) :: dvydy + real(DP) :: vz + real(DP) :: dvzdz + real(DP) :: dtexitx + real(DP) :: dtexity + real(DP) :: dtexitz + real(DP) :: dtexit + real(DP) :: texit + real(DP) :: dt + real(DP) :: t + real(DP) :: t0 + real(DP) :: x + real(DP) :: y + real(DP) :: z + integer(I4B) :: statusVX + integer(I4B) :: statusVY + integer(I4B) :: statusVZ + integer(I4B) :: i + real(DP) :: initialX + real(DP) :: initialY + real(DP) :: initialZ + integer(I4B) :: exitFace + integer(I4B) :: reason + integer(I4B) :: tslice(2) !< user-time slice for the current time step + + reason = -1 + + ! -- Initial particle location in scaled subcell coordinates + initialX = particle%x / subcell%dx + initialY = particle%y / subcell%dy + initialZ = particle%z / subcell%dz + + ! -- Compute time of travel to each possible exit face + statusVX = calculate_dt(subcell%vx1, subcell%vx2, subcell%dx, & + initialX, vx, dvxdx, dtexitx) + statusVY = calculate_dt(subcell%vy1, subcell%vy2, subcell%dy, & + initialY, vy, dvydy, dtexity) + statusVZ = calculate_dt(subcell%vz1, subcell%vz2, subcell%dz, & + initialZ, vz, dvzdz, dtexitz) + + ! -- Subcells should never be strong sinks, contact the developer situation + if ((statusVX .eq. 3) .and. (statusVY .eq. 3) .and. (statusVZ .eq. 3)) then + print *, "Subcell with no exit face:", & + "particle", get_particle_id(particle), & + "cell", particle%idomain(2) + call pstop(1) + end if + + ! -- Determine (earliest) exit face and corresponding travel time to exit + exitFace = 0 + dtexit = 1.0d+30 + if ((statusVX .lt. 2) .or. (statusVY .lt. 2) .or. (statusVZ .lt. 2)) then + ! -- Consider x-oriented faces + dtexit = dtexitx + if (vx .lt. 0d0) then + exitFace = 1 + else if (vx .gt. 0) then + exitFace = 2 + end if + ! -- Consider y-oriented faces + if (dtexity .lt. dtexit) then + dtexit = dtexity + if (vy .lt. 0d0) then + exitFace = 3 + else if (vy .gt. 0d0) then + exitFace = 4 + end if + end if + ! -- Consider z-oriented faces + if (dtexitz .lt. dtexit) then + dtexit = dtexitz + if (vz .lt. 0d0) then + exitFace = 5 + else if (vz .gt. 0d0) then + exitFace = 6 + end if + end if + else + end if + + ! -- Compute exit time + texit = particle%ttrack + dtexit + t0 = particle%ttrack + + ! -- Select user tracking times to solve. If this is the first time step + ! of the simulation, include all times before it begins; if it is the + ! last time step include all times after it ends, otherwise the times + ! within the current period and time step only. + call this%tracktimes%try_advance() + tslice = this%tracktimes%selection + if (all(tslice > 0)) then + do i = tslice(1), tslice(2) + t = this%tracktimes%times(i) + if (t < particle%ttrack .or. t >= texit .or. t >= tmax) cycle + dt = t - t0 + x = new_x(vx, dvxdx, subcell%vx1, subcell%vx2, & + dt, initialX, subcell%dx, statusVX == 1) + y = new_x(vy, dvydy, subcell%vy1, subcell%vy2, & + dt, initialY, subcell%dy, statusVY == 1) + z = new_x(vz, dvzdz, subcell%vz1, subcell%vz2, & + dt, initialZ, subcell%dz, statusVZ == 1) + particle%x = x * subcell%dx + particle%y = y * subcell%dy + particle%z = z * subcell%dz + particle%ttrack = t + particle%istatus = 1 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=5) + end do + end if + + if (texit .gt. tmax) then + ! -- The computed exit time is greater than the maximum time, so set + ! -- final time for particle trajectory equal to maximum time and + ! -- calculate particle location at that final time. + t = tmax + dt = t - t0 + x = new_x(vx, dvxdx, subcell%vx1, subcell%vx2, & + dt, initialX, subcell%dx, statusVX == 1) + y = new_x(vy, dvydy, subcell%vy1, subcell%vy2, & + dt, initialY, subcell%dy, statusVY == 1) + z = new_x(vz, dvzdz, subcell%vz1, subcell%vz2, & + dt, initialZ, subcell%dz, statusVZ == 1) + exitFace = 0 + particle%istatus = 1 + particle%advancing = .false. + reason = 2 ! timestep end + else + ! -- The computed exit time is less than or equal to the maximum time, + ! -- so set final time for particle trajectory equal to exit time and + ! -- calculate exit location. + t = texit + dt = dtexit + if ((exitFace .eq. 1) .or. (exitFace .eq. 2)) then + x = 0d0 + y = new_x(vy, dvydy, subcell%vy1, subcell%vy2, & + dt, initialY, subcell%dy, statusVY == 1) + z = new_x(vz, dvzdz, subcell%vz1, subcell%vz2, & + dt, initialZ, subcell%dz, statusVZ == 1) + if (exitFace .eq. 2) x = 1.0d0 + else if ((exitFace .eq. 3) .or. (exitFace .eq. 4)) then + x = new_x(vx, dvxdx, subcell%vx1, subcell%vx2, dt, & + initialX, subcell%dx, statusVX == 1) + y = 0d0 + z = new_x(vz, dvzdz, subcell%vz1, subcell%vz2, dt, & + initialZ, subcell%dz, statusVZ == 1) + if (exitFace .eq. 4) y = 1.0d0 + else if ((exitFace .eq. 5) .or. (exitFace .eq. 6)) then + x = new_x(vx, dvxdx, subcell%vx1, subcell%vx2, & + dt, initialX, subcell%dx, statusVX == 1) + y = new_x(vy, dvydy, subcell%vy1, subcell%vy2, & + dt, initialY, subcell%dy, statusVY == 1) + z = 0d0 + if (exitFace .eq. 6) z = 1.0d0 + else + print *, "programmer error, invalid exit face", exitFace + call pstop(1) + end if + reason = 1 ! cell transition + end if + + ! -- Set final particle location in local (unscaled) subcell coordinates, + ! -- final time for particle trajectory, and exit face + particle%x = x * subcell%dx + particle%y = y * subcell%dy + particle%z = z * subcell%dz + particle%ttrack = t + particle%iboundary(3) = exitFace + + ! -- Save particle track record + if (reason > -1) & + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=reason) + + end subroutine track_subcell + + !> @brief Calculate particle travel time to exit and exit status. + !! + !! This subroutine consists partly or entirely of code written by + !! David W. Pollock of the USGS for MODPATH 7. The authors of the present + !! code are responsible for its appropriate application in this context + !! and for any modifications or errors. + !< + function calculate_dt(v1, v2, dx, xL, v, dvdx, dt) result(status) + ! dummy + real(DP) :: v1 + real(DP) :: v2 + real(DP) :: dx + real(DP) :: xL + real(DP) :: v + real(DP) :: dvdx + real(DP) :: dt + ! result + integer(I4B) :: status + ! local + real(DP) :: v2a + real(DP) :: v1a + real(DP) :: dv + real(DP) :: dva + real(DP) :: vv + real(DP) :: vvv + real(DP) :: zro + real(DP) :: zrom + real(DP) :: x + real(DP) :: tol + real(DP) :: vr1 + real(DP) :: vr2 + real(DP) :: vr + real(DP) :: v1v2 + logical(LGP) :: noOutflow + + ! -- Initialize variables. + status = -1 + dt = 1.0d+20 + v2a = v2 + if (v2a .lt. 0d0) v2a = -v2a + v1a = v1 + if (v1a .lt. 0d0) v1a = -v1a + dv = v2 - v1 + dva = dv + if (dva .lt. 0d0) dva = -dva + + ! -- Check for a uniform zero velocity in this direction. + ! -- If so, set status = 2 and return (dt = 1.0d+20). + tol = 1.0d-15 + if ((v2a .lt. tol) .and. (v1a .lt. tol)) then + v = 0d0 + dvdx = 0d0 + status = 2 + return + end if + + ! -- Check for uniform non-zero velocity in this direction. + ! -- If so, set compute dt using the constant velocity, + ! -- set status = 1 and return. + vv = v1a + if (v2a .gt. vv) vv = v2a + vvv = dva / vv + if (vvv .lt. 1.0d-4) then + zro = tol + zrom = -zro + v = v1 + x = xL * dx + if (v1 .gt. zro) dt = (dx - x) / v1 + if (v1 .lt. zrom) dt = -x / v1 + dvdx = 0d0 + status = 1 + return + end if + + ! -- Velocity has a linear variation. + ! -- Compute velocity corresponding to particle position. + dvdx = dv / dx + v = (1.0d0 - xL) * v1 + xL * v2 + + ! -- If flow is into the cell from both sides there is no outflow. + ! -- In that case, set status = 3 and return. + noOutflow = .true. + if (v1 .lt. 0d0) noOutflow = .false. + if (v2 .gt. 0d0) noOutflow = .false. + if (noOutflow) then + status = 3 + return + end if + + ! -- If there is a divide in the cell for this flow direction, check to + ! -- see if the particle is located exactly on the divide. If it is, move + ! -- it very slightly to get it off the divide. This avoids possible + ! -- numerical problems related to stagnation points. + if ((v1 .le. 0d0) .and. (v2 .ge. 0d0)) then + if (abs(v) .le. 0d0) then + v = 1.0d-20 + if (v2 .le. 0d0) v = -v + end if + end if + + ! -- If there is a flow divide, this check finds out what side of the + ! -- divide the particle is on and sets the value of vr appropriately + ! -- to reflect that location. + vr1 = v1 / v + vr2 = v2 / v + vr = vr1 + if (vr .le. 0d0) then + vr = vr2 + end if + + ! -- If the product v1*v2 > 0, the velocity is in the same direction + ! -- throughout the cell (i.e. no flow divide). If so, set the value + ! -- of vr to reflect the appropriate direction. + v1v2 = v1 * v2 + if (v1v2 .gt. 0d0) then + if (v .gt. 0d0) vr = vr2 + if (v .lt. 0d0) vr = vr1 + end if + + ! -- Check if vr is (very close to) zero. + ! -- If so, set status = 2 and return (dt = 1.0d+20). + if (dabs(vr) .lt. 1.0d-10) then + v = 0d0 + dvdx = 0d0 + status = 2 + return + end if + + ! -- Compute travel time to exit face. Return with status = 0. + dt = log(vr) / dvdx + status = 0 + + end function calculate_dt + + !> @brief Update a cell-local coordinate based on a time increment. + !! + !! This subroutine consists partly or entirely of code written by + !! David W. Pollock of the USGS for MODPATH 7. The authors of the present + !! code are responsible for its appropriate application in this context + !! and for any modifications or errors. + !< + pure function new_x(v, dvdx, v1, v2, dt, x, dx, velocity_profile) result(newx) + ! dummy + real(DP), intent(in) :: v + real(DP), intent(in) :: dvdx + real(DP), intent(in) :: v1 + real(DP), intent(in) :: v2 + real(DP), intent(in) :: dt + real(DP), intent(in) :: x + real(DP), intent(in) :: dx + logical(LGP), intent(in), optional :: velocity_profile + ! result + real(DP) :: newx + logical(LGP) :: lprofile + + ! -- process optional arguments + if (present(velocity_profile)) then + lprofile = velocity_profile + else + lprofile = .false. + end if + + ! -- recompute coordinate + newx = x + if (lprofile) then + newx = newx + (v1 * dt / dx) + else if (v .ne. 0d0) then + newx = newx + (v * (exp(dvdx * dt) - 1.0d0) / dvdx / dx) + end if + + ! -- clamp to [0, 1] + if (newx .lt. 0d0) newx = 0d0 + if (newx .gt. 1.0d0) newx = 1.0d0 + + end function new_x + +end module MethodSubcellPollockModule diff --git a/src/Solution/ParticleTracker/MethodSubcellPool.f90 b/src/Solution/ParticleTracker/MethodSubcellPool.f90 new file mode 100644 index 00000000000..cb07ac34b2f --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellPool.f90 @@ -0,0 +1,31 @@ +!> @brief Subcell-level tracking methods. +module MethodSubcellPoolModule + + use MethodSubcellPollockModule + use MethodSubcellTernaryModule + implicit none + + private + public :: create_method_subcell_pool + public :: destroy_method_subcell_pool + + type(MethodSubcellPollockType), pointer, public :: method_subcell_plck => null() + type(MethodSubcellTernaryType), pointer, public :: method_subcell_tern => null() + +contains + + !> @brief Create the subcell method pool + subroutine create_method_subcell_pool() + call create_method_subcell_pollock(method_subcell_plck) + call create_method_subcell_ternary(method_subcell_tern) + end subroutine create_method_subcell_pool + + !> @brief Destroy the subcell method pool + subroutine destroy_method_subcell_pool() + call method_subcell_plck%destroy() + deallocate (method_subcell_plck) + call method_subcell_tern%destroy() + deallocate (method_subcell_tern) + end subroutine destroy_method_subcell_pool + +end module MethodSubcellPoolModule diff --git a/src/Solution/ParticleTracker/MethodSubcellTernary.f90 b/src/Solution/ParticleTracker/MethodSubcellTernary.f90 new file mode 100644 index 00000000000..04a7151449c --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellTernary.f90 @@ -0,0 +1,495 @@ +module MethodSubcellTernaryModule + use KindModule, only: DP, I4B, LGP + use ErrorUtilModule, only: pstop + use GeomUtilModule, only: skew + use MethodModule, only: MethodType + use CellModule, only: CellType + use SubcellModule, only: SubcellType + use SubcellTriModule, only: SubcellTriType, create_subcell_tri + use ParticleModule, only: ParticleType, get_particle_id + use TrackModule, only: TrackFileControlType + use TernarySolveTrack, only: traverse_triangle, step_analytical, canonical + use PrtFmiModule, only: PrtFmiType + use BaseDisModule, only: DisBaseType + use GwfDisvModule, only: GwfDisvType + implicit none + + private + public :: MethodSubcellTernaryType + public :: create_method_subcell_ternary + + !> @brief Ternary triangular subcell tracking method + type, extends(MethodType) :: MethodSubcellTernaryType + integer(I4B), public, pointer :: zeromethod + contains + procedure, public :: apply => apply_mst + procedure, public :: destroy + procedure, private :: track_subcell + end type MethodSubcellTernaryType + +contains + + !> @brief Create a new ternary subcell-method object + subroutine create_method_subcell_ternary(method) + ! -- dummy + type(MethodSubcellTernaryType), pointer :: method + ! -- local + type(SubcellTriType), pointer :: subcell + + allocate (method) + allocate (method%zeromethod) + call create_subcell_tri(subcell) + method%subcell => subcell + method%type => method%subcell%type + method%delegates = .false. + method%zeromethod = 0 + end subroutine create_method_subcell_ternary + + !> @brief Destructor for a ternary subcell-method object + subroutine destroy(this) + class(MethodSubcellTernaryType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy + + !> @brief Apply the ternary subcell method + subroutine apply_mst(this, particle, tmax) + class(MethodSubcellTernaryType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + + select type (subcell => this%subcell) + type is (SubcellTriType) + call this%track_subcell(subcell, particle, tmax) + end select + end subroutine apply_mst + + !> @brief Track a particle across a triangular subcell using the ternary method + subroutine track_subcell(this, subcell, particle, tmax) + ! modules + use TdisModule, only: kper, kstp + ! dummy + class(MethodSubcellTernaryType), intent(inout) :: this + class(SubcellTriType), intent(in) :: subcell + type(ParticleType), pointer, intent(inout) :: particle + real(DP), intent(in) :: tmax + ! local + integer(I4B) :: exitFace + logical(LGP) :: lbary ! kluge + real(DP) :: x0 + real(DP) :: y0 + real(DP) :: x1 + real(DP) :: y1 + real(DP) :: x2 + real(DP) :: y2 + real(DP) :: v0x + real(DP) :: v0y + real(DP) :: v1x + real(DP) :: v1y + real(DP) :: v2x + real(DP) :: v2y + real(DP) :: xi + real(DP) :: yi + real(DP) :: zi + real(DP) :: zirel + real(DP) :: ztop + real(DP) :: zbot + real(DP) :: dz + real(DP) :: rxx + real(DP) :: rxy + real(DP) :: ryx + real(DP) :: ryy + real(DP) :: sxx + real(DP) :: sxy + real(DP) :: syy + real(DP) :: rot(2, 2), res(2), loc(2) + real(DP) :: alp + real(DP) :: bet + real(DP) :: alp0 + real(DP) :: bet0 + real(DP) :: alp1 + real(DP) :: bet1 + real(DP) :: alp2 + real(DP) :: bet2 + real(DP) :: alpi + real(DP) :: beti + real(DP) :: vzbot + real(DP) :: vztop + real(DP) :: vzi + real(DP) :: vziodz + real(DP) :: az + real(DP) :: dtexitz + real(DP) :: dt + real(DP) :: t + real(DP) :: t0 + real(DP) :: dtexitxy + real(DP) :: texit + real(DP) :: x + real(DP) :: y + real(DP) :: z + integer(I4B) :: izstatus + integer(I4B) :: itopbotexit + integer(I4B) :: ntmax + integer(I4B) :: nsave + integer(I4B) :: isolv + integer(I4B) :: itrifaceenter + integer(I4B) :: itrifaceexit + real(DP) :: tol + real(DP) :: step + real(DP) :: dtexit + real(DP) :: alpexit + real(DP) :: betexit + integer(I4B) :: ntdebug ! kluge + integer(I4B) :: reason + integer(I4B) :: i + integer(I4B) :: tslice(2) + + lbary = .true. ! kluge + ntmax = 10000 + nsave = 1 ! needed??? + isolv = this%zeromethod + tol = 1d-7 + step = 1e-3 ! needed only for euler + reason = -1 + + ! -- Set some local variables for convenience + xi = particle%x + yi = particle%y + zi = particle%z + x0 = subcell%x0 + y0 = subcell%y0 + x1 = subcell%x1 + y1 = subcell%y1 + x2 = subcell%x2 + y2 = subcell%y2 + v0x = subcell%v0x + v0y = subcell%v0y + v1x = subcell%v1x + v1y = subcell%v1y + v2x = subcell%v2x + v2y = subcell%v2y + zbot = subcell%zbot + ztop = subcell%ztop + dz = subcell%dz + vzbot = subcell%vzbot + vztop = subcell%vztop + + ! -- Translate and rotate coordinates to "canonical" configuration + call canonical(x0, y0, x1, y1, x2, y2, & + v0x, v0y, v1x, v1y, v2x, v2y, & + xi, yi, & + rxx, rxy, ryx, ryy, & + sxx, sxy, syy, & + alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti, & + lbary) + + ! -- Do calculations related to analytical z solution, which can be done + ! -- after traverse_triangle call if results not needed for adaptive time + ! -- stepping during triangle (subcell) traversal + ! kluge note: actually, can probably do z calculation just once for each cell + zirel = (zi - zbot) / dz + call calculate_dt(vzbot, vztop, dz, zirel, vzi, & + az, dtexitz, izstatus, & + itopbotexit) + vziodz = vzi / dz + + ! -- Traverse triangular subcell + ntdebug = -999 ! kluge debug bludebug + itrifaceenter = particle%iboundary(3) - 1 + if (itrifaceenter .eq. -1) itrifaceenter = 999 + + ! kluge note: can probably avoid calculating alpexit + ! here in many cases and wait to calculate it later, + ! once the final trajectory time is known + call traverse_triangle(isolv, tol, step, & + dtexitxy, alpexit, betexit, & + itrifaceenter, itrifaceexit, & + rxx, rxy, ryx, ryy, & + alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti, & + vziodz, az, lbary) + + ! -- Check for no exit face + if ((itopbotexit .eq. 0) .and. (itrifaceexit .eq. 0)) then + ! exitFace = 0 + ! particle%iboundary(3) = exitFace + ! particle%istatus = 5 + ! return + + ! contact the developer situation (for now? always?) + print *, "Subcell with no exit face: particle", get_particle_id(particle), & + "cell", particle%idomain(2) + call pstop(1) + end if + + ! -- Determine (earliest) exit face and corresponding travel time to exit + if (itopbotexit .eq. 0) then + ! -- Exits through triangle face first + exitFace = itrifaceexit + dtexit = dtexitxy + else if (itrifaceexit .eq. 0) then + ! -- Exits through top/bottom first + exitFace = 45 + dtexit = dtexitz + else if (dtexitz .lt. dtexitxy) then + ! -- Exits through top/bottom first + exitFace = 45 + dtexit = dtexitz + else + ! -- Exits through triangle face first + exitFace = itrifaceexit + dtexit = dtexitxy + end if + if (exitFace .eq. 45) then + if (itopbotexit .eq. -1) then + exitFace = 4 + else + exitFace = 5 + end if + end if + + ! -- Compute exit time + texit = particle%ttrack + dtexit + t0 = particle%ttrack + + ! -- Select user tracking times to solve. If this is the first time step + ! of the simulation, include all times before it begins; if it is the + ! last time step, include all times after it ends. Otherwise take the + ! times within the current period and time step only. + call this%tracktimes%try_advance() + tslice = this%tracktimes%selection + if (all(tslice > 0)) then + do i = tslice(1), tslice(2) + t = this%tracktimes%times(i) + if (t < particle%ttrack .or. t >= texit .or. t >= tmax) cycle + dt = t - t0 + call step_analytical(dt, alp, bet) + loc = (/alp, bet/) + if (lbary) loc = skew(loc, (/sxx, sxy, syy/), invert=.true.) + rot = reshape((/rxx, rxy, ryx, ryy/), shape(rot)) + res = matmul(rot, loc) ! rotate vector + x = res(1) + x0 + y = res(2) + y0 + ! kluge note: make this into a function + if (izstatus .eq. 2) then + ! -- vz uniformly zero + z = zi + else if (izstatus .eq. 1) then + ! -- vz uniform, nonzero + z = zi + vzi * dt + else + ! -- vz nonuniform + z = zbot + (vzi * dexp(az * dt) - vzbot) / az + end if + particle%x = x + particle%y = y + particle%z = z + particle%ttrack = t + particle%istatus = 1 + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=5) + end do + end if + + if (texit .gt. tmax) then + ! -- The computed exit time is greater than the maximum time, so set + ! -- final time for particle trajectory equal to maximum time. + t = tmax + dt = t - t0 + exitFace = 0 + particle%istatus = 1 + particle%advancing = .false. + reason = 2 ! timestep end + else + ! -- The computed exit time is less than or equal to the maximum time, + ! -- so set final time for particle trajectory equal to exit time. + t = texit + dt = dtexit + reason = 1 ! cell transition + end if + + ! -- Calculate final particle location + ! -- kluge note: need to evaluate both alpha and beta here only + ! -- for exitFace=0, otherwise just one or the other + call step_analytical(dt, alp, bet) + if (exitFace .eq. 1) then + bet = 0d0 + else if (exitFace .eq. 2) then + alp = 1d0 - bet + else if (exitFace .eq. 3) then + alp = 0d0 + end if + loc = (/alp, bet/) + if (lbary) loc = skew(loc, (/sxx, sxy, syy/), invert=.true.) + rot = reshape((/rxx, rxy, ryx, ryy/), shape(rot)) + res = matmul(rot, loc) ! rotate vector + x = res(1) + x0 + y = res(2) + y0 + if (exitFace .eq. 4) then + z = zbot + else if (exitFace .eq. 5) then + z = ztop + else + if (izstatus .eq. 2) then ! kluge note: make this into a function + ! -- vz uniformly zero + z = zi + else if (izstatus .eq. 1) then + ! -- vz uniform, nonzero + z = zi + vzi * dt + else + ! -- vz nonuniform + z = zbot + (vzi * dexp(az * dt) - vzbot) / az + end if + end if + + ! -- Set final particle location in local (unscaled) subcell coordinates, + ! -- final time for particle trajectory, and exit face + particle%x = x + particle%y = y + particle%z = z + particle%ttrack = t + particle%iboundary(3) = exitFace + + ! -- Save particle track record + if (reason > -1) & + call this%trackfilectl%save(particle, kper=kper, & + kstp=kstp, reason=reason) ! reason=2: timestep + end subroutine track_subcell + + !> @brief Do calculations related to analytical z solution + !! + !! This subroutine consists partly or entirely of code written by + !! David W. Pollock of the USGS for MODPATH 7. The authors of the present + !! code are responsible for its appropriate application in this context + !! and for any modifications or errors. + !< + subroutine calculate_dt(v1, v2, dx, xL, v, dvdx, & + dt, status, itopbotexit) + real(DP) :: v1 + real(DP) :: v2 + real(DP) :: dx + real(DP) :: xL + real(DP) :: v + real(DP) :: dvdx + real(DP) :: dt + real(DP) :: v2a + real(DP) :: v1a + real(DP) :: dv + real(DP) :: dva + real(DP) :: vv + real(DP) :: vvv + real(DP) :: zro + real(DP) :: zrom + real(DP) :: x + real(DP) :: tol + real(DP) :: vr1 + real(DP) :: vr2 + real(DP) :: vr + real(DP) :: v1v2 + integer(I4B) :: status + integer(I4B) :: itopbotexit + logical(LGP) :: noOutflow + + ! Initialize variables + status = -1 + dt = 1.0d+20 + v2a = v2 + if (v2a .lt. 0d0) v2a = -v2a + v1a = v1 + if (v1a .lt. 0d0) v1a = -v1a + dv = v2 - v1 + dva = dv + if (dva .lt. 0d0) dva = -dva + + ! Check for a uniform zero velocity in this direction. + ! If so, set status = 2 and return (dt = 1.0d+20). + tol = 1.0d-15 + if ((v2a .lt. tol) .and. (v1a .lt. tol)) then + v = 0d0 + dvdx = 0d0 + status = 2 + itopbotexit = 0 + return + end if + + ! Check for uniform non-zero velocity in this direction. + ! If so, set compute dt using the constant velocity, + ! set status = 1 and return. + vv = v1a + if (v2a .gt. vv) vv = v2a + vvv = dva / vv + if (vvv .lt. 1.0d-4) then + zro = tol + zrom = -zro + v = v1 + x = xL * dx + if (v1 .gt. zro) then + dt = (dx - x) / v1 + itopbotexit = -2 + end if + if (v1 .lt. zrom) then + dt = -x / v1 + itopbotexit = -1 + end if + dvdx = 0d0 + status = 1 + return + end if + + ! Velocity has a linear variation. + ! Compute velocity corresponding to particle position + dvdx = dv / dx + v = (1.0d0 - xL) * v1 + xL * v2 + + ! If flow is into the cell from both sides there is no outflow. + ! In that case, set status = 3 and return + noOutflow = .true. + if (v1 .lt. 0d0) noOutflow = .false. + if (v2 .gt. 0d0) noOutflow = .false. + if (noOutflow) then + status = 3 + itopbotexit = 0 + return + end if + + ! If there is a divide in the cell for this flow direction, check to see if the + ! particle is located exactly on the divide. If it is, move it very slightly to + ! get it off the divide. This avoids possible numerical problems related to + ! stagnation points. + if ((v1 .le. 0d0) .and. (v2 .ge. 0d0)) then + if (abs(v) .le. 0d0) then + v = 1.0d-20 + if (v2 .le. 0d0) v = -v + end if + end if + + ! If there is a flow divide, find out what side of the divide the particle + ! is on and set the value of vr appropriately to reflect that location. + vr1 = v1 / v + vr2 = v2 / v + vr = vr1 + itopbotexit = -1 + if (vr .le. 0d0) then + vr = vr2 + itopbotexit = -2 + end if + + ! Check if velocity is in the same direction throughout cell (i.e. no flow divide). + ! Check if product v1*v2 > 0 then the velocity is in the same direction throughout + ! the cell (i.e. no flow divide). If so, set vr to reflect appropriate direction. + v1v2 = v1 * v2 + if (v1v2 .gt. 0d0) then + if (v .gt. 0d0) then + vr = vr2 + itopbotexit = -2 + end if + if (v .lt. 0d0) then + vr = vr1 + itopbotexit = -1 + end if + end if + + ! Compute travel time to exit face. Return with status = 0 + dt = log(vr) / dvdx + status = 0 + end subroutine calculate_dt + +end module MethodSubcellTernaryModule diff --git a/src/Solution/ParticleTracker/Particle.f90 b/src/Solution/ParticleTracker/Particle.f90 new file mode 100644 index 00000000000..1ce8e47a507 --- /dev/null +++ b/src/Solution/ParticleTracker/Particle.f90 @@ -0,0 +1,361 @@ +module ParticleModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DONE, LENMEMPATH, LENBOUNDNAME + use MemoryManagerModule, only: mem_allocate, mem_deallocate, & + mem_reallocate + implicit none + + private + public :: ParticleType, ParticleStoreType, & + create_particle, create_particle_store, & + get_particle_id + + ! min/max tracking levels (1: model, 2: cell, 3: subcell) + integer, parameter, public :: levelmin = 0, levelmax = 4 + + !> @brief A particle tracked by the PRT model. + !! + !! Record-type used mainly for convenience to shuffle + !! data into and out of storage as tracking proceeds. + !! + !! Particle coordinates may be local to the cell or + !! global/model. Routines are provided to convert a + !! particle's global coordinates to/from cell-local + !! coordinates for tracking through cell subdomains. + !! + !! Particles are identified by composite key, i.e., + !! combinations of properties imdl, iprp, irpt, and + !! trelease. An optional label may be provided, but + !! need not be unique + !< + type ParticleType + private + ! identity + character(len=LENBOUNDNAME), public :: name = '' !< optional particle name + integer(I4B), public :: imdl !< index of model the particle originated in + integer(I4B), public :: iprp !< index of release package the particle is from + integer(I4B), public :: irpt !< index of release point the particle is from + integer(I4B), public :: ip !< index of particle in the particle list + ! stop criteria + integer(I4B), public :: istopweaksink !< weak sink option (0: do not stop, 1: stop) + integer(I4B), public :: istopzone !< stop zone number + ! state + integer(I4B), allocatable, public :: idomain(:) !< tracking domain hierarchy + integer(I4B), allocatable, public :: iboundary(:) !< tracking domain boundaries + integer(I4B), public :: icu !< user cell (node) number + integer(I4B), public :: ilay !< grid layer + integer(I4B), public :: izone !< zone number + integer(I4B), public :: istatus !< tracking status + real(DP), public :: x !< x coordinate + real(DP), public :: y !< y coordinate + real(DP), public :: z !< z coordinate + real(DP), public :: trelease !< release time + real(DP), public :: tstop !< stop time + real(DP), public :: ttrack !< time tracked so far + real(DP), public :: xorigin !< x origin for coordinate transformation from model to local + real(DP), public :: yorigin !< y origin for coordinate transformation from model to local + real(DP), public :: zorigin !< z origin for coordinate transformation from model to local + real(DP), public :: sinrot !< sine of rotation angle for coordinate transformation from model to local + real(DP), public :: cosrot !< cosine of rotation angle for coordinate transformation from model to local + logical(LGP), public :: transformed !< whether coordinates have been transformed from model to local + logical(LGP), public :: advancing !< whether particle is still being tracked for current time step + contains + procedure, public :: destroy => destroy_particle + procedure, public :: get_model_coords + procedure, public :: load_from_store + procedure, public :: transform => transform_coords + end type ParticleType + + !> @brief Structure of arrays to store particles. + type ParticleStoreType + ! identity + character(len=LENBOUNDNAME), dimension(:), pointer, contiguous :: name !< optional particle label + integer(I4B), dimension(:), pointer, contiguous :: imdl !< index of model particle originated in + integer(I4B), dimension(:), pointer, contiguous :: iprp !< index of release package the particle originated in + integer(I4B), dimension(:), pointer, contiguous :: irpt !< index of release point in the particle release package the particle originated in + ! stopping criteria + integer(I4B), dimension(:), pointer, contiguous :: istopweaksink !< weak sink option: 0 = do not stop, 1 = stop + integer(I4B), dimension(:), pointer, contiguous :: istopzone !< stop zone number + ! state + integer(I4B), dimension(:, :), allocatable :: idomain !< array of indices for domains in the tracking domain hierarchy + integer(I4B), dimension(:, :), allocatable :: iboundary !< array of indices for tracking domain boundaries + integer(I4B), dimension(:), pointer, contiguous :: icu !< cell number (user, not reduced) + integer(I4B), dimension(:), pointer, contiguous :: ilay !< layer + integer(I4B), dimension(:), pointer, contiguous :: izone !< current zone number + integer(I4B), dimension(:), pointer, contiguous :: istatus !< particle status + real(DP), dimension(:), pointer, contiguous :: x !< model x coord of particle + real(DP), dimension(:), pointer, contiguous :: y !< model y coord of particle + real(DP), dimension(:), pointer, contiguous :: z !< model z coord of particle + real(DP), dimension(:), pointer, contiguous :: trelease !< particle release time + real(DP), dimension(:), pointer, contiguous :: tstop !< particle stop time + real(DP), dimension(:), pointer, contiguous :: ttrack !< current tracking time + contains + procedure, public :: destroy => destroy_store + procedure, public :: resize => resize_store + procedure, public :: load_from_particle + end type ParticleStoreType + +contains + + !> @brief Create a new particle + subroutine create_particle(particle) + type(ParticleType), pointer :: particle !< particle + allocate (particle) + allocate (particle%idomain(levelmin:levelmax)) + allocate (particle%iboundary(levelmin:levelmax)) + end subroutine create_particle + + !> @brief Destroy a particle + subroutine destroy_particle(this) + class(ParticleType), intent(inout) :: this !< particle + deallocate (this%idomain) + deallocate (this%iboundary) + end subroutine destroy_particle + + !> @brief Create a new particle store + subroutine create_particle_store(this, np, mempath) + type(ParticleStoreType), pointer :: this !< store + integer(I4B), intent(in) :: np !< number of particles + character(*), intent(in) :: mempath !< path to memory + + allocate (this) + call mem_allocate(this%imdl, np, 'PLIMDL', mempath) + call mem_allocate(this%irpt, np, 'PLIRPT', mempath) + call mem_allocate(this%iprp, np, 'PLIPRP', mempath) + call mem_allocate(this%name, LENBOUNDNAME, np, 'PLNAME', mempath) + ! -- kluge todo: update mem_allocate to allow custom range of indices? + ! e.g. here we want to allocate 0-4 for trackdomain levels, not 1-5 + allocate (this%idomain(np, levelmin:levelmax)) + allocate (this%iboundary(np, levelmin:levelmax)) + call mem_allocate(this%icu, np, 'PLICU', mempath) + call mem_allocate(this%ilay, np, 'PLILAY', mempath) + call mem_allocate(this%izone, np, 'PLIZONE', mempath) + call mem_allocate(this%istatus, np, 'PLISTATUS', mempath) + call mem_allocate(this%x, np, 'PLX', mempath) + call mem_allocate(this%y, np, 'PLY', mempath) + call mem_allocate(this%z, np, 'PLZ', mempath) + call mem_allocate(this%trelease, np, 'PLTRELEASE', mempath) + call mem_allocate(this%tstop, np, 'PLTSTOP', mempath) + call mem_allocate(this%ttrack, np, 'PLTTRACK', mempath) + call mem_allocate(this%istopweaksink, np, 'PLISTOPWEAKSINK', mempath) + call mem_allocate(this%istopzone, np, 'PLISTOPZONE', mempath) + end subroutine create_particle_store + + !> @brief Deallocate particle arrays + subroutine destroy_store(this, mempath) + class(ParticleStoreType), intent(inout) :: this !< store + character(*), intent(in) :: mempath !< path to memory + + call mem_deallocate(this%imdl, 'PLIMDL', mempath) + call mem_deallocate(this%iprp, 'PLIPRP', mempath) + call mem_deallocate(this%irpt, 'PLIRPT', mempath) + call mem_deallocate(this%name, 'PLNAME', mempath) + deallocate (this%idomain) + deallocate (this%iboundary) + call mem_deallocate(this%icu, 'PLICU', mempath) + call mem_deallocate(this%ilay, 'PLILAY', mempath) + call mem_deallocate(this%izone, 'PLIZONE', mempath) + call mem_deallocate(this%istatus, 'PLISTATUS', mempath) + call mem_deallocate(this%x, 'PLX', mempath) + call mem_deallocate(this%y, 'PLY', mempath) + call mem_deallocate(this%z, 'PLZ', mempath) + call mem_deallocate(this%trelease, 'PLTRELEASE', mempath) + call mem_deallocate(this%tstop, 'PLTSTOP', mempath) + call mem_deallocate(this%ttrack, 'PLTTRACK', mempath) + call mem_deallocate(this%istopweaksink, 'PLISTOPWEAKSINK', mempath) + call mem_deallocate(this%istopzone, 'PLISTOPZONE', mempath) + end subroutine destroy_store + + !> @brief Reallocate particle arrays + subroutine resize_store(this, np, mempath) + ! -- modules + use ArrayHandlersModule, only: ExpandArray2D + ! -- dummy + class(ParticleStoreType), intent(inout) :: this !< particle store + integer(I4B), intent(in) :: np !< number of particles + character(*), intent(in) :: mempath !< path to memory + + ! resize 1D arrays + call mem_reallocate(this%imdl, np, 'PLIMDL', mempath) + call mem_reallocate(this%iprp, np, 'PLIPRP', mempath) + call mem_reallocate(this%irpt, np, 'PLIRPT', mempath) + call mem_reallocate(this%name, LENBOUNDNAME, np, 'PLNAME', mempath) + call mem_reallocate(this%icu, np, 'PLICU', mempath) + call mem_reallocate(this%ilay, np, 'PLILAY', mempath) + call mem_reallocate(this%izone, np, 'PLIZONE', mempath) + call mem_reallocate(this%istatus, np, 'PLISTATUS', mempath) + call mem_reallocate(this%x, np, 'PLX', mempath) + call mem_reallocate(this%y, np, 'PLY', mempath) + call mem_reallocate(this%z, np, 'PLZ', mempath) + call mem_reallocate(this%trelease, np, 'PLTRELEASE', mempath) + call mem_reallocate(this%tstop, np, 'PLTSTOP', mempath) + call mem_reallocate(this%ttrack, np, 'PLTTRACK', mempath) + call mem_reallocate(this%istopweaksink, np, 'PLISTOPWEAKSINK', mempath) + call mem_reallocate(this%istopzone, np, 'PLISTOPZONE', mempath) + ! resize first dimension of 2D arrays + ! todo: memory manager support? + call ExpandArray2D( & + this%idomain, & + np - size(this%idomain, 1), & + 0) + call ExpandArray2D( & + this%iboundary, & + np - size(this%iboundary, 1), & + 0) + end subroutine resize_store + + !> @brief Initialize particle from particle list. + !! + !! This routine is used to initialize a particle from the list + !! so it can be tracked by prt_solve. The particle's advancing + !! flag is set and local coordinate transformations are reset. + !< + subroutine load_from_store(this, store, imdl, iprp, ip) + class(ParticleType), intent(inout) :: this !< particle + type(ParticleStoreType), intent(in) :: store !< particle storage + integer(I4B), intent(in) :: imdl !< index of model particle originated in + integer(I4B), intent(in) :: iprp !< index of particle release package particle originated in + integer(I4B), intent(in) :: ip !< index into the particle list + + call this%transform(reset=.true.) + this%imdl = imdl + this%iprp = iprp + this%irpt = store%irpt(ip) + this%ip = ip + this%name = store%name(ip) + this%istopweaksink = store%istopweaksink(ip) + this%istopzone = store%istopzone(ip) + this%icu = store%icu(ip) + this%ilay = store%ilay(ip) + this%izone = store%izone(ip) + this%istatus = store%istatus(ip) + this%x = store%x(ip) + this%y = store%y(ip) + this%z = store%z(ip) + this%trelease = store%trelease(ip) + this%tstop = store%tstop(ip) + this%ttrack = store%ttrack(ip) + this%advancing = .true. + this%idomain(levelmin:levelmax) = & + store%idomain(ip, levelmin:levelmax) + this%idomain(1) = imdl + this%iboundary(levelmin:levelmax) = & + store%iboundary(ip, levelmin:levelmax) + end subroutine load_from_store + + !> @brief Update particle store from particle + subroutine load_from_particle(this, particle, ip) + class(ParticleStoreType), intent(inout) :: this !< particle storage + type(ParticleType), intent(in) :: particle !< particle + integer(I4B), intent(in) :: ip !< particle index + + this%imdl(ip) = particle%imdl + this%iprp(ip) = particle%iprp + this%irpt(ip) = particle%irpt + this%name(ip) = particle%name + this%istopweaksink(ip) = particle%istopweaksink + this%istopzone(ip) = particle%istopzone + this%icu(ip) = particle%icu + this%ilay(ip) = particle%ilay + this%izone(ip) = particle%izone + this%istatus(ip) = particle%istatus + this%x(ip) = particle%x + this%y(ip) = particle%y + this%z(ip) = particle%z + this%trelease(ip) = particle%trelease + this%tstop(ip) = particle%tstop + this%ttrack(ip) = particle%ttrack + this%idomain( & + ip, & + levelmin:levelmax) = & + particle%idomain(levelmin:levelmax) + this%iboundary( & + ip, & + levelmin:levelmax) = & + particle%iboundary(levelmin:levelmax) + end subroutine load_from_particle + + !> @brief Apply the given global-to-local transformation to the particle. + subroutine transform_coords(this, xorigin, yorigin, zorigin, & + sinrot, cosrot, invert, reset) + use GeomUtilModule, only: transform, compose + class(ParticleType), intent(inout) :: this !< particle + real(DP), intent(in), optional :: xorigin !< x coordinate of origin + real(DP), intent(in), optional :: yorigin !< y coordinate of origin + real(DP), intent(in), optional :: zorigin !< z coordinate of origin + real(DP), intent(in), optional :: sinrot !< sine of rotation angle + real(DP), intent(in), optional :: cosrot !< cosine of rotation angle + logical(LGP), intent(in), optional :: invert !< whether to invert + logical(LGP), intent(in), optional :: reset !< whether to reset + + ! -- reset if requested + if (present(reset)) then + if (reset) then + this%xorigin = DZERO + this%yorigin = DZERO + this%zorigin = DZERO + this%sinrot = DZERO + this%cosrot = DONE + this%cosrot = DONE + this%transformed = .false. + return + end if + end if + + ! -- Otherwise, transform coordinates + call transform(this%x, this%y, this%z, & + this%x, this%y, this%z, & + xorigin, yorigin, zorigin, & + sinrot, cosrot, invert) + + ! -- Modify transformation from model coordinates to particle's new + ! -- local coordinates by incorporating this latest transformation + call compose(this%xorigin, this%yorigin, this%zorigin, & + this%sinrot, this%cosrot, & + xorigin, yorigin, zorigin, & + sinrot, cosrot, invert) + + ! -- Set isTransformed flag to true. Note that there is no check + ! -- to see whether the modification brings the coordinates back + ! -- to model coordinates (in which case the origin would be very + ! -- close to zero and sinrot and cosrot would be very close to 0. + ! -- and 1., respectively, allowing for roundoff error). + this%transformed = .true. + end subroutine transform_coords + + !> @brief Return the particle's model (global) coordinates. + subroutine get_model_coords(this, x, y, z) + use GeomUtilModule, only: transform, compose + class(ParticleType), intent(inout) :: this !< particle + real(DP), intent(out) :: x !< x coordinate + real(DP), intent(out) :: y !< y coordinate + real(DP), intent(out) :: z !< z coordinate + + if (this%transformed) then + ! -- Transform back from local to model coordinates + call transform(this%x, this%y, this%z, x, y, z, & + this%xorigin, this%yorigin, this%zorigin, & + this%sinrot, this%cosrot, .true.) + else + ! -- Already in model coordinates + x = this%x + y = this%y + z = this%z + end if + end subroutine get_model_coords + + !> @brief Return the particle's composite ID. + !! + !! Particles are uniquely identified by model index, PRP index, + !! location index, and release time. + !< + pure function get_particle_id(particle) result(id) + class(ParticleType), intent(in) :: particle !< particle + character(len=LENMEMPATH) :: id !< particle id + + write (id, '(I0,"-",I0,"-",I0,"-",F0.0)') & + particle%imdl, particle%iprp, particle%irpt, particle%trelease + end function get_particle_id + +end module ParticleModule diff --git a/src/Solution/ParticleTracker/Subcell.f90 b/src/Solution/ParticleTracker/Subcell.f90 new file mode 100644 index 00000000000..c326f595eb7 --- /dev/null +++ b/src/Solution/ParticleTracker/Subcell.f90 @@ -0,0 +1,31 @@ +module SubcellModule + + use CellDefnModule, only: CellDefnType + implicit none + private + public :: SubcellType + + !> @brief A subcell of a cell. + type, abstract :: SubcellType + private + character(len=40), pointer, public :: type !< character string that names the tracking domain type + integer, public :: isubcell !< index of subcell in the cell + integer, public :: icell !< index of cell in the source grid + contains + procedure(destroy), deferred :: destroy !< destructor + procedure(init), deferred :: init !< initializer + end type SubcellType + + abstract interface + subroutine destroy(this) + import SubcellType + class(SubcellType), intent(inout) :: this + end subroutine + + subroutine init(this) + import SubcellType + class(SubcellType), intent(inout) :: this + end subroutine init + end interface + +end module SubcellModule diff --git a/src/Solution/ParticleTracker/SubcellRect.f90 b/src/Solution/ParticleTracker/SubcellRect.f90 new file mode 100644 index 00000000000..7ea6e4a35b1 --- /dev/null +++ b/src/Solution/ParticleTracker/SubcellRect.f90 @@ -0,0 +1,45 @@ +module SubcellRectModule + + use SubcellModule, only: SubcellType + implicit none + + private + public :: SubcellRectType + public :: create_subcell_rect + + type, extends(SubcellType) :: SubcellRectType + private + double precision, public :: sinrot !< sine of rotation angle for local (x, y) + double precision, public :: cosrot !< cosine of rotation angle for local (x, y) + double precision, public :: xOrigin !< cell x origin for local (x, y) + double precision, public :: yOrigin !< cell y origin for local (x, y) + double precision, public :: zOrigin !< cell z origin for local z + double precision, public :: dx, dy, dz !< subcell dimensions + double precision, public :: vx1, vx2, vy1, vy2, vz1, vz2 !< subcell face velocities + contains + procedure, public :: destroy => destroy_subcell_rect !< destructor for the subcell + procedure, public :: init => init_subcell_rect !< initializes the rectangular subcell + end type SubcellRectType + +contains + + !> @brief Create a new rectangular subcell + subroutine create_subcell_rect(subcell) + type(SubcellRectType), pointer :: subcell + allocate (subcell) + allocate (subcell%type) + subcell%type = 'subcellrect' + end subroutine create_subcell_rect + + !> @brief Destructor for a rectangular subcell + subroutine destroy_subcell_rect(this) + class(SubcellRectType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy_subcell_rect + + !> @brief Initialize a rectangular subcell + subroutine init_subcell_rect(this) + class(SubcellRectType), intent(inout) :: this + end subroutine init_subcell_rect + +end module SubcellRectModule diff --git a/src/Solution/ParticleTracker/SubcellTri.f90 b/src/Solution/ParticleTracker/SubcellTri.f90 new file mode 100644 index 00000000000..6a441463ed2 --- /dev/null +++ b/src/Solution/ParticleTracker/SubcellTri.f90 @@ -0,0 +1,43 @@ +module SubcellTriModule + + use SubcellModule, only: SubcellType + implicit none + + private + public :: SubcellTriType + public :: create_subcell_tri + + type, extends(SubcellType) :: SubcellTriType + private + double precision, public :: x0, y0, x1, y1, x2, y2 !< subcell corner coordinates + double precision, public :: v0x, v0y, v1x, v1y, v2x, v2y !< subcell corner velocities + double precision, public :: ztop, zbot !< subcell top and bottom elevations + double precision, public :: dz !< subcell thickness + double precision, public :: vztop, vzbot !< subcell top and bottom velocities + contains + procedure, public :: destroy => destroy_subcell_tri !< destructor for the subcell + procedure, public :: init => init_subcell_tri !< initializes the triangular subcell + end type SubcellTriType + +contains + + !> @brief Create a new triangular subcell + subroutine create_subcell_tri(subcell) + type(SubcellTriType), pointer :: subcell + allocate (subcell) + allocate (subcell%type) + subcell%type = 'subcelltri' + end subroutine create_subcell_tri + + !> @brief Destructor for a triangular subcell + subroutine destroy_subcell_tri(this) + class(SubcellTriType), intent(inout) :: this + deallocate (this%type) + end subroutine destroy_subcell_tri + + !> @brief Initialize a triangular subcell + subroutine init_subcell_tri(this) + class(SubcellTriType), intent(inout) :: this + end subroutine init_subcell_tri + +end module SubcellTriModule diff --git a/src/Solution/ParticleTracker/TernarySolveTrack.f90 b/src/Solution/ParticleTracker/TernarySolveTrack.f90 new file mode 100644 index 00000000000..dbc49a10eb7 --- /dev/null +++ b/src/Solution/ParticleTracker/TernarySolveTrack.f90 @@ -0,0 +1,972 @@ +module TernarySolveTrack + + use KindModule, only: I4B, DP, LGP + use GeomUtilModule, only: skew + use MathUtilModule, only: f1d, zero_ch, zero_br, zero_test + use ErrorUtilModule, only: pstop + + private + public :: traverse_triangle + public :: canonical + public :: get_w + public :: solve_coefs + public :: step_analytical + public :: step_euler + public :: find_exit_bary + public :: get_t_alpt + public :: get_bet_outflow_bary + public :: get_bet_soln_limits + public :: soln_brent + public :: soln_chand + public :: soln_test + public :: soln_euler + public :: alpfun + + ! global data + real(DP) ca1, ca2, ca3, cb1, cb2 !< Analytical solution coefficients + real(DP) waa, wab, wba, wbb !< Elements of the "velocity matrix," W + real(DP) :: cv0(2), cv1(2), cv2(2) !< "Canonical" velocity components at corners of triangular subcell + integer(I4B) icase !< Case index for analytical solution + +contains + + !> @brief Traverse triangular cell + subroutine traverse_triangle(isolv, tol, step, texit, & + alpexit, betexit, & + itrifaceenter, itrifaceexit, & + rxx, rxy, ryx, ryy, & + alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti, & + vziodz, az, & + bary) + ! -- dummy + integer(I4B), intent(in) :: isolv !< solution method + real(DP), intent(in) :: tol !< solution tolerance + real(DP), intent(in) :: step !< stepsize for numerical methods (e.g. euler) + real(DP), intent(out) :: texit !< time particle exits the cell + real(DP) :: alpexit + real(DP) :: betexit !< alpha and beta coefficients + integer(I4B) :: itrifaceenter + integer(I4B) :: itrifaceexit !< entry and exit faces + real(DP) :: rxx + real(DP) :: rxy + real(DP) :: ryx + real(DP) :: ryy !< rotation matrix + real(DP) :: alp0 + real(DP) :: bet0 + real(DP) :: alp1 + real(DP) :: bet1 + real(DP) :: alp2 + real(DP) :: bet2 + real(DP) :: alpi + real(DP) :: beti !< alpha and beta coefficients + real(DP) :: vziodz + real(DP) :: az + logical(LGP), intent(in) :: bary !< whether to use barycentric coordinates + ! -- local + real(DP) :: texit0 + real(DP) :: alpexit0 + real(DP) :: betexit0 + real(DP) :: texit1 + real(DP) :: alpexit1 + real(DP) :: betexit1 + real(DP) :: texit2 + real(DP) :: alpexit2 + real(DP) :: betexit2 + + ! -- Compute elements of matrix W + call get_w(alp1, bet1, alp2, bet2, waa, wab, wba, wbb, bary) + + ! -- Determine alpha and beta analytically as functions of time + call solve_coefs(alpi, beti) + + ! -- Compute exit time (travel time to exit) and exit location + call find_exit_bary(isolv, 0, itrifaceenter, & + alpi, beti, & + tol, step, vziodz, az, & + texit0, alpexit0, betexit0) + call find_exit_bary(isolv, 1, itrifaceenter, & + alpi, beti, & + tol, step, vziodz, az, & + texit1, alpexit1, betexit1) + call find_exit_bary(isolv, 2, itrifaceenter, & + alpi, beti, & + tol, step, vziodz, az, & + texit2, alpexit2, betexit2) + texit = min(texit0, texit1, texit2) + + ! -- Note that while the numbering of triangle faces is generally zero-based + ! -- (0, 1, 2), itrifaceexit, which gets passed out, is one-based (1, 2, 3). + if (texit .eq. texit0) then + alpexit = alpexit0 + betexit = betexit0 + itrifaceexit = 1 + else if (texit .eq. texit1) then + alpexit = alpexit1 + betexit = betexit1 + itrifaceexit = 2 + else if (texit .eq. texit2) then + alpexit = alpexit2 + betexit = betexit2 + itrifaceexit = 3 + end if + if (texit .eq. huge(1d0)) itrifaceexit = 0 + + end subroutine + + !> @brief Set coordinates to "canonical" configuration + subroutine canonical(x0, y0, x1, y1, x2, y2, & + v0x, v0y, v1x, v1y, v2x, v2y, & + xi, yi, & + rxx, rxy, ryx, ryy, & + sxx, sxy, syy, & + alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti, & + bary) + ! -- dummy + real(DP) :: x0 + real(DP) :: y0 + real(DP) :: x1 + real(DP) :: y1 + real(DP) :: x2 + real(DP) :: y2 + real(DP) :: v0x + real(DP) :: v0y + real(DP) :: v1x + real(DP) :: v1y + real(DP) :: v2x + real(DP) :: v2y + real(DP) :: xi + real(DP) :: yi + real(DP) :: rxx + real(DP) :: rxy + real(DP) :: ryx + real(DP) :: ryy !< rotation matrix + real(DP), intent(inout) :: sxx, sxy, syy !< skew matrix entries (top left, top right, bottom right) + real(DP) :: alp0 + real(DP) :: bet0 + real(DP) :: alp1 + real(DP) :: bet1 + real(DP) :: alp2 + real(DP) :: bet2 + real(DP) :: alpi + real(DP) :: beti !< alpha and beta coefficients + logical(LGP), intent(in) :: bary !< whether to use barycentric coordinates + ! -- local + real(DP) :: baselen + real(DP) :: oobaselen + real(DP) :: sinomega + real(DP) :: cosomega + real(DP) :: x1diff + real(DP) :: y1diff + real(DP) :: x2diff + real(DP) :: y2diff + real(DP) :: xidiff + real(DP) :: yidiff + real(DP) :: rot(2, 2), res(2) + + ! -- Translate and rotate coordinates to "canonical" configuration + x1diff = x1 - x0 + y1diff = y1 - y0 + x2diff = x2 - x0 + y2diff = y2 - y0 + baselen = dsqrt(x1diff * x1diff + y1diff * y1diff) + oobaselen = 1d0 / baselen + cosomega = x1diff * oobaselen + sinomega = y1diff * oobaselen + rxx = cosomega + rxy = sinomega + ryx = -sinomega + ryy = cosomega + alp0 = 0d0 + bet0 = 0d0 + alp1 = baselen + bet1 = 0d0 + + rot = reshape((/rxx, ryx, rxy, ryy/), shape(rot)) + res = matmul(rot, (/x2diff, y2diff/)) + alp2 = res(1) + bet2 = res(2) + + cv0 = matmul(rot, (/v0x, v0y/)) + cv1 = matmul(rot, (/v1x, v1y/)) + cv2 = matmul(rot, (/v2x, v2y/)) + + xidiff = xi - x0 + yidiff = yi - y0 + res = matmul(rot, (/xidiff, yidiff/)) + alpi = res(1) + beti = res(2) + + if (bary) then + sxx = 1d0 / alp1 + syy = 1d0 / bet2 + sxy = -alp2 * sxx * syy + alp1 = 1d0 + alp2 = 0d0 + bet2 = 1d0 + cv0 = skew(cv0, (/sxx, sxy, syy/)) + cv1 = skew(cv1, (/sxx, sxy, syy/)) + cv2 = skew(cv2, (/sxx, sxy, syy/)) + res = (/alpi, beti/) + res = skew(res, (/sxx, sxy, syy/)) + alpi = res(1) + beti = res(2) + end if + + end subroutine + + !> @brief Compute elements of W matrix + subroutine get_w( & + alp1, bet1, alp2, bet2, & + waa, wab, wba, wbb, & + bary) + ! -- dummy + real(DP) :: alp1 + real(DP) :: bet1 + real(DP) :: alp2 + real(DP) :: bet2 !< triangle face points + real(DP) :: waa + real(DP) :: wab + real(DP) :: wba + real(DP) :: wbb !< w matrix + logical(LGP), intent(in), optional :: bary !< barycentric coordinates + ! -- local + logical(LGP) :: lbary + real(DP) :: v1alpdiff + real(DP) :: v2alpdiff + real(DP) :: v2betdiff + real(DP) :: ooalp1 + real(DP) :: oobet2 + real(DP) :: vterm + + if (present(bary)) then + lbary = bary + else + lbary = .true. + end if + + ! -- Note: wab is the "alpha,beta" entry in matrix W + ! and the alpha component of the w^(beta) vector + v1alpdiff = cv1(1) - cv0(1) + v2alpdiff = cv2(1) - cv0(1) + v2betdiff = cv2(2) - cv0(2) + if (bary) then + waa = v1alpdiff + wab = v2alpdiff + wba = 0d0 + wbb = v2betdiff + else + ooalp1 = 1d0 / alp1 + oobet2 = 1d0 / bet2 + vterm = v1alpdiff * ooalp1 + waa = vterm + wab = (v2alpdiff - alp2 * vterm) * oobet2 + wba = 0d0 + wbb = v2betdiff * oobet2 + end if + + end subroutine + + !> @brief Compute analytical solution coefficients depending on case + subroutine solve_coefs(alpi, beti) + ! -- dummy + real(DP) :: alpi + real(DP) :: beti + ! -- local + real(DP) :: zerotol + real(DP) :: wratv + real(DP) :: acoef + real(DP) :: bcoef + real(DP) :: afact + real(DP) :: bfact + real(DP) :: vfact + real(DP) :: oowaa + + zerotol = 1d-10 ! kluge + if (dabs(wbb) .gt. zerotol) then + wratv = (wab / wbb) * cv0(2) + acoef = cv0(1) - wratv + bcoef = wratv + wab * beti + afact = acoef / waa + vfact = cv0(2) / wbb + ! -- Coefs for beta do not depend on whether waa = 0 or not + cb1 = -vfact ! const term in beta + cb2 = vfact + beti ! coef for e(wbb*t) term in beta + ! -- Coefs for alpha + if (dabs(waa) .gt. zerotol) then + ! -- Case waa <> 0, wbb <> 0 + if (dabs(wbb - waa) .gt. zerotol) then + ! -- Subcase wbb <> waa + bfact = bcoef / (wbb - waa) + ca1 = -afact ! const term in alpha + ca2 = alpi + afact - bfact ! coef for exp(waa*t) term in alpha + ca3 = bfact ! coef for exp(wbb*t) term in alpha + icase = 1 + else + ! -- Subcase wbb = waa + ca1 = -afact ! const term in alpha + ca2 = alpi + afact ! coef for exp(waa*t) term in alpha + ca3 = bcoef ! coef for t*exp(waa*t) term in alpha + icase = -1 + end if + else + ! -- Case waa = 0, wbb <> 0 + bfact = bcoef / wbb + ca1 = alpi - bfact ! const term in alpha + ca2 = acoef ! coef for t term in alpha + ca3 = bfact ! coef for exp(wbb*t) term in alpha + icase = 2 + end if + else + ! -- Coefs for beta do not depend on whether waa = 0 or not + cb1 = beti ! const term in beta + cb2 = cv0(2) ! coef for t term in beta + if (dabs(waa) .gt. zerotol) then + ! -- Case waa <> 0, wbb = 0 + oowaa = 1d0 / waa + vfact = (wab * oowaa) * cv0(2) + ca1 = -oowaa * (cv0(1) + wab * beti + vfact) ! const term in alpha + ca2 = -vfact ! coef for t term in alpha + ca3 = alpi - ca1 ! coef for exp(waa*t) term in alpha + icase = 3 + else + ! -- Case waa = 0, wbb = 0 + ca1 = alpi ! const term in alpha + ca2 = cv0(1) + wab * beti ! coef for t term in alpha + ca3 = 5d-1 * wab * cv0(2) ! coef for t^2 term in alpha + icase = 4 + end if + end if + + end subroutine + + !> @brief Step (evaluate) analytically depending on case + subroutine step_analytical(t, alp, bet) + ! -- dummy + real(DP), intent(in) :: t + real(DP) :: alp + real(DP) :: bet + + if (icase .eq. 1) then + alp = ca1 + ca2 * dexp(waa * t) + ca3 * dexp(wbb * t) + bet = cb1 + cb2 * dexp(wbb * t) + else if (icase .eq. -1) then + alp = ca1 + (ca2 + ca3 * t) * dexp(waa * t) + bet = cb1 + cb2 * dexp(wbb * t) + else if (icase .eq. 2) then + alp = ca1 + ca2 * t + ca3 * dexp(wbb * t) + bet = cb1 + cb2 * dexp(wbb * t) + else if (icase .eq. 3) then + alp = ca1 + ca2 * t + ca3 * dexp(waa * t) + bet = cb1 + cb2 * t + else if (icase .eq. 4) then + alp = ca1 + (ca2 + ca3 * t) * t + bet = cb1 + cb2 * t + end if + + end subroutine + + !> @brief Step (evaluate) numerically depending in case + subroutine step_euler(nt, step, vziodz, az, alpi, beti, t, alp, bet) + ! -- dummy + integer(I4B) :: nt + real(DP), intent(in) :: step + real(DP) :: vziodz + real(DP) :: az + real(DP) :: alpi + real(DP) :: beti + real(DP), intent(inout) :: t + real(DP) :: alp + real(DP) :: bet + ! -- local + real(DP) :: alpproj + real(DP) :: betproj + real(DP) :: valp + real(DP) :: vbet + real(DP) :: vz + real(DP) :: vmeasure + real(DP) :: delt + real(DP) :: thalf + real(DP) :: rkn1 + real(DP) :: rln1 + real(DP) :: rkn2 + real(DP) :: rln2 + real(DP) :: rkn3 + real(DP) :: rln3 + real(DP) :: rkn4 + real(DP) :: rln4 + + if (nt .eq. 0) then + ! -- Initial location + alp = alpi + bet = beti + t = 0d0 + else + ! -- Step numerically + valp = cv0(1) + waa * alp + wab * bet + vbet = cv0(2) + wba * alp + wbb * bet + if (step .lt. 0d0) then + ! -- Compute time step based on abs value of step, interpreting the latter + ! -- as a distance in canonical coordinates (alpha, beta, and scaled z) + vz = vziodz * dexp(az * t) + vmeasure = dsqrt(valp * valp + vbet * vbet + vz * vz) + delt = -step / vmeasure + else + ! -- Set time step directly to step + delt = step + end if + ikluge = 2 ! kluge + if (ikluge .eq. 1) then + t = t + delt + alp = alp + valp * delt + bet = bet + vbet * delt + else + rkn1 = valp + rln1 = vbet + thalf = t + 5d-1 * delt + call step_analytical(thalf, alpproj, betproj) + rkn2 = cv0(1) + waa * alpproj + wab * betproj + rln2 = cv0(2) + wba * alpproj + wbb * betproj + rkn3 = rkn2 + rln3 = rln2 + t = t + delt + call step_analytical(t, alpproj, betproj) + rkn4 = cv0(1) + waa * alpproj + wab * betproj + rln4 = cv0(2) + wba * alpproj + wbb * betproj + alp = alp + delt * (rkn1 + 2d0 * rkn2 + 2d0 * rkn3 + rkn4) / 6d0 + bet = bet + delt * (rln1 + 2d0 * rln2 + 2d0 * rln3 + rln4) / 6d0 + end if + end if + + end subroutine + + !> @brief Find the exit time and location in barycentric coordinates. + subroutine find_exit_bary(isolv, itriface, itrifaceenter, & + alpi, beti, & + tol, step, vziodz, az, & + texit, alpexit, betexit) + ! -- dummy + integer(I4B) :: isolv + integer(I4B) :: itriface + integer(I4B) :: itrifaceenter + real(DP) :: alpi + real(DP) :: beti + real(DP) :: tol + real(DP) :: step + real(DP) :: vziodz + real(DP) :: az + real(DP) :: texit + real(DP) :: alpexit + real(DP) :: betexit + ! -- local + real(DP) :: alplo + real(DP) :: alphi + real(DP) :: alpt + real(DP) :: alplim + real(DP) :: fax + real(DP) :: fbx + real(DP) :: t + real(DP) :: tlo + real(DP) :: thi + real(DP) :: v0alpstar + real(DP) :: valpi + real(DP) :: v1n + real(DP) :: v2n + real(DP) :: vbeti + real(DP) :: zerotol + real(DP) :: betlo + real(DP) :: bethi + real(DP) :: betsollo + real(DP) :: betsolhi + real(DP) :: betoutlo + real(DP) :: betouthi + integer(I4B) :: ibettrend + + ! -- Use iterative scheme or numerical integration indicated by isolv. + zerotol = 1d-10 ! kluge + if (itriface .eq. 0) then + ! -- Checking for exit on canonical face 0 (beta = 0) + if (itrifaceenter .eq. 0) then + ! -- Entrance face, so no exit. (Normal velocity is uniform along face 0, + ! -- so it cannot be both an entrance and an exit.) + texit = huge(1d0) + else + ! -- Not the entrance face, so check for outflow + if (cv0(2) .ge. 0d0) then + ! -- Inflow or no flow, so no exit + texit = huge(1d0) + else + ! -- Outflow, so check beta-velocity at the initial location, + ! -- recognizing that it will never change sign along the + ! -- trajectory (and will not be blocked from zero by an asymptote) + vbeti = cv0(2) + wbb * beti + if (vbeti .ge. 0d0) then + ! -- Can't exit along beta = 0 + texit = huge(1d0) + else + ! -- get alpt and check it + call get_t_alpt(0d0, t, alpt) + if ((alpt .ge. 0d0) .and. (alpt .le. 1d0)) then + ! -- alpt within the edge, so exit found + texit = t + alpexit = alpt + betexit = 0d0 + else + ! -- alpt not within the edge, so not an exit + texit = huge(1d0) + end if + end if + end if + end if + ! -- End canonical face 0 (beta = 0) + else + ! -- Checking for exit on canonical face 1 (gamma = 0.) or 2 (alpha = 0.) + if (itriface .eq. 1) then + ! -- Normal velocities (gamma components) at ends of canonical face 1 + v1n = -cv1(1) - cv1(2) + v2n = -cv2(1) - cv2(2) + else + ! -- Normal velocities (alpha components) at ends of canonical face 2 + v1n = cv0(1) + v2n = cv2(1) + end if + if ((v1n .ge. 0d0) .and. (v2n .ge. 0d0)) then + ! -- No outflow at vn1 and vn2 corners; no outflow interval, so no exit. + texit = huge(1d0) + else + ! -- Find outflow interval + call get_bet_outflow_bary(v1n, v2n, betoutlo, betouthi) + ! -- Find trend of and limits on beta from beta{t} solution + call get_bet_soln_limits(beti, betsollo, betsolhi, ibettrend) + ! -- Look for exit + if (ibettrend .eq. 0) then + ! -- Beta is constant, so check if it's within the outflow interval; + ! -- if not, no exit; if so, solve for t and alpha + if ((beti .gt. betouthi) .or. (beti .lt. betoutlo)) then + texit = huge(1d0) + else + ! -- Check alpha-velocity at the initial location, + ! -- recognizing that it will never change sign along the + ! -- trajectory (and will not be blocked from zero by an asymptote) + ! -- in this special case + v0alpstar = cv0(1) + wab * beti + valpi = v0alpstar + waa * alpi + if ((itriface .eq. 1) .and. (valpi .le. 0d0)) then + ! -- Can't exit along gamma = 0. + texit = huge(1d0) + else if ((itriface .eq. 2) .and. (valpi .ge. 0d0)) then + ! -- Can't exit along alpha = 0. + texit = huge(1d0) + else + ! -- get exit + if (itriface .eq. 1) then + alpexit = 1d0 - beti + else + alpexit = 0d0 + end if ! kluge note: seems like in this case (beta=const) this + betexit = beti ! must be the ONLY exit; no need to check other edges?? + if (waa .ne. 0d0) then + alplim = -v0alpstar / waa + texit = dlog(alpexit - alplim / (alpi - alplim)) / waa + else + texit = (alpexit - alpi) / v0alpstar + end if + end if + end if + ! -- End constant-beta case + else + ! -- Beta varies along trajectory; combine outflow and soln limits on beta + bethi = min(betouthi, betsolhi) + betlo = max(betoutlo, betsollo) + if (betlo .ge. bethi) then + ! -- If bounds on bet leave no feasible interval, no exit + texit = huge(1d0) + else + ! -- Check sign of function value at beta bounds + call get_t_alpt(bethi, thi, alphi) + call get_t_alpt(betlo, tlo, alplo) + if (itriface .eq. 1) then + fax = 1d0 - betlo - alplo + fbx = 1d0 - bethi - alphi + else + fax = alplo + fbx = alphi + end if + if (fax * fbx .gt. 0d0) then + ! -- Root not bracketed; no exit + texit = huge(1d0) + else + if (isolv .eq. 0) then + ! -- Use Euler integration to find exit + call soln_euler(itriface, alpi, beti, step, vziodz, az, & + texit, alpexit, betexit) + else if (isolv .eq. 1) then + ! -- Use Brent's method with initial bounds on beta of betlo and bethi, + ! -- assuming they bound the root + call soln_brent(itriface, betlo, bethi, tol, texit, & + alpexit, betexit) + else if (isolv .eq. 2) then + ! -- Use Chandrupatla's method with initial bounds on beta of betlo and bethi, + ! -- assuming they bound the root + call soln_chand(itriface, betlo, bethi, tol, texit, & + alpexit, betexit) + else if (isolv .eq. 3) then + ! -- Use a test method with initial bounds on beta of betlo and bethi, + ! -- assuming they bound the root + call soln_test(itriface, betlo, bethi, tol, texit, & + alpexit, betexit) + else + call pstop(1, "Invalid isolv, expected 0, 1, 2, or 3") + end if + end if + end if + ! -- End variable-beta case + end if + end if + ! -- End canonical face 1 (gamma = 0.) or 2 (alpha = 0.) + end if + + if (texit .ne. huge(1d0) .and. texit .lt. 0d0) & + call pstop(1, "texit is negative (unexpected)") ! shouldn't get here + + end subroutine + + !> @brief Brent's method applied to canonical face 1 (gamma = 0) + function fbary1(bet) result(fb) + ! -- dummy + real(DP), intent(in) :: bet + real(DP) :: fb + ! -- local + real(DP) :: t + real(DP) :: alpt + + ! -- Evaluate gamma{t{beta}} = 1. - alpha{t{beta}} - beta + call get_t_alpt(bet, t, alpt) + fb = 1d0 - alpt - bet + end function + + !> @brief Brent's method applied to canonical face 2 (alpha = 0) + function fbary2(bet) result(fb) + ! -- dummy + real(DP), intent(in) :: bet + real(DP) :: fb + ! -- local + real(DP) :: t + real(DP) :: alpt + + ! -- Evaluate alpha{t{beta}} + call get_t_alpt(bet, t, alpt) + fb = alpt + end function + + !> @brief Given beta evaluate t and alpha depending on case + subroutine get_t_alpt(bet, t, alp) + ! -- dummy + real(DP), intent(in) :: bet + real(DP) :: t + real(DP) :: alp + ! -- local + real(DP) :: term + real(DP) :: zerotol + + ! kluge note: assumes cb2<>0, wbb<>0 as appropriate + zerotol = 1d-10 ! kluge + term = (bet - cb1) / cb2 + if (icase .eq. 1) then + term = max(term, zerotol) + t = dlog(term) / wbb + alp = ca1 + ca2 * dexp(waa * t) + ca3 * dexp(wbb * t) + else if (icase .eq. -1) then + term = max(term, zerotol) + t = dlog(term) / wbb + alp = ca1 + (ca2 + ca3 * t) * dexp(waa * t) + else if (icase .eq. 2) then + term = max(term, zerotol) + t = dlog(term) / wbb + alp = ca1 + ca2 * t + ca3 * dexp(wbb * t) + else if (icase .eq. 3) then + t = term + alp = ca1 + ca2 * t + ca3 * dexp(waa * t) + else if (icase .eq. 4) then + t = term + alp = ca1 + (ca2 + ca3 * t) * t + end if + + end subroutine + + !> @brief Find outflow interval + subroutine get_bet_outflow_bary(vn1, vn2, betoutlo, betouthi) + ! -- dummy + real(DP) :: vn1 + real(DP) :: vn2 + real(DP) :: betoutlo + real(DP) :: betouthi + ! -- local + real(DP) :: vndiff + + vndiff = vn2 - vn1 + if (vn1 .lt. 0d0) then + ! -- Outflow at vn1 corner + betoutlo = 0d0 + if (vn2 .le. 0d0) then + ! -- Outflow along entire edge (except possibly no-flow right at vn2 corner) + betouthi = 1d0 + else + ! -- Outflow along part of edge + betouthi = -vn1 / vndiff + end if + else + ! -- Outflow at vn2 corner + betouthi = 1d0 + if (vn1 .le. 0d0) then + ! -- Outflow along entire edge (except possibly no-flow right at vn1 corner) + betoutlo = 0d0 + else + ! -- Outflow along part of edge + betoutlo = -vn1 / vndiff + end if + end if + + end subroutine + + !> @brief Find trend of and limits on beta from beta{t} solution + subroutine get_bet_soln_limits(beti, betsollo, betsolhi, ibettrend) + ! -- dummy + real(DP), intent(in) :: beti + real(DP) :: betsollo + real(DP) :: betsolhi + integer(I4B), intent(inout) :: ibettrend + ! -- local + real(DP) :: betlim + + if (wbb .gt. 0d0) then + betlim = -cv0(2) / wbb + if (beti .gt. betlim) then + betsolhi = huge(1d0) + betsollo = beti + ibettrend = 1 + else if (beti .lt. betlim) then + betsolhi = beti + betsollo = -huge(1d0) + ibettrend = -1 + else + betsolhi = beti + betsollo = beti + ibettrend = 0 + end if + else if (wbb .lt. 0d0) then + betlim = -cv0(2) / wbb + if (beti .gt. betlim) then + betsolhi = beti + betsollo = betlim + ibettrend = -1 + else if (beti .lt. betlim) then + betsolhi = betlim + betsollo = beti + ibettrend = 1 + else + betsolhi = beti + betsollo = beti + ibettrend = 0 + end if + else ! kluge note: use zerotol and elsewhere? + if (cv0(2) .gt. 0d0) then + betsolhi = huge(1d0) + betsollo = beti + ibettrend = 1 + else if (cv0(2) .lt. 0d0) then + betsolhi = beti + betsollo = -huge(1d0) + ibettrend = -1 + else + betsolhi = beti + betsollo = beti + ibettrend = 0 + end if + end if + + end subroutine + + !> @brief Use Brent's method with initial bounds on beta of betlo and bethi + subroutine soln_brent(itriface, betlo, bethi, tol, & + texit, alpexit, betexit) + ! -- dummy + integer(I4B), intent(in) :: itriface + real(DP) :: betlo + real(DP) :: bethi + real(DP), intent(in) :: tol + real(DP) :: texit + real(DP) :: alpexit + real(DP) :: betexit + ! -- local + real(DP) :: itmax + real(DP) :: itact + real(DP) :: blo + real(DP) :: bhi + procedure(f1d), pointer :: f + + ! -- assuming betlo and bethi bracket the root + ! -- + ! tol = 1d-7 ! kluge + itmax = 50 ! kluge + itact = itmax + 1 ! kluge + blo = betlo + bhi = bethi + if (itriface .eq. 1) then + f => fbary1 + betexit = zero_br(blo, bhi, f, tol) + else + f => fbary2 + betexit = zero_br(blo, bhi, f, tol) + end if + call get_t_alpt(betexit, texit, alpexit) + + end subroutine + + !> @brief Use Chandrupatla's method with initial bounds on beta of betlo and bethi + subroutine soln_chand(itriface, betlo, bethi, tol, & + texit, alpexit, betexit) + ! -- dummy + integer(I4B), intent(in) :: itriface + real(DP) :: betlo + real(DP) :: bethi + real(DP), intent(in) :: tol + real(DP) :: texit + real(DP) :: alpexit + real(DP) :: betexit + ! -- local + real(DP) :: itmax + real(DP) :: itact + real(DP) :: blo + real(DP) :: bhi + procedure(f1d), pointer :: f + + ! -- note: assuming betlo and bethi bracket the root + ! tol = 1d-7 ! kluge + itmax = 50 ! kluge + itact = itmax + 1 ! kluge + blo = betlo + bhi = bethi + if (itriface .eq. 1) then + f => fbary1 + betexit = zero_ch(blo, bhi, f, tol) + else + f => fbary2 + betexit = zero_ch(blo, bhi, f, tol) + end if + call get_t_alpt(betexit, texit, alpexit) + + end subroutine + + !> @brief Use a test method with initial bounds on beta of betlo and bethi + subroutine soln_test(itriface, betlo, bethi, tol, & + texit, alpexit, betexit) + ! -- dummy + integer(I4B), intent(in) :: itriface + real(DP) :: betlo + real(DP) :: bethi + real(DP), intent(in) :: tol + real(DP) :: texit + real(DP) :: alpexit + real(DP) :: betexit + ! -- local + real(DP) :: itmax + real(DP) :: itact + real(DP) :: blo + real(DP) :: bhi + procedure(f1d), pointer :: f + + ! -- assuming betlo and bethi bracket the root + ! tol = 1d-7 ! kluge + itmax = 50 ! kluge + itact = itmax + 1 ! kluge + blo = betlo + bhi = bethi + if (itriface .eq. 1) then + f => fbary1 + betexit = zero_test(blo, bhi, f, tol) + else + f => fbary2 + betexit = zero_test(blo, bhi, f, tol) + end if + call get_t_alpt(betexit, texit, alpexit) + + end subroutine + + !> @brief Use Euler integration to find exit + subroutine soln_euler(itriface, alpi, beti, step, vziodz, & + az, texit, alpexit, betexit) + ! -- dummy + integer(I4B), intent(in) :: itriface + real(DP) :: alpi + real(DP) :: beti + real(DP), intent(in) :: step + real(DP) :: vziodz + real(DP) :: az + real(DP) :: texit + real(DP) :: alpexit + real(DP) :: betexit + ! -- local + real(DP) :: alp + real(DP) :: bet + real(DP) :: gam + real(DP) :: alpold + real(DP) :: betold + real(DP) :: gamold + real(DP) :: wt + real(DP) :: omwt + real(DP) :: t + real(DP) :: told + + t = 0d0 + alp = alpi + bet = beti + if (itriface .eq. 1) gam = 1d0 - alpi - beti + do nt = 1, 1000000000 ! kluge hardwired + ! -- Save current time, alpha, and beta + told = t + alpold = alp + betold = bet + ! -- Step forward in time + ! t = dble(nt)*step + call step_euler(nt, step, vziodz, az, alpi, beti, t, alp, bet) + ! if (nt.eq.0) then + ! znum = zi + ! else + ! vz = vzbot + az*(znum - zbot) + ! znum = znum + vz*delt ! kluge note: can be smart about checking z + ! end if + if (itriface .eq. 1) then + ! -- If gamma has crossed zero, interpolate linearly + ! -- to find crossing (exit) point + gamold = gam + gam = 1d0 - alp - bet + if (gam .lt. 0d0) then + wt = gamold / (gamold - gam) + omwt = 1d0 - wt + texit = omwt * told + wt * t + alpexit = omwt * alpold + wt * alp + betexit = omwt * betold + wt * bet + exit + end if + else + ! -- If alpha has crossed zero, interpolate linearly + ! -- to find crossing (exit) point + if (alp .lt. 0d0) then + wt = alpold / (alpold - alp) + omwt = 1d0 - wt + texit = omwt * told + wt * t + alpexit = omwt * alpold + wt * alp + betexit = omwt * betold + wt * bet + exit + end if + end if + ! -- End time step loop + end do + if (nt .gt. 1000000000) then ! kluge hardwired + ! -- Exit not found after max number of time steps + call pstop(1, "Didn't find exit in soln_euler") + end if + + end subroutine + +end module TernarySolveTrack diff --git a/src/Utilities/BlockParser.f90 b/src/Utilities/BlockParser.f90 index 887955ff972..d808748f036 100644 --- a/src/Utilities/BlockParser.f90 +++ b/src/Utilities/BlockParser.f90 @@ -6,7 +6,7 @@ !< module BlockParserModule - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use DevFeatureModule, only: dev_feature use ConstantsModule, only: LENBIGLINE, LENHUGELINE, LINELENGTH, MAXCHARLEN use InputOutputModule, only: urword, upcase, openfile, & @@ -39,6 +39,7 @@ module BlockParserModule procedure, public :: GetCellid procedure, public :: GetCurrentLine procedure, public :: GetDouble + procedure, public :: TryGetDouble procedure, public :: GetInteger procedure, public :: GetLinesRead procedure, public :: GetNextLine @@ -313,11 +314,29 @@ function GetDouble(this) result(r) if (istart == istop .and. istop == len(this%line)) then call this%ReadScalarError('DOUBLE PRECISION') end if - ! - ! -- return - return + end function GetDouble + subroutine TryGetDouble(this, r, success) + ! -- dummy variables + class(BlockParserType), intent(inout) :: this !< BlockParserType object + real(DP), intent(inout) :: r !< double precision real variable + logical(LGP), intent(inout) :: success !< whether parsing was successful + ! -- local variables + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: ival + + call urword(this%line, this%lloc, istart, istop, 3, ival, r, & + this%iout, this%iuext) + + success = .true. + if (istart == istop .and. istop == len(this%line)) then + success = .false. + end if + + end subroutine TryGetDouble + !> @ brief Issue a read error !! !! Method to issue an unable to read error. diff --git a/src/Utilities/GeomUtil.f90 b/src/Utilities/GeomUtil.f90 index 9d1bad53c2b..9fdd947e99f 100644 --- a/src/Utilities/GeomUtil.f90 +++ b/src/Utilities/GeomUtil.f90 @@ -6,8 +6,7 @@ module GeomUtilModule private public :: between, point_in_polygon, & get_node, get_ijk, get_jk, & - skew, transform, & - compose + skew, transform, compose contains !> @brief Check if a value is between two other values (inclusive). @@ -17,8 +16,10 @@ logical function between(x, a, 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 + !! + !! Vertices and edge points are considered in the polygon. + !! Adapted from https://stackoverflow.com/a/63436180/6514033, + !< logical function point_in_polygon(x, y, poly) ! dummy real(DP), intent(in) :: x !< x point coordinate @@ -38,23 +39,27 @@ logical function point_in_polygon(x, y, poly) xb = poly(1, ii) yb = poly(2, ii) - if ((x == xa .and. y == ya) .or. (x == xb .and. y == yb)) then + 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 + 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 + 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 + if (c == 0.0_DP) then ! on edge point_in_polygon = .true. exit diff --git a/src/Utilities/MathUtil.f90 b/src/Utilities/MathUtil.f90 index f53c1d3d21c..058f32d5f1d 100644 --- a/src/Utilities/MathUtil.f90 +++ b/src/Utilities/MathUtil.f90 @@ -7,7 +7,7 @@ module MathUtilModule implicit none private - public :: f1d, is_close, mod_offset, zeroch, zeroin, zerotest + public :: f1d, is_close, mod_offset, zero_ch, zero_br, zero_test interface mod_offset module procedure :: mod_offset_int, mod_offset_dbl @@ -128,7 +128,7 @@ end function mod_offset_dbl !! Simulation of Classical and Quantum Systems," 2nd ed., Springer, New York. !! !< - function zeroch(x0, x1, f, epsa) result(z) + function zero_ch(x0, x1, f, epsa) result(z) ! -- dummy real(DP) :: x0, x1 procedure(f1d), pointer, intent(in) :: f @@ -240,11 +240,11 @@ function zeroch(x0, x1, f, epsa) result(z) !! !! Output: !! - !! zeroin abscissa approximating a zero of f in the interval ax,bx + !! zero_br 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 + !! satisfied. zero_br 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. @@ -252,7 +252,7 @@ function zeroch(x0, x1, f, epsa) result(z) !! 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) + function zero_br(ax, bx, f, tol) result(z) ! -- dummy real(DP) :: ax, bx procedure(f1d), pointer, intent(in) :: f @@ -352,10 +352,10 @@ function zeroin(ax, bx, f, tol) result(z) fb = f(b) rs = (fb * (fc / dabs(fc))) .gt. 0.0d0 end do - end function zeroin + end function zero_br - !> @brief Compute a zero of the function f(x) in the interval (x0, x1) - function zerotest(x0, x1, f, epsa) result(z) + !> @brief Compute a zero of f(x) in the interval (x0, x1) with a test method. + function zero_test(x0, x1, f, epsa) result(z) ! -- dummy real(DP) :: x0, x1 procedure(f1d), pointer, intent(in) :: f diff --git a/src/Utilities/Observation/Obs.f90 b/src/Utilities/Observation/Obs.f90 index b1d1867ad38..93ec3b973f3 100644 --- a/src/Utilities/Observation/Obs.f90 +++ b/src/Utilities/Observation/Obs.f90 @@ -980,7 +980,7 @@ end function get_obs !> @ brief Read observation blocks !! - !! Subroutine to read CONTIGUIUS block from the observation input file. + !! Subroutine to read CONTIGUOUS block from the observation input file. !! !< subroutine read_obs_blocks(this, fname) diff --git a/src/meson.build b/src/meson.build index b0539631c9c..5b33ba2e0e3 100644 --- a/src/meson.build +++ b/src/meson.build @@ -32,18 +32,20 @@ modflow_sources = files( 'Exchange' / 'GhostNode.f90', 'Exchange' / 'GwfExchangeMover.f90', 'Exchange' / 'NumericalExchange.f90', - 'Exchange' / 'exg-gwfgwe.f90', 'Exchange' / 'exg-gwfgwf.f90', 'Exchange' / 'exg-gwfgwt.f90', 'Exchange' / 'exg-gwtgwt.f90', + 'Exchange' / 'exg-gwfgwe.f90', 'Exchange' / 'exg-gwegwe.f90', 'Exchange' / 'exg-swfgwf.f90', + 'Exchange' / 'exg-gwfprt.f90', 'Idm' / 'exg-gwfgwfidm.f90', 'Idm' / 'exg-gwfgwtidm.f90', 'Idm' / 'exg-gwtgwtidm.f90', 'Idm' / 'exg-gwfgweidm.f90', 'Idm' / 'exg-gwegweidm.f90', 'Idm' / 'exg-swfgwfidm.f90', + 'Idm' / 'exg-gwfprtidm.f90', 'Idm' / 'gwe-cndidm.f90', 'Idm' / 'gwe-ctpidm.f90', 'Idm' / 'gwe-disidm.f90', @@ -83,12 +85,17 @@ modflow_sources = files( 'Idm' / 'swf-zdgidm.f90', 'Idm' / 'sim-namidm.f90', 'Idm' / 'sim-tdisidm.f90', + 'Idm' / 'prt-namidm.f90', + 'Idm' / 'prt-disidm.f90', + 'Idm' / 'prt-disvidm.f90', + 'Idm' / 'prt-mipidm.f90', 'Idm' / 'selector' / 'IdmDfnSelector.f90', 'Idm' / 'selector' / 'IdmExgDfnSelector.f90', 'Idm' / 'selector' / 'IdmGweDfnSelector.f90', 'Idm' / 'selector' / 'IdmGwfDfnSelector.f90', 'Idm' / 'selector' / 'IdmGwtDfnSelector.f90', 'Idm' / 'selector' / 'IdmSwfDfnSelector.f90', + 'Idm' / 'selector' / 'IdmPrtDfnSelector.f90', 'Idm' / 'selector' / 'IdmSimDfnSelector.f90', 'Model' / 'Connection' / 'ConnectionBuilder.f90', 'Model' / 'Connection' / 'CellWithNbrs.f90', @@ -115,7 +122,6 @@ modflow_sources = files( 'Model' / 'GroundWaterEnergy' / 'gwe-mwe.f90', 'Model' / 'GroundWaterEnergy' / 'gwe-sfe.f90', 'Model' / 'GroundWaterEnergy' / 'gwe-uze.f90', - 'Model' / 'GroundWaterFlow' / 'gwf.f90', 'Model' / 'GroundWaterFlow' / 'gwf-api.f90', 'Model' / 'GroundWaterFlow' / 'gwf-buy.f90', @@ -125,7 +131,6 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf-disu.f90', 'Model' / 'GroundWaterFlow' / 'gwf-disv.f90', 'Model' / 'GroundWaterFlow' / 'gwf-drn.f90', - 'Model' / 'GroundWaterFlow' / 'gwf-evt.f90', 'Model' / 'GroundWaterFlow' / 'gwf-ghb.f90', 'Model' / 'GroundWaterFlow' / 'gwf-hfb.f90', @@ -156,11 +161,9 @@ modflow_sources = files( 'Model' / 'GroundWaterTransport' / 'gwt-sft.f90', 'Model' / 'GroundWaterTransport' / 'gwt-src.f90', 'Model' / 'GroundWaterTransport' / 'gwt-uzt.f90', - 'Model' / 'SurfaceWaterFlow' / 'swf.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-disl.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-cxs.f90', - 'Model' / 'SurfaceWaterFlow' / 'swf-dfw.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-ic.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-obs.f90', @@ -168,6 +171,12 @@ modflow_sources = files( 'Model' / 'SurfaceWaterFlow' / 'swf-flw.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-sto.f90', 'Model' / 'SurfaceWaterFlow' / 'swf-zdg.f90', + 'Model' / 'ParticleTracking' / 'prt.f90', + 'Model' / 'ParticleTracking' / 'prt-fmi.f90', + 'Model' / 'ParticleTracking' / 'prt-mip.f90', + 'Model' / 'ParticleTracking' / 'prt-obs.f90', + 'Model' / 'ParticleTracking' / 'prt-oc.f90', + 'Model' / 'ParticleTracking' / 'prt-prp.f90', 'Model' / 'ModelUtilities' / 'BoundaryPackage.f90', 'Model' / 'ModelUtilities' / 'BoundaryPackageExt.f90', 'Model' / 'ModelUtilities' / 'GweCndOptions.f90', @@ -191,6 +200,10 @@ modflow_sources = files( 'Model' / 'ModelUtilities' / 'SfrCrossSectionUtils.f90', 'Model' / 'ModelUtilities' / 'SwfCxsUtils.f90', 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', + 'Model' / 'ModelUtilities' / 'TimeSelect.f90', + 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', + 'Model' / 'ModelUtilities' / 'SwfCxsUtils.f90', + 'Model' / 'ModelUtilities' / 'TrackData.f90', 'Model' / 'ModelUtilities' / 'UzfCellGroup.f90', 'Model' / 'ModelUtilities' / 'Xt3dAlgorithm.f90', 'Model' / 'ModelUtilities' / 'Xt3dInterface.f90', @@ -221,8 +234,32 @@ modflow_sources = files( 'Solution' / 'NumericalSolution.f90', 'Solution' / 'SolutionFactory.F90', 'Solution' / 'SolutionGroup.f90', + 'Solution' / 'ParticleTracker' / 'Cell.f90', + 'Solution' / 'ParticleTracker' / 'CellDefn.f90', + 'Solution' / 'ParticleTracker' / 'CellPoly.f90', + 'Solution' / 'ParticleTracker' / 'CellRect.f90', + 'Solution' / 'ParticleTracker' / 'CellRectQuad.f90', + 'Solution' / 'ParticleTracker' / 'CellUtil.f90', + 'Solution' / 'ParticleTracker' / 'Method.f90', + 'Solution' / 'ParticleTracker' / 'MethodCellPollock.f90', + 'Solution' / 'ParticleTracker' / 'MethodCellPollockQuad.f90', + 'Solution' / 'ParticleTracker' / 'MethodCellPool.f90', + 'Solution' / 'ParticleTracker' / 'MethodCellTernary.f90', + 'Solution' / 'ParticleTracker' / 'MethodDis.f90', + 'Solution' / 'ParticleTracker' / 'MethodDisv.f90', + 'Solution' / 'ParticleTracker' / 'MethodPool.f90', + 'Solution' / 'ParticleTracker' / 'MethodCellPassToBot.f90', + 'Solution' / 'ParticleTracker' / 'MethodSubcellPollock.f90', + 'Solution' / 'ParticleTracker' / 'MethodSubcellPool.f90', + 'Solution' / 'ParticleTracker' / 'MethodSubcellTernary.f90', + 'Solution' / 'ParticleTracker' / 'Particle.f90', + 'Solution' / 'ParticleTracker' / 'Subcell.f90', + 'Solution' / 'ParticleTracker' / 'SubcellRect.f90', + 'Solution' / 'ParticleTracker' / 'SubcellTri.f90', + 'Solution' / 'ParticleTracker' / 'TernarySolveTrack.f90', + 'Solution' / 'BaseSolution.f90', + 'Solution' / 'ExplicitSolution.f90', 'Timing' / 'ats.f90', - 'Timing' / 'tdis.f90', 'Utilities' / 'ArrayRead' / 'ArrayReaderBase.f90', 'Utilities' / 'ArrayRead' / 'Double1dReader.f90', @@ -247,7 +284,6 @@ modflow_sources = files( 'Utilities' / 'Idm' / 'mf6blockfile' / 'StressListInput.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructArray.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructVector.f90', - 'Utilities' / 'Matrix' / 'MatrixBase.f90', 'Utilities' / 'Matrix' / 'SparseMatrix.f90', 'Utilities' / 'Memory' / 'Memory.f90', @@ -286,6 +322,7 @@ modflow_sources = files( 'Utilities' / 'CharString.f90', 'Utilities' / 'comarg.f90', 'Utilities' / 'compilerversion.F90', + 'Utilities' / 'CharString.f90', 'Utilities' / 'Constants.f90', 'Utilities' / 'defmacro.F90', 'Utilities' / 'DevFeature.f90', @@ -308,7 +345,7 @@ modflow_sources = files( 'Utilities' / 'SimVariables.f90', 'Utilities' / 'SmoothingFunctions.f90', 'Utilities' / 'sort.f90', - 'Utilities' / 'Sparse.f90', + 'Utilities' / 'Sparse.f90', 'Utilities' / 'STLVecInt.f90', 'Utilities' / 'StringList.f90', 'Utilities' / 'Table.f90', @@ -317,7 +354,6 @@ modflow_sources = files( 'Utilities' / 'version.f90', 'mf6core.f90', 'mf6lists.f90', - 'SimulationCreate.f90', 'RunControl.f90', 'RunControlFactory.F90' diff --git a/utils/idmloader/dfns.txt b/utils/idmloader/dfns.txt index e958f7bfd2a..f67efab0ab0 100644 --- a/utils/idmloader/dfns.txt +++ b/utils/idmloader/dfns.txt @@ -51,10 +51,17 @@ swf-chd.dfn swf-flw.dfn swf-zdg.dfn +# prt model +prt-nam.dfn +prt-dis.dfn +prt-disv.dfn +prt-mip.dfn + # exchanges exg-gwfgwf.dfn exg-gwfgwt.dfn exg-gwtgwt.dfn exg-gwfgwe.dfn exg-gwegwe.dfn -exg-swfgwf.dfn \ No newline at end of file +exg-swfgwf.dfn +exg-gwfprt.dfn \ No newline at end of file From e4c414fde383796cff16ebc6dca17ebe8f59e10f Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 23 Feb 2024 08:19:00 -0500 Subject: [PATCH 2/4] skip voronoi test case causing FPE in mac CI for now --- autotest/test_prt_voronoi1.py | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/autotest/test_prt_voronoi1.py b/autotest/test_prt_voronoi1.py index 192550a3080..257be507ea5 100644 --- a/autotest/test_prt_voronoi1.py +++ b/autotest/test_prt_voronoi1.py @@ -15,7 +15,9 @@ """ from math import isclose +from os import environ from pathlib import Path +from platform import system import flopy import matplotlib as mpl @@ -29,6 +31,7 @@ from flopy.utils.voronoi import VoronoiGrid from prt_test_utils import get_model_name from shapely.geometry import LineString, Point +from modflow_devtools.misc import is_in_ci from framework import TestFramework @@ -401,6 +404,14 @@ def callback(mesh, value): @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): + if ( + "weli" in name + and system() == "Darwin" + and environ.get("FC") == "ifort" + and is_in_ci() + ): + pytest.skip(f"FPE (div by 0) with ifort 2021.7 in macOS CI") + test = TestFramework( name=name, workspace=function_tmpdir, From c97c9d309cfd63541145ffeabc6348b0d3a2847f Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 23 Feb 2024 10:14:05 -0500 Subject: [PATCH 3/4] remove edits from README --- README.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/README.md b/README.md index 0acb60eac81..15ec9fb662f 100644 --- a/README.md +++ b/README.md @@ -67,14 +67,12 @@ Instructions for building definition files for new packages are summarized in [d MODFLOW is a popular open-source groundwater flow model distributed by the U.S. Geological Survey. For 30 years, the MODFLOW program has been widely used by academic researchers, private consultants, and government scientists to accurately, reliably, and efficiently simulate groundwater flow. With time, growing interest in surface and groundwater interactions, local refinement with nested and unstructured grids, karst groundwater flow, solute transport, and saltwater intrusion, has led to the development of numerous MODFLOW versions. Although these MODFLOW versions are often based on the core version (presently MODFLOW-2005), there are often incompatibilities that restrict their use with one another. In many cases, development of these alternative versions has been challenging due to the underlying MODFLOW structure, which was designed for the simulation with a single groundwater flow model using a rectilinear grid. -MODFLOW 6 is the latest core version of MODFLOW. It synthesizes many of the capabilities available in MODFLOW-2005, MODFLOW-NWT, and MODFLOW-LGR. MODFLOW 6 was built on a new object-oriented framework that allows new packages and models to be added, and allows any number of models to be run simultaneously in a single simulation. Model may be coupled sequentially, such as for flow and transport, or the models may be tightly coupled at the matrix level, such as for multiple flow models. MODFLOW 6 presently contains three types of hydrologic models, the Groundwater Flow (GWF) Model, the Groundwater Transport (GWT) Model, and the Particle Tracking (PRT) Model. +MODFLOW 6 is the latest core version of MODFLOW. It synthesizes many of the capabilities available in MODFLOW-2005, MODFLOW-NWT, and MODFLOW-LGR. MODFLOW 6 was built on a new object-oriented framework that allows new packages and models to be added, and allows any number of models to be run simultaneously in a single simulation. Model may be coupled sequentially, such as for flow and transport, or the models may be tightly coupled at the matrix level, such as for multiple flow models. MODFLOW 6 presently contains two types of hydrologic models, the Groundwater Flow (GWF) Model and the Groundwater Transport (GWT) Model. The Groundwater Flow (GWF) Model was the first model to be released in MODFLOW 6. It supports regular MODFLOW grids consisting of layers, rows, and columns, but it also supports more flexible grids that may conform to irregular boundaries or have increased resolution in areas of interest. The GWF Model consists of the original MODFLOW stress packages (CHD, WEL, DRN, RIV, GHB, RCH, and EVT) and four advanced stress packages (MAW, SFR, LAK, and UZF), which have been distilled from their predecessors to contain the most commonly used capabilities. MODFLOW 6 contains a new Water Mover (MVR) Package that can transfer water from provider packages to receiver packages. Providers can be many of the stress and advanced stress packages; receivers can be any of the advanced stress packages. This new capability makes it possible to route water between lakes and streams, route rejected infiltration into a nearby stream, or augment lakes using groundwater pumped from wells, for example. To modernize user interaction with the program, the MODFLOW 6 input structure was redesigned. Within package input files, information is divided into blocks, and informative keywords are used to label numeric data and activate options. This new input structure was designed to make it easier for users to adjust simulation options in an intuitive manner, reduce user input errors, and allow new capabilities to be added without causing problems with backward compatibility. The GWT model for MODFLOW 6 simulates three-dimensional transport of a single solute species in flowing groundwater. The GWT Model solves the solute transport equation using numerical methods and a generalized CVFD approach, which can be used with regular MODFLOW grids or with unstructured grids. The GWT Model is designed to work with most of the new capabilities released with the GWF Model, including the Newton flow formulation, unstructured grids, advanced packages, and the movement of water between packages. The GWF and GWT Models operate simultaneously during a MODFLOW 6 simulation to represent coupled groundwater flow and solute transport. The GWT Model can also run separately from a GWF Model by reading the heads and flows saved by a previously run GWF Model. The GWT model is also capable of working with the flows from another groundwater flow model, as long as the flows from that model can be written in the correct form to flow and head files. -The Particle Tracking (PRT) Model simulates three-dimensional particle trajectories in flowing groundwater. The PRT Model can operate simultaneously with a GWF model via an exchange, or can consume GWF outputs via Flow Model Interface (FMI). The PRT Model solves structured DIS grids analytically and unstructured DISV grids semi-analytically. Tracking delegates from the model domain to individual cells, and to sub-components of cells for DISV grids. On structured grids the approach reduces to Pollock's method used in MODPATH 7. On DISV grids, polygonal cells are decomposed into triangles, within which particle exit faces/times are solved numerically. Track data are recorded at the boundaries between spatial volumes (cells or subcells) and time segments (timesteps or stress periods), and at other relevant times, e.g. release and termination. Events to record may be configured by the user. Though each particle's motion may be computed independently, parallel solving is not yet supported. Particle exchange between models is also planned but not yet supported. Particle mass is conserved at the cell level, but may not be conserved at the subcell level for DISV grids. - ## How to Cite MODFLOW 6 From 07e8143d710eafbdca6d42fbdd0203afba1bf7ce Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 23 Feb 2024 10:20:31 -0500 Subject: [PATCH 4/4] cleanup src/meson.build and unit tests --- autotest/TestGeomUtil.f90 | 1 - autotest/TestList.f90 | 1 + src/meson.build | 4 ---- 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/autotest/TestGeomUtil.f90 b/autotest/TestGeomUtil.f90 index 933f485e7cd..3447f8eb6e9 100644 --- a/autotest/TestGeomUtil.f90 +++ b/autotest/TestGeomUtil.f90 @@ -292,7 +292,6 @@ subroutine test_point_in_polygon_irr(error) deallocate (face_pts) end subroutine test_point_in_polygon_irr - !> @brief Test 2D skew subroutine test_skew(error) type(error_type), allocatable, intent(out) :: error real(DP) :: v(2) diff --git a/autotest/TestList.f90 b/autotest/TestList.f90 index 0de78859e14..605460ec9d2 100644 --- a/autotest/TestList.f90 +++ b/autotest/TestList.f90 @@ -112,6 +112,7 @@ subroutine test_get_next_previous_item_reset(error) type(ListType), pointer :: list type(IntNodeType), pointer :: n1, n2, n3 class(*), pointer :: p + integer(I4B) :: i allocate (list) allocate (n1) diff --git a/src/meson.build b/src/meson.build index 5b33ba2e0e3..9836a06a526 100644 --- a/src/meson.build +++ b/src/meson.build @@ -201,8 +201,6 @@ modflow_sources = files( 'Model' / 'ModelUtilities' / 'SwfCxsUtils.f90', 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', 'Model' / 'ModelUtilities' / 'TimeSelect.f90', - 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', - 'Model' / 'ModelUtilities' / 'SwfCxsUtils.f90', 'Model' / 'ModelUtilities' / 'TrackData.f90', 'Model' / 'ModelUtilities' / 'UzfCellGroup.f90', 'Model' / 'ModelUtilities' / 'Xt3dAlgorithm.f90', @@ -257,8 +255,6 @@ modflow_sources = files( 'Solution' / 'ParticleTracker' / 'SubcellRect.f90', 'Solution' / 'ParticleTracker' / 'SubcellTri.f90', 'Solution' / 'ParticleTracker' / 'TernarySolveTrack.f90', - 'Solution' / 'BaseSolution.f90', - 'Solution' / 'ExplicitSolution.f90', 'Timing' / 'ats.f90', 'Timing' / 'tdis.f90', 'Utilities' / 'ArrayRead' / 'ArrayReaderBase.f90',