From 3487570add48fa125edd420f35c66f3265eaf071 Mon Sep 17 00:00:00 2001 From: w-bonelli Date: Tue, 28 Mar 2023 16:52:21 -0400 Subject: [PATCH] feat(PRT): add particle tracking model Co-authored-by: Alden Provost --- .github/workflows/ci.yml | 10 +- autotest/TestGeomUtil.f90 | 1 + autotest/prt/prt_test_utils.py | 294 ++++ autotest/prt/test_prt_exg01.py | 335 +++++ autotest/prt/test_prt_fmi01.py | 323 +++++ autotest/prt/test_prt_fmi02.py | 439 ++++++ autotest/prt/test_prt_fmi03.py | 402 ++++++ autotest/prt/test_prt_fmi04.py | 361 +++++ autotest/prt/test_prt_fmi05.py | 364 +++++ autotest/prt/test_prt_fmi06.py | 453 ++++++ autotest/prt/test_prt_fmi07.py | 131 ++ autotest/prt/test_prt_fmi08.py | 342 +++++ autotest/prt/test_prt_fmi09.py | 319 +++++ autotest/prt/test_prt_fmi10.py | 271 ++++ autotest/prt/test_prt_notebooks.py | 253 ++++ autotest/test_examples.py | 5 + 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 | 30 + doc/mf6io/mf6ivar/dfn/prt-nam.dfn | 73 + doc/mf6io/mf6ivar/dfn/prt-oc.dfn | 388 ++++++ doc/mf6io/mf6ivar/dfn/prt-prp.dfn | 300 ++++ 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 | 118 +- doc/mf6io/mf6ivar/mf6ivar.py | 9 + doc/mf6io/mf6ivar/tex/appendixA.tex | 29 + doc/mf6io/mf6ivar/tex/exg-gwfprt-desc.tex | 3 + doc/mf6io/mf6ivar/tex/gwf-evt-period.dat | 4 +- doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex | 4 +- doc/mf6io/mf6ivar/tex/gwf-evta-period.dat | 4 +- doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex | 4 +- 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 | 13 + doc/mf6io/mf6ivar/tex/prt-mip-griddata.dat | 8 + 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 | 73 + doc/mf6io/mf6ivar/tex/prt-oc-options.dat | 9 + doc/mf6io/mf6ivar/tex/prt-oc-period.dat | 4 + doc/mf6io/mf6ivar/tex/prt-prp-desc.tex | 79 ++ doc/mf6io/mf6ivar/tex/prt-prp-dimensions.dat | 3 + doc/mf6io/mf6ivar/tex/prt-prp-options.dat | 11 + 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/utl-spc-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 | 6 +- make/makedefaults | 14 +- make/makefile | 139 +- msvs/mf6.vfproj | 6 +- msvs/mf6core.vfproj | 40 + msvs/mf6lib.vfproj | 1 - src/Exchange/GwfPrtExchange.f90 | 356 +++++ src/Exchange/gwfprtidm.f90 | 70 + src/Model/ExplicitModel.f90 | 2 +- src/Model/GroundWaterFlow/gwf3disv8.f90 | 2 +- src/Model/GroundWaterFlow/gwf3mvr8.f90 | 1 - .../ModelUtilities/FlowModelInterface.f90 | 4 +- .../ModelUtilities/ModelPackageInput.f90 | 15 + src/Model/ModelUtilities/TrackData.f90 | 297 ++++ src/Model/ParticleTracking/prt1.f90 | 1234 +++++++++++++++++ src/Model/ParticleTracking/prt1dis1idm.f90 | 313 +++++ src/Model/ParticleTracking/prt1disv1idm.f90 | 460 ++++++ src/Model/ParticleTracking/prt1fmi1.f90 | 224 +++ src/Model/ParticleTracking/prt1idm.f90 | 196 +++ src/Model/ParticleTracking/prt1mip.f90 | 137 ++ src/Model/ParticleTracking/prt1mip1idm.f90 | 117 ++ src/Model/ParticleTracking/prt1obs1.f90 | 235 ++++ src/Model/ParticleTracking/prt1oc1.f90 | 287 ++++ src/Model/ParticleTracking/prt1prp1.f90 | 914 ++++++++++++ src/Model/TransportModel/tsp1.f90 | 1 - src/Model/TransportModel/tsp1mvt1.f90 | 1 - src/SimulationCreate.f90 | 15 +- src/Solution/ParticleTracker/Cell.f90 | 23 + src/Solution/ParticleTracker/CellDefn.f90 | 90 ++ src/Solution/ParticleTracker/CellPoly.f90 | 34 + src/Solution/ParticleTracker/CellRect.f90 | 54 + src/Solution/ParticleTracker/CellRectQuad.f90 | 221 +++ src/Solution/ParticleTracker/CellUtil.f90 | 169 +++ src/Solution/ParticleTracker/Method.f90 | 204 +++ .../ParticleTracker/MethodCellPassToBot.f90 | 61 + .../ParticleTracker/MethodCellPollock.f90 | 191 +++ .../ParticleTracker/MethodCellPollockQuad.f90 | 360 +++++ .../ParticleTracker/MethodCellPool.f90 | 42 + .../ParticleTracker/MethodCellTernary.f90 | 327 +++++ src/Solution/ParticleTracker/MethodDis.f90 | 403 ++++++ src/Solution/ParticleTracker/MethodDisv.f90 | 705 ++++++++++ src/Solution/ParticleTracker/MethodPool.f90 | 31 + .../ParticleTracker/MethodSubcellPollock.f90 | 383 +++++ .../ParticleTracker/MethodSubcellPool.f90 | 32 + .../ParticleTracker/MethodSubcellTernary.f90 | 382 +++++ 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 | 775 +++++++++++ src/Utilities/GeomUtil.f90 | 23 +- src/Utilities/Idm/selector/IdmDfnSelector.f90 | 13 + .../Idm/selector/IdmExgDfnSelector.f90 | 11 + .../Idm/selector/IdmPrtDfnSelector.f90 | 127 ++ src/meson.build | 43 +- utils/idmloader/scripts/dfn2f90.py | 20 + utils/mf5to6/make/makedefaults | 10 +- utils/mf5to6/make/makefile | 10 +- utils/zonebudget/make/makedefaults | 14 +- utils/zonebudget/make/makefile | 2 +- 137 files changed, 16870 insertions(+), 101 deletions(-) create mode 100644 autotest/prt/prt_test_utils.py create mode 100644 autotest/prt/test_prt_exg01.py create mode 100644 autotest/prt/test_prt_fmi01.py create mode 100644 autotest/prt/test_prt_fmi02.py create mode 100644 autotest/prt/test_prt_fmi03.py create mode 100644 autotest/prt/test_prt_fmi04.py create mode 100644 autotest/prt/test_prt_fmi05.py create mode 100644 autotest/prt/test_prt_fmi06.py create mode 100644 autotest/prt/test_prt_fmi07.py create mode 100644 autotest/prt/test_prt_fmi08.py create mode 100644 autotest/prt/test_prt_fmi09.py create mode 100644 autotest/prt/test_prt_fmi10.py create mode 100644 autotest/prt/test_prt_notebooks.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-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/GwfPrtExchange.f90 create mode 100644 src/Exchange/gwfprtidm.f90 create mode 100644 src/Model/ModelUtilities/TrackData.f90 create mode 100644 src/Model/ParticleTracking/prt1.f90 create mode 100644 src/Model/ParticleTracking/prt1dis1idm.f90 create mode 100644 src/Model/ParticleTracking/prt1disv1idm.f90 create mode 100644 src/Model/ParticleTracking/prt1fmi1.f90 create mode 100644 src/Model/ParticleTracking/prt1idm.f90 create mode 100644 src/Model/ParticleTracking/prt1mip.f90 create mode 100644 src/Model/ParticleTracking/prt1mip1idm.f90 create mode 100644 src/Model/ParticleTracking/prt1obs1.f90 create mode 100644 src/Model/ParticleTracking/prt1oc1.f90 create mode 100644 src/Model/ParticleTracking/prt1prp1.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 create mode 100644 src/Utilities/Idm/selector/IdmPrtDfnSelector.f90 diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 86edea78f9f..bcd8ed3c46b 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -207,7 +207,8 @@ jobs: - name: Checkout modflow6-examples uses: actions/checkout@v4 with: - repository: MODFLOW-USGS/modflow6-examples + repository: w-bonelli/modflow6-examples + ref: PRT path: modflow6-examples - name: Setup GNU Fortran ${{ env.GCC }} @@ -321,6 +322,13 @@ jobs: with: repository: MODFLOW-USGS/modflow6-testmodels path: modflow6-testmodels + + - name: Checkout modflow6-examples + uses: actions/checkout@v3 + with: + repository: w-bonelli/modflow6-examples + ref: PRT + path: modflow6-examples - name: Setup Micromamba uses: mamba-org/setup-micromamba@v1 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/prt/prt_test_utils.py b/autotest/prt/prt_test_utils.py new file mode 100644 index 00000000000..b8743ccdc6e --- /dev/null +++ b/autotest/prt/prt_test_utils.py @@ -0,0 +1,294 @@ +import os +from types import SimpleNamespace +from typing import Optional, 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() + + +def get_gwf_sim( + name, ws, mf6 +) -> Tuple[flopy.mf6.MFSimulation, SimpleNamespace]: + """ + Simple GWF simulation for use/modification by PRT tests + """ + + # test case context + ctx = SimpleNamespace( + 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, + # mp7 release points (cell-local coordinates) + 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) + ], + # PRT release points (cell indices and global coordinates both required) + 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) + ], + ) + + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.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=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.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, ctx + + +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) + + +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") + for i in range(ncpl): + x, y = verts[i, 0], verts[i, 1] + ax.annotate(str(i + 1), verts[i, :], color="b") + + # 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") + ax.annotate(str(i + 1), (x, y), color="grey") + + # 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/prt/test_prt_exg01.py b/autotest/prt/test_prt_exg01.py new file mode 100644 index 00000000000..813ec90ee82 --- /dev/null +++ b/autotest/prt/test_prt_exg01.py @@ -0,0 +1,335 @@ +""" +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 check_budget_data, check_track_data, get_gwf_sim + +from framework import TestFramework + +simname = "prtexg01" +ex = [simname, f"{simname}bnms"] + + +# model names +def get_model_name(idx, mdl): + return f"{ex[idx]}_{mdl}" + + +def build_sim(idx, ws, mf6): + # create simulation + name = ex[idx] + sim, ctx = get_gwf_sim(name, ws, mf6) + + # create prt model + prtname = get_model_name(idx, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # create prp package + rpts = ( + [r + [str(r[0] + 1)] for r in ctx.releasepts_prt] + if "bnms" in name + else ctx.releasepts_prt + ) + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(rpts), + packagedata=rpts, + perioddata={0: ["FIRST"]}, + boundnames="bnms" in name, + ) + + # create output control package + 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], + ) + + # 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 + gwfname = get_model_name(idx, "gwf") + flopy.mf6.ModflowGwfprt( + sim, + exgtype="GWF6-PRT6", + exgmnamea=gwfname, + exgmnameb=prtname, + filename=f"{gwfname}.gwfprt", + ) + + # add explicit model solution + ems = flopy.mf6.ModflowEms( + sim, + pname="ems", + filename=f"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim, ctx + + +def build_mp7_sim(ctx, idx, ws, mp7, gwf): + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in ctx.releasepts_mp7], + localx=[p[1] for p in ctx.releasepts_mp7], + localy=[p[2] for p in ctx.releasepts_mp7], + localz=[p[3] for p in ctx.releasepts_mp7], + timeoffset=0, + drape=0, + ) + mp7name = get_model_name(idx, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +def eval_results(ctx, test): + print(f"Evaluating results for sim {test.name}") + simpath = Path(test.workspace) + + # check budget data + check_budget_data(simpath / f"{test.name}_prt.lst", ctx.perlen, ctx.nper) + + # check particle track data + prt_track_file = simpath / f"{test.name}_prt.trk" + prt_track_hdr_file = simpath / f"{test.name}_prt.trk.hdr" + prt_track_csv_file = simpath / f"{test.name}_prt.trk.csv" + assert prt_track_file.exists() + assert prt_track_hdr_file.exists() + assert prt_track_csv_file.exists() + check_track_data( + track_bin=prt_track_file, + track_hdr=prt_track_hdr_file, + track_csv=prt_track_csv_file, + ) + + +@pytest.mark.parametrize("idx, name", enumerate(ex)) +def test_mf6model(idx, name, function_tmpdir, targets): + ws = function_tmpdir + sim, ctx = build_sim(idx, str(ws), targets.mf6) + sim.write_simulation() + + test = TestFramework( + name=name, + workspace=ws, + targets=targets, + check=lambda s: eval_results(ctx, s), + compare=None, + ) + test.run() + + # model names + gwfname = get_model_name(idx, "gwf") + prtname = get_model_name(idx, "prt") + mp7name = get_model_name(idx, "mp7") + + # extract model objects + gwf = sim.get_model(gwfname) + prt = sim.get_model(prtname) + + # extract model grid + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, idx, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(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(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=ws / prt_track_csv_file, + ) + + # extract head, budget, and specific discharge results from GWF model + gwf = sim.get_model(gwfname) + 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_{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) diff --git a/autotest/prt/test_prt_fmi01.py b/autotest/prt/test_prt_fmi01.py new file mode 100644 index 00000000000..b97909914af --- /dev/null +++ b/autotest/prt/test_prt_fmi01.py @@ -0,0 +1,323 @@ +""" +Tests ability to run a GWF model then a PRT model +in separate simulations via flow model interface. + +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. + +Two test cases are defined, one with the particle +release (PRP) package option STOP_AT_WEAK_SINK on +and one with the option off. No effect on results +are 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. +""" + + +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 (all_equal, check_budget_data, check_track_data, + get_gwf_sim, get_model_name, get_partdata, + has_default_boundnames) + +simname = "prtfmi01" +ex = [simname, f"{simname}saws"] + + +def build_prt_sim(ctx, name, ws, mf6): + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.tsmult)], + ) + + # create prt model + prtname = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # convert mp7 to prt release points and check against expectation + partdata = get_partdata(prt.modelgrid, ctx.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(ctx.releasepts_prt, releasepts) + + # create prp package + 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(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + stop_at_weak_sink="saws" in prtname, + boundnames=True, + ) + + # create output control package + 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], + ) + + # create the flow model interface + gwfname = get_model_name(name, "gwf") + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(ctx, name, ws, mp7, gwf): + # convert mp7 particledata to prt release points + partdata = get_partdata(gwf.modelgrid, ctx.releasepts_mp7) + + # create modpath 7 simulation + mp7name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # model names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + mp7name = get_model_name(name, "mp7") + + # build mf6 models + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + prtsim = build_prt_sim(ctx, name, ws, targets.mf6) + + # run mf6 models + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract mf6 models and grid + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, name, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + assert (ws / prp_track_file).is_file() + assert (ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(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(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ws / prt_track_csv_file, ws / prp_track_csv_file]: + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=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 + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) diff --git a/autotest/prt/test_prt_fmi02.py b/autotest/prt/test_prt_fmi02.py new file mode 100644 index 00000000000..59174e755ba --- /dev/null +++ b/autotest/prt/test_prt_fmi02.py @@ -0,0 +1,439 @@ +""" +This test is similar to test_prt_fmi01.py, except +particles are split across two release packages, +and the grid has an inactive region. This tests +that cell numbers recorded in pathline data have +been converted from reduced to user node numbers. +This is verified by using FloPy to intersect path +points with the grid, then compute node numbers. + +GWF and PRT models run in separate simulations +via flow model interface. + +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. + +Particles are released from the top left cell. + +Results are compared against a MODPATH 7 model. + +A case is defined for each TRACKEVENT optional +value to check that events can be selected. +""" + + +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 (check_budget_data, check_track_data, get_gwf_sim, + get_model_name) + +simname = "prtfmi02" +ex = [ + f"{simname}all", + f"{simname}rel", + f"{simname}trst", + f"{simname}tstp", + f"{simname}wksk", +] +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) + ], +} + + +def get_output_event(case_name): + return ( + "ALL" + if "all" in case_name + else "RELEASE" + if "rel" in case_name + else "TRANSIT" + if "trst" in case_name + else "TIMESTEP" + if "tstp" in case_name + else "WEAKSINK" + if "wksk" in case_name + else "TERMINATE" + if "terminate" in case_name + else "ALL" # default + ) + + +# 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(ctx, name, ws, mf6): + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.tsmult)], + ) + + # create prt model + prtname = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + idomain=create_idomain(ctx.nlay, ctx.nrow, ctx.ncol), + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # create a prp package for groups a and b + prps = [ + flopy.mf6.ModflowPrtprp( + prt, + pname=f"prp_{grp}", + filename=f"{prtname}_{grp}.prp", + nreleasepts=len(releasepts_prt[grp]), + packagedata=releasepts_prt[grp], + perioddata={0: ["FIRST"]}, + ) + for grp in ["a", "b"] + ] + + # create output control package + event = get_output_event(name) + 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], + trackevent=event, + ) + + # create the flow model interface + gwfname = get_model_name(name, "gwf") + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(ctx, name, ws, mp7, gwf): + mp7name = get_model_name(name, "mp7") + mp7_pathline_file = f"{mp7name}.mppth" + 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"{mp7name}_{grp}.sloc", + ) + for grp in ["a", "b"] + ] + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=pgs, + ) + + return mp + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # model names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + mp7name = get_model_name(name, "mp7") + + # build mf6 model + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + + # add idomain + gwf = gwfsim.get_model() + dis = gwf.get_package("DIS") + dis.idomain = create_idomain(ctx.nlay, ctx.nrow, ctx.ncol) + + # build prt model + prtsim = build_prt_sim(ctx, name, ws, targets.mf6) + + # run mf6 models + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract models + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + + # extract model grid + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, name, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(ws / prt_track_csv_file) + + # if event is ALL, output should be the same as MODPATH 7, + # so continue with comparisons. + # if event is RELEASE, expect 1 location for each particle. + # if event is TRANSIT, expect full results minus start loc. + # if event is TIMESTEP or WEAKSINK, output should be empty. + # in either case, return early and skip MP7 comparison. + event = get_output_event(name) + if event == "RELEASE" or event == "TERMINATE": + assert len(mf6_pls) == len(releasepts_prt["a"]) + len( + releasepts_prt["b"] + ) + return + elif event == "TRANSIT": + assert len(mf6_pls) == ( + len(mp7_pls) + - 2 * (len(releasepts_prt["a"]) + len(releasepts_prt["b"])) + ) + return + elif event == "TIMESTEP" or event == "WEAKSINK": + assert len(mf6_pls) == 0 + return + + # 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() + + 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(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=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(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") + + # 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 + + # 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["particleid"] + del mf6_pls["sequencenumber"] + del mf6_pls["particleidloc"] + del mf6_pls["xloc"] + del mf6_pls["yloc"] + del mf6_pls["zloc"] + del mp7_pls["particleid"] + 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) diff --git a/autotest/prt/test_prt_fmi03.py b/autotest/prt/test_prt_fmi03.py new file mode 100644 index 00000000000..b593c670b9b --- /dev/null +++ b/autotest/prt/test_prt_fmi03.py @@ -0,0 +1,402 @@ +""" +This test checks that zones defined in the model +input package (MIP) are correctly applied to the +particle tracking simulation, i.e. particles are +terminated when they enter the appropriate zone. + +GWF and PRT models run in separate simulations +via flow model interface. + +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. + +Results are compared against a MODPATH 7 model. +""" + + +from itertools import repeat +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 matplotlib.collections import LineCollection +from prt_test_utils import (check_budget_data, check_track_data, get_gwf_sim, + get_model_name) + +simname = "prtfmi03" +ex = [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(ctx, name, ws, mf6): + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.tsmult)], + ) + + # create prt model + prtname = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + ctx.nlay = int(name[-1]) + botm = [ctx.top - (k + 1) for k in range(ctx.nlay)] + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + top=ctx.top, + botm=botm, + ) + + # create mip package + izone = create_izone(ctx.nlay, ctx.nrow, ctx.ncol) + flopy.mf6.ModflowPrtmip( + prt, + pname="mip", + porosity=ctx.porosity, + izone=izone, # if ctx.nlay == 1 else np.array([izone, izone]), + ) + + # create prp package + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(ctx.releasepts_prt), + packagedata=ctx.releasepts_prt, + perioddata={0: ["FIRST"]}, + istopzone=1, + ) + + # create output control package + 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], + ) + + # create the flow model interface + gwfname = get_model_name(name, "gwf") + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim, ctx + + +def build_mp7_sim(ctx, name, ws, mp7, gwf): + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in ctx.releasepts_mp7], + localx=[p[1] for p in ctx.releasepts_mp7], + localy=[p[2] for p in ctx.releasepts_mp7], + localz=[p[3] for p in ctx.releasepts_mp7], + timeoffset=0, + drape=0, + ) + mp7name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.porosity, + ) + ctx.nlay = int(name[-1]) + izone = create_izone(ctx.nlay, ctx.nrow, ctx.ncol) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + stopzone=1, + zones=izone, # if ctx.nlay == 1 else np.array([izone, izone]), + zonedataoption="on", + particlegroups=[pg], + ) + + return mp + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + ws = function_tmpdir + + # define model names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + mp7name = get_model_name(name, "mp7") + + # build mf6 simulations + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + gwf = gwfsim.get_model() + dis = gwf.get_package("DIS") + ctx.nlay = int(name[-1]) + botm = [ctx.top - (k + 1) for k in range(ctx.nlay)] + botm_data = np.array( + [list(repeat(b, ctx.nrow * ctx.ncol)) for b in botm] + ).reshape((ctx.nlay, ctx.nrow, ctx.ncol)) + dis.nlay = ctx.nlay + dis.botm.set_data(botm_data) + prtsim, ctx = build_prt_sim(ctx, name, ws, targets.mf6) + + # run mf6 simulations + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract mf6 models + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + + # extract model grid + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, name, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(ws / prt_track_csv_file) + + # check budget data were written to mf6 prt list file + check_budget_data(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=ws / prt_track_csv_file, + ) + + # get head, budget, and spdis 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 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(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) diff --git a/autotest/prt/test_prt_fmi04.py b/autotest/prt/test_prt_fmi04.py new file mode 100644 index 00000000000..df5eab9ce36 --- /dev/null +++ b/autotest/prt/test_prt_fmi04.py @@ -0,0 +1,361 @@ +""" +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 (check_budget_data, check_track_data, get_gwf_sim, + get_ireason_code, get_model_name) + +simname = "prtfmi04" +ex = [simname, f"{simname}saws"] + + +def build_prt_sim(ctx, name, ws, mf6): + # output file names + gwfname = f"{name}_gwf" + prtname = f"{name}_prt" + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=ws, + ) + + # create tdis package + pd = (ctx.perlen, ctx.nstp, ctx.tsmult) + flopy.mf6.modflow.mftdis.ModflowTdis( + sim, + pname="tdis", + time_units="DAYS", + nper=ctx.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=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # create prp package + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(ctx.releasepts_prt), + packagedata=ctx.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(ctx, name, ws, mp7, gwf): + mp7name = f"{name}_mp7" + mp7_pathline_file = f"{mp7name}.mppth" + + partdata = flopy.modpath.ParticleData( + partlocs=[p[0] for p in ctx.releasepts_mp7], + localx=[p[1] for p in ctx.releasepts_mp7], + localy=[p[2] for p in ctx.releasepts_mp7], + localz=[p[3] for p in ctx.releasepts_mp7], + timeoffset=0, + drape=0, + ) + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.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) + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # output file names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + mp7name = get_model_name(name, "mp7") + + # build gwf model + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + + # add wel package + gwf = gwfsim.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 + prtsim = build_prt_sim(ctx, name, ws, targets.mf6) + + # run mf6 models + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract mf6 models and grid + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, name, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + + # check mp7 output files exist + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(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(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=ws / Path(prt_track_file.replace(".trk", ".trk.hdr")), + track_csv=ws / prt_track_csv_file, + ) + + # 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(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(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) diff --git a/autotest/prt/test_prt_fmi05.py b/autotest/prt/test_prt_fmi05.py new file mode 100644 index 00000000000..fa811407103 --- /dev/null +++ b/autotest/prt/test_prt_fmi05.py @@ -0,0 +1,364 @@ +""" +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. + +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 pprint import pformat +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 ( + all_equal, + check_budget_data, + check_track_data, + get_gwf_sim, + get_model_name, + get_partdata, +) + +simname = "prtfmi05" +cases = [ + # options block options + f"{simname}relt", # RELEASETIME 0.5 + # 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 get_perioddata(name, periods=1, fraction=None) -> Optional[dict]: + if "relt" 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(ctx, name, ws, mf6, fraction=None): + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.tsmult)], + ) + + # create prt model + prtname = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # convert mp7 particledata to prt release points + partdata = get_partdata(prt.modelgrid, ctx.releasepts_mp7) + releasepts = list(partdata.to_prp(prt.modelgrid)) + + # check release points match expectation + assert np.allclose(ctx.releasepts_prt, releasepts) + + # create prp package + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + pdat = get_perioddata(prtname, fraction=fraction) + # fraction 0.5 equiv. to release time 0.5 since 1 period 1 step with length 1 + trelease = fraction if "relt" in prtname else None + flopy.mf6.ModflowPrtprp( + prt, + pname="prp1", + filename=f"{prtname}_1.prp", + nreleasepts=len(releasepts), + packagedata=releasepts, + perioddata=pdat, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + releasetime=trelease, + ) + + # create output control package + 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], + ) + + # create the flow model interface + gwfname = get_model_name(name, "gwf") + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(ctx, name, ws, mp7, gwf): + # convert mp7 particledata to prt release points + partdata = get_partdata(gwf.modelgrid, ctx.releasepts_mp7) + + # create modpath 7 simulation + mp7name = get_model_name(name, "mp7") + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=ctx.porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="extend", + particlegroups=[pg], + ) + + return mp + + +@pytest.mark.parametrize("name", cases) +@pytest.mark.parametrize("fraction", [0.5]) +def test_mf6model(name, function_tmpdir, targets, fraction): + # workspace + ws = function_tmpdir + + # model names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + mp7name = get_model_name(name, "mp7") + + # build mf6 models + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + prtsim = build_prt_sim(ctx, name, ws, targets.mf6, fraction) + + # run mf6 models + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract mf6 models + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + + # extract model grid + mg = gwf.modelgrid + + # build mp7 model + mp7sim = build_mp7_sim(ctx, name, ws, targets.mp7, gwf) + + # run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + assert (ws / prp_track_file).is_file() + assert (ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(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(ws / f"{name}_prt.lst", ctx.perlen, ctx.nper) + + # check mf6 prt particle track data were written to binary/CSV files + # and that different formats are equal + for track_csv in [ws / prt_track_csv_file, ws / prp_track_csv_file]: + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=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 + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) diff --git a/autotest/prt/test_prt_fmi06.py b/autotest/prt/test_prt_fmi06.py new file mode 100644 index 00000000000..2bc117f1148 --- /dev/null +++ b/autotest/prt/test_prt_fmi06.py @@ -0,0 +1,453 @@ +""" +Tests particle tracking on a vertex (DISV) 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 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, +) + +simname = "prtfmi06" +ex = [f"{simname}", f"{simname}bprp"] + +# 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 + +# 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, dir, mf6): + # model name + gwfname = f"{ex[idx]}_gwf" + + # build MODFLOW 6 files + ws = dir + sim = flopy.mf6.MFSimulation( + sim_name=gwfname, 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=gwfname, 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(gwfname), + head_filerecord="{}.hds".format(gwfname), + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename="{}.oc".format(gwfname), + ) + + # 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"{gwfname}.obs.csv": obs_lst} + obs = flopy.mf6.ModflowUtlobs( + gwf, pname="head_obs", digits=20, continuous=obs_dict + ) + + return sim + + +def build_prt_sim(idx, ws, mf6): + # create simulation + name = ex[idx] + sim = flopy.mf6.MFSimulation( + sim_name=name, + exe_name=mf6, + version="mf6", + sim_ws=ws, + ) + + # create tdis package + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", nper=nper, perioddata=tdis_rc + ) + + # create prt model + prtname = f"{ex[idx]}_prt" + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # 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"{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(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"{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], + ) + + # create the flow model interface + gwfname = f"{ex[idx]}_gwf" + gwf_budget_file = f"{gwfname}.cbc" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +def build_mp7_sim(idx, ws, mp7, gwf): + # convert mp7 particledata to prt release points + partdata = get_partdata(gwf.modelgrid, releasepts_mp7) + + # create modpath 7 simulation + mp7name = f"{ex[idx]}_mp7" + pg = flopy.modpath.ParticleGroup( + particlegroupname="G1", + particledata=partdata, + filename=f"{mp7name}.sloc", + ) + mp = flopy.modpath.Modpath7( + modelname=mp7name, + flowmodel=gwf, + exe_name=mp7, + model_ws=ws, + ) + mpbas = flopy.modpath.Modpath7Bas( + mp, + porosity=porosity, + ) + mpsim = flopy.modpath.Modpath7Sim( + mp, + simulationtype="pathline", + trackingdirection="forward", + budgetoutputoption="summary", + stoptimeoption="total", + particlegroups=[pg], + ) + + return mp + + +@pytest.mark.parametrize("idx, name", list(enumerate(ex))) +def test_mf6model(idx, name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # test case name + name = ex[idx] + + # model names + gwfname = f"{ex[idx]}_gwf" + prtname = f"{ex[idx]}_prt" + mp7name = f"{ex[idx]}_mp7" + + # build mf6 models + gwfsim = build_gwf_sim(idx, ws, targets.mf6) + prtsim = build_prt_sim(idx, ws, targets.mf6) + + # run gwf model + gwfsim.write_simulation() + success, buff = gwfsim.run_simulation(report=True) + assert success, pformat(buff) + + # run prt model + prtsim.write_simulation() + success, buff = prtsim.run_simulation(report=True) + if "bprp" in name: + assert not success, pformat(buff) + assert any("Error: release point" in l for l in buff) + return + else: + assert success, pformat(buff) + + # extract mf6 models + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + + # extract model grid + mg = gwf.modelgrid + + # todo build mp7 model + mp7sim = build_mp7_sim(idx, ws, targets.mp7, gwf) + + # todo run mp7 model + mp7sim.write_input() + success, buff = mp7sim.run_model(report=True) + assert success, pformat(buff) + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.cbc" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + assert (ws / prp_track_file).is_file() + assert (ws / prp_track_csv_file).is_file() + + # check mp7 output files exist + mp7_pathline_file = f"{mp7name}.mppth" + assert (ws / mp7_pathline_file).is_file() + + # load mp7 pathline results + plf = PathlineFile(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(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(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( + [ws / prt_track_file, ws / prp_track_file], + [ws / prt_track_csv_file, 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(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.2) + pmv.plot_vector(qx, qy, normalize=True, color="white") + # set zoom area + # xmin, xmax = 2050, 4800 + # ymin, ymax = 5200, 7550 + 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", + 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.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(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 + # import pdb + # pdb.set_trace() + assert mf6_pls.shape == mp7_pls.shape + assert np.allclose(mf6_pls, mp7_pls, atol=1e-3) diff --git a/autotest/prt/test_prt_fmi07.py b/autotest/prt/test_prt_fmi07.py new file mode 100644 index 00000000000..3d2ac82dbc4 --- /dev/null +++ b/autotest/prt/test_prt_fmi07.py @@ -0,0 +1,131 @@ +""" +Tests ability to run a GWF model then a PRT model +in separate simulations via flow model interface, +with release points improperly mapped to cell IDs +(expect failures). + +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. +""" + + +from pprint import pformat + +import flopy +import pytest +from prt_test_utils import get_gwf_sim, get_model_name, get_partdata + +simname = "prtfmi07" +ex = [simname] + + +def build_prt_sim(ctx, name, ws, mf6): + # 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=ctx.nper, + perioddata=[(ctx.perlen, ctx.nstp, ctx.tsmult)], + ) + + # create prt model + prtname = get_model_name(name, "prt") + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + + # create prt discretization + flopy.mf6.modflow.mfgwfdis.ModflowGwfdis( + prt, + pname="dis", + nlay=ctx.nlay, + nrow=ctx.nrow, + ncol=ctx.ncol, + ) + + # create mip package + flopy.mf6.ModflowPrtmip(prt, pname="mip", porosity=ctx.porosity) + + # convert mp7 to prt release points and check against expectation + partdata = get_partdata(prt.modelgrid, ctx.releasepts_mp7) + coords = partdata.to_coords(prt.modelgrid) + # bad cell indices! + releasepts = [(i, 0, 1, 1, c[0], c[1], c[2]) for i, c in enumerate(coords)] + + # create prp package + 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(releasepts), + packagedata=releasepts, + perioddata={0: ["FIRST"]}, + track_filerecord=[prp_track_file], + trackcsv_filerecord=[prp_track_csv_file], + stop_at_weak_sink="saws" in prtname, + boundnames=True, + ) + + # create output control package + 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], + ) + + # create the flow model interface + gwfname = get_model_name(name, "gwf") + gwf_budget_file = f"{gwfname}.bud" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # build mf6 models + gwfsim, ctx = get_gwf_sim(name, ws, targets.mf6) + prtsim = build_prt_sim(ctx, name, ws, targets.mf6) + + # run gwf models + gwfsim.write_simulation() + success, buff = gwfsim.run_simulation(report=True) + assert success, pformat(buff) + + # run prt model (expect failure) + prtsim.write_simulation() + success, buff = prtsim.run_simulation(report=True) + assert not success, pformat(buff) + assert any("Error: release point" in l for l in buff) diff --git a/autotest/prt/test_prt_fmi08.py b/autotest/prt/test_prt_fmi08.py new file mode 100644 index 00000000000..67efe573a53 --- /dev/null +++ b/autotest/prt/test_prt_fmi08.py @@ -0,0 +1,342 @@ +""" +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 + +Two variants are included, first with straight +pathlines then with a well capturing particles. + +Particles are released from the x coordinate +of the constant concentration cell from the +transport model, along a range of y coords. + +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 +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.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 + +simname = "prtfmi08" +ex = [simname, f"{simname}_wel"] +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 = [ + [500, 100, 0.5], + [500, 350, 0.5], + [500, 450, 0.5], + [500, 500, 0.5], + [500, 550, 0.5], + [500, 650, 0.5], + [500, 800, 0.5], +] + + +def get_grid(workspace, targets): + workspace.mkdir(exist_ok=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) + + # fig = plt.figure(figsize=(10, 10)) + # ax = plt.subplot(1, 1, 1, aspect="equal") + # pc = tri.plot(ax=ax) + + +def build_gwf_sim(name, ws, targets): + ws = Path(ws) + gwfname = 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 release cell + point = Point((500, 500)) + cells2 = gi.intersect(point)["cellids"] + cells2 = np.array(list(cells2)) + # ibd[cells2] = 3 + + # identify well cell + point = Point((1200, 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=ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + 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, + ) + disv = flopy.mf6.ModflowGwfdisv( + gwf, nlay=nlay, **grid.get_disv_gridprops(), top=top, botm=botm + ) + if "wel" in name: + wells = [ + # k, j, q + (0, cell_wel, -0.5), + ] + 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 = [] + for icpl in cells_left: + chdlist.append([(0, icpl), 1.0]) + for icpl in cells_right: + chdlist.append([(0, icpl), 0.0]) + chd = flopy.mf6.ModflowGwfchd(gwf, stress_period_data=chdlist) + oc = flopy.mf6.ModflowGwfoc( + gwf, + budget_filerecord=f"{gwfname}.bud", + head_filerecord=f"{gwfname}.hds", + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "LAST"), ("BUDGET", "LAST")], + ) + return sim + + +def build_prt_sim(name, ws, targets): + ws = Path(ws) + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # create grid + grid = get_grid(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=ws + ) + tdis = flopy.mf6.ModflowTdis( + sim, time_units="DAYS", perioddata=[[1.0, 1, 1.0]] + ) + prt = flopy.mf6.ModflowPrt(sim, modelname=prtname) + 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) + ] + 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 = f"{gwfname}.bud" + gwf_head_file = 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 + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # build mf6 models + gwfsim = build_gwf_sim(name, ws, targets) + prtsim = build_prt_sim(name, ws, targets) + + # run gwf + gwfsim.write_simulation() + success, buff = gwfsim.run_simulation(report=True) + assert success, pformat(buff) + + # 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) + + # run prt + prtsim.write_simulation() + success, buff = prtsim.run_simulation(report=True) + assert success, pformat(buff) + + # get prt output + prtname = get_model_name(name, "prt") + prt_track_csv_file = f"{prtname}.prp.trk.csv" + pls = pd.read_csv(ws / prt_track_csv_file, na_filter=False) + + plot_debug = False + if plot_debug: + # plot in 2d with mpl + 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) + 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): + pl.plot( + title=f"MF6 pathlines ({name})", + kind="line", + x="x", + y="y", + ax=ax, + legend=False, + color="black", + ) + plt.show() + + # plot in 3d with pyvista (via vtk) + from flopy.export.vtk import Vtk + from flopy.plot.plotutil import to_mp7_pathlines + import pyvista as pv + + 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() diff --git a/autotest/prt/test_prt_fmi09.py b/autotest/prt/test_prt_fmi09.py new file mode 100644 index 00000000000..551993c0b20 --- /dev/null +++ b/autotest/prt/test_prt_fmi09.py @@ -0,0 +1,319 @@ +""" +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 +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.utils.binaryfile import HeadFile +from prt_test_utils import all_equal, check_track_data, get_model_name + +simname = "prtfmi09" +ex = [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) + gwfname = get_model_name(name, "gwf") + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=gwfname, 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"{gwfname}.outer.ims.csv" + csv1 = f"{gwfname}.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=gwfname, 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"{gwfname}.cbc", + head_filerecord=f"{gwfname}.hds", + headprintrecord=[("COLUMNS", 10, "WIDTH", 15, "DIGITS", 6, "GENERAL")], + saverecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + printrecord=[("HEAD", "ALL"), ("BUDGET", "ALL")], + filename=f"{gwfname}.oc", + ) + + return sim + + +def build_prt_sim(name, ws, mf6): + ws = Path(ws) + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # create simulation + sim = flopy.mf6.MFSimulation( + sim_name=prtname, + exe_name=mf6, + version="mf6", + sim_ws=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=prtname) + + # 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"{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(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"{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], + ) + + # create the flow model interface + gwf_budget_file = f"{gwfname}.cbc" + gwf_head_file = f"{gwfname}.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"{prtname}.ems", + ) + sim.register_solution_package(ems, [prt.name]) + + return sim + + +@pytest.mark.parametrize("name", ex) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # determine if drape is enabled + drape = "drp" in name + + # model names + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # build mf6 models + gwfsim = build_gwf_sim(name, ws, targets.mf6) + prtsim = build_prt_sim(name, ws, targets.mf6) + + # run mf6 models + for sim in [gwfsim, prtsim]: + sim.write_simulation() + success, buff = sim.run_simulation(report=True) + assert success, pformat(buff) + + # extract mf6 models and grid + gwf = gwfsim.get_model(gwfname) + prt = prtsim.get_model(prtname) + mg = gwf.modelgrid + + # check mf6 output files exist + gwf_budget_file = f"{gwfname}.cbc" + gwf_head_file = f"{gwfname}.hds" + prt_track_file = f"{prtname}.trk" + prt_track_csv_file = f"{prtname}.trk.csv" + prp_track_file = f"{prtname}.prp.trk" + prp_track_csv_file = f"{prtname}.prp.trk.csv" + assert (ws / gwf_budget_file).is_file() + assert (ws / gwf_head_file).is_file() + assert (ws / prt_track_file).is_file() + assert (ws / prt_track_csv_file).is_file() + assert (ws / prp_track_file).is_file() + assert (ws / prp_track_csv_file).is_file() + + # load mf6 pathline results + mf6_pls = pd.read_csv(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 [ws / prt_track_csv_file, ws / prp_track_csv_file]: + check_track_data( + track_bin=ws / prt_track_file, + track_hdr=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=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(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() diff --git a/autotest/prt/test_prt_fmi10.py b/autotest/prt/test_prt_fmi10.py new file mode 100644 index 00000000000..df3bd50ff5a --- /dev/null +++ b/autotest/prt/test_prt_fmi10.py @@ -0,0 +1,271 @@ +""" +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 test cases, both of which +release particles from the right border +of the grid. In the 1st flow is left to +right, in the 2nd flow is top right to +bottom left. +""" + +from math import isclose +from pathlib import Path +from pprint import pformat + +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 + +simname = "prtfmi10" +cases = [f"{simname}l2r", 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 chdhead(x): + return x * 10.0 / 100.0 + + +def get_tri(workspace, targets) -> Triangle: + workspace.mkdir(exist_ok=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): + 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) + chdlist = [] + leftcells = tri.get_edge_cells(4) + rightcells = tri.get_edge_cells(2) + botmcells = tri.get_edge_cells(3) + if "l2r" in name: + cells = rightcells + leftcells + elif "diag" in name: + cells = leftcells + botmcells + + for icpl in set(cells): + h = chdhead(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(name, ws, targets): + ws = Path(ws) + gwfname = get_model_name(name, "gwf") + prtname = get_model_name(name, "prt") + + # create grid + tri = get_tri(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=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 = f"{gwfname}.cbc" + gwf_head_file = 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 + + +@pytest.mark.parametrize("name", cases) +def test_mf6model(name, function_tmpdir, targets): + # workspace + ws = function_tmpdir + + # build mf6 models + gwfsim = build_gwf_sim(name, ws, targets) + prtsim = build_prt_sim(name, ws, targets) + + # run gwf + gwfsim.write_simulation() + success, buff = gwfsim.run_simulation(report=True) + assert success, pformat(buff) + + # 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) + + # run prt + prtsim.write_simulation() + success, buff = prtsim.run_simulation(report=True) + assert success, pformat(buff) + + # get prt output + prtname = get_model_name(name, "prt") + prt_track_csv_file = f"{prtname}.prp.trk.csv" + pls = pd.read_csv(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 "l2r" 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} diff --git a/autotest/prt/test_prt_notebooks.py b/autotest/prt/test_prt_notebooks.py new file mode 100644 index 00000000000..610e9a7fb2d --- /dev/null +++ b/autotest/prt/test_prt_notebooks.py @@ -0,0 +1,253 @@ +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 flaky import flaky +from flopy.mf6 import MFSimulation +from flopy.plot.plotutil import to_mp7_pathlines +from flopy.utils import PathlineFile +from modflow_devtools.markers import excludes_platform +from modflow_devtools.misc import run_cmd, set_env +from numpy.lib.recfunctions import stack_arrays + +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" + mp7name = 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"{mp7name}.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"{mp7name}{ll}.mppth" + mp7_endpoint_file = ws / f"{mp7name}{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_examples.py b/autotest/test_examples.py index 330c77b664c..5c78439d015 100644 --- a/autotest/test_examples.py +++ b/autotest/test_examples.py @@ -53,6 +53,11 @@ @pytest.mark.slow def test_scenario(function_tmpdir, example_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"Excluding mf6 model: {name}") diff --git a/doc/mf6io/body.tex b/doc/mf6io/body.tex index 32f0150cf94..00064866d3d 100644 --- a/doc/mf6io/body.tex +++ b/doc/mf6io/body.tex @@ -45,6 +45,11 @@ \SECTION{Groundwater Transport (GWT) Model Input} \input{gwt/gwt.tex} +%PRT Model Input Instructions +\newpage +\SECTION{Particle Tracking (PRT) Model Input} +\input{prt/prt.tex} + %Sparse Matrix Solution (IMS) \newpage \SECTION{Iterative Model Solution} 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..0434f02ff90 --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-mip.dfn @@ -0,0 +1,30 @@ +# --------------------- prt prp 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. 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..0c6429ec2fa --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/prt-oc.dfn @@ -0,0 +1,388 @@ +# --------------------- 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 trackevent +type string +shape +reader urword +tagged true +optional true +longname tracking event(s) +description particle tracking event(s) to include in track output files. Can be ALL, RELEASE, TRANSIT, TIMESTEP, TERMINATE, or WEAKSINK. RELEASE selects particle releases. TRANSIT selects cell-to-cell transitions. TIMESTEP selects transitions between timesteps. TERMINATE selects particle terminations. WEAKSINK selects particle exits from weak sink cells. Events may coincide with other events. + +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 track. + +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 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. + +# --------------------- 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 ( - <@surface@> <@rate@> <@depth@> <@pxdp(nseg-1)@> <@petm(nseg-1)@> [<@petm0@>] [<@aux(naux)@>] [] - <@surface@> <@rate@> <@depth@> <@pxdp(nseg-1)@> <@petm(nseg-1)@> [<@petm0@>] [<@aux(naux)@>] [] + <@surface@> <@rate@> <@depth@> [<@pxdp(nseg-1)@>] [<@petm(nseg-1)@>] [<@petm0@>] [<@aux(naux)@>] [] + <@surface@> <@rate@> <@depth@> [<@pxdp(nseg-1)@>] [<@petm(nseg-1)@>] [<@petm0@>] [<@aux(naux)@>] [] ... END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex index 3dbded6c6c1..987b185558b 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-evta-desc.tex @@ -37,11 +37,11 @@ \item \texttt{surface}---is the elevation of the ET surface ($L$). -\item \texttt{rate}---is the maximum ET flux rate ($LT^{-1}$). +\item \textcolor{blue}{\texttt{rate}---is the maximum ET flux rate ($LT^{-1}$).} \item \texttt{depth}---is the ET extinction depth ($L$). -\item \texttt{aux(iaux)}---is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array. +\item \textcolor{blue}{\texttt{aux}---is an array of values for auxiliary variable AUX(IAUX), where iaux is a value from 1 to NAUX, and AUX(IAUX) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the evapotranspiration rate will be multiplied by this array.} \end{description} diff --git a/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat b/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat index 2fe138e798b..185b433f84e 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat +++ b/doc/mf6io/mf6ivar/tex/gwf-evta-period.dat @@ -7,6 +7,6 @@ BEGIN PERIOD -- READARRAY DEPTH -- READARRAY - AUX(IAUX) - -- READARRAY + AUX + -- READARRAY END PERIOD diff --git a/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex b/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex index c8ed6e6cda9..6257d63895f 100644 --- a/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex +++ b/doc/mf6io/mf6ivar/tex/gwf-rcha-desc.tex @@ -35,9 +35,9 @@ \item \texttt{irch}---IRCH is the layer number that defines the layer in each vertical column where recharge is applied. If IRCH is omitted, recharge by default is applied to cells in layer 1. IRCH can only be used if READASARRAYS is specified in the OPTIONS block. If IRCH is specified, it must be specified as the first variable in the PERIOD block or MODFLOW will terminate with an error. -\item \texttt{recharge}---is the recharge flux rate ($LT^{-1}$). This rate is multiplied inside the program by the surface area of the cell to calculate the volumetric recharge rate. The recharge array may be defined by a time-array series (see the "Using Time-Array Series in a Package" section). +\item \textcolor{blue}{\texttt{recharge}---is the recharge flux rate ($LT^{-1}$). This rate is multiplied inside the program by the surface area of the cell to calculate the volumetric recharge rate. The recharge array may be defined by a time-array series (see the "Using Time-Array Series in a Package" section).} -\item \texttt{aux}---is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array. +\item \textcolor{blue}{\texttt{aux}---is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array.} \end{description} diff --git a/doc/mf6io/mf6ivar/tex/prt-dis-desc.tex b/doc/mf6io/mf6ivar/tex/prt-dis-desc.tex new file mode 100644 index 00000000000..afef5a5fa76 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-dis-desc.tex @@ -0,0 +1,41 @@ +% 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 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. + +\item \texttt{yorigin}---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. + +\item \texttt{angrot}---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. + +\end{description} +\item \textbf{Block: DIMENSIONS} + +\begin{description} +\item \texttt{nlay}---is the number of layers in the model grid. + +\item \texttt{nrow}---is the number of rows in the model grid. + +\item \texttt{ncol}---is the number of columns in the model grid. + +\end{description} +\item \textbf{Block: GRIDDATA} + +\begin{description} +\item \texttt{delr}---is the column spacing in the row direction. + +\item \texttt{delc}---is the row spacing in the column direction. + +\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} + diff --git a/doc/mf6io/mf6ivar/tex/prt-dis-dimensions.dat b/doc/mf6io/mf6ivar/tex/prt-dis-dimensions.dat new file mode 100644 index 00000000000..227d0e1f799 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-dis-dimensions.dat @@ -0,0 +1,5 @@ +BEGIN DIMENSIONS + NLAY + 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..1f6ed2cb645 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-mip-desc.tex @@ -0,0 +1,13 @@ +% DO NOT MODIFY THIS FILE DIRECTLY. IT IS CREATED BY mf6ivar.py + +\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. 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-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..0e1e650bccb --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-oc-desc.tex @@ -0,0 +1,73 @@ +% 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{trackevent}---particle tracking event(s) to include in track output files. Can be ALL, RELEASE, TRANSIT, TIMESTEP, TERMINATE, or WEAKSINK. RELEASE selects particle releases. TRANSIT selects cell-to-cell transitions. TIMESTEP selects transitions between timesteps. TERMINATE selects particle terminations. WEAKSINK selects particle exits from weak sink cells. Events may coincide with other events. + +\item \texttt{TRACK}---keyword to specify that record corresponds to track. + +\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{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. + +\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..66d229f1201 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-oc-options.dat @@ -0,0 +1,9 @@ +BEGIN OPTIONS + [BUDGET FILEOUT ] + [BUDGETCSV FILEOUT ] + [CONCENTRATION FILEOUT ] + [CONCENTRATION PRINT_FORMAT COLUMNS WIDTH DIGITS ] + [TRACKEVENT ] + [TRACK FILEOUT ] + [TRACKCSV FILEOUT ] +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..ee354612dec --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-desc.tex @@ -0,0 +1,79 @@ +% 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{referencetime}---real value defining the time at which to release particles. This is comparable to MODPATH 7 referencetime option 1. + +\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 REFERENCETIME 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 with another RELEASESETTING option. + +\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..9def10d2c45 --- /dev/null +++ b/doc/mf6io/mf6ivar/tex/prt-prp-options.dat @@ -0,0 +1,11 @@ +BEGIN OPTIONS + [BOUNDNAMES] + [TRACK FILEOUT ] + [TRACKCSV FILEOUT ] + [STOPTIME ] + [STOPTRAVELTIME ] + [STOP_AT_WEAK_SINK] + [ISTOPZONE ] + [DRAPE] + [REFERENCETIME ] +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/utl-spc-desc.tex b/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex index bba10d98e87..3e5c0ccf826 100644 --- a/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex +++ b/doc/mf6io/mf6ivar/tex/utl-spc-desc.tex @@ -25,7 +25,7 @@ \item \texttt{bndno}---integer value that defines the boundary package feature number associated with the specified PERIOD data on the line. BNDNO must be greater than zero and less than or equal to MAXBOUND. -\item \texttt{spcsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the MAWSETTING string include: CONCENTRATION. +\item \texttt{spcsetting}---line of information that is parsed into a keyword and values. Keyword values that can be used to start the SPCSETTING string include: CONCENTRATION. \begin{lstlisting}[style=blockdefinition] CONCENTRATION <@concentration@> diff --git a/doc/mf6io/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..f4467e45b5b --- /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. In this implementation, each particle is assigned unit mass, and the numerical value of the flow can be interpreted as particles per time. + +\begin{enumerate} + +\item The PRT Model simulates transport of ...; however, because \mf allows for multiple models of the same type to be included in a single simulation, ... can be represented by using multiple PRT Models. + +\item The PRT Model requires simulated groundwater flows as input. Simulated flows from the GWF Model can be passed in memory to the PRT Model in the same simulation via a GWF-PRT Exchange. Alternatively, the PRT Model can read binary flow and head files saved by a previously run GWF Model. The current implemention of the PRT Model does not support particle tracking through the advanced stress packages or the Water Mover Package. + +\item Although there is GWF-GWF Exchange, a PRT-PRT Exchange has not yet been developed to connect multiple particle-tracking models, as might be done in a nested grid configuration. + +\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 particle-tracking model and transport model are included in the same simulation, then the length of the time step specified in TDIS is used for both models. If the PRT Model runs in a separate simulation from the GWF Model, then .... 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 5b3aab00b24..dc83811e1c6 100644 --- a/environment.yml +++ b/environment.yml @@ -17,15 +17,17 @@ dependencies: - numpy - pyshp - shapely + - scipy - pip - pip: - - git+https://github.com/modflowpy/flopy.git + - https://github.com/wpbonelli/flopy/archive/prt-utils.zip - git+https://github.com/modflowpy/pymake.git - git+https://github.com/Deltares/xmipy.git - git+https://github.com/MODFLOW-USGS/modflowapi.git - modflow-devtools>=1.1.0 + - fortls - pytest - pytest-dotenv - pytest-order - pytest-xdist - - flaky + - flaky \ No newline at end of file diff --git a/make/makedefaults b/make/makedefaults index 88e1790887a..ce27db970e6 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf6' executable. +# makedefaults created by pymake (version 1.2.8) for the 'mf6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -57,16 +57,19 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp MODSWITCH = -module $(MODDIR) endif + ifeq ($(FC), $(filter $(FC), ftn)) + FFLAGS ?= -h noheap_allocate + endif endif # set the ldflgs @@ -81,6 +84,9 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif + ifeq ($(FC), $(filter $(FC), ftn)) + LDFLAGS ?= -lc + endif endif # check for Windows error condition diff --git a/make/makefile b/make/makefile index 12fea034964..3d6cc0ee82d 100644 --- a/make/makefile +++ b/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.9.dev0) for the 'mf6' executable. +# makefile created by pymake (version 1.2.8) for the 'mf6' executable. include ./makedefaults @@ -6,35 +6,37 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src SOURCEDIR2=../src/Exchange -SOURCEDIR3=../src/Model -SOURCEDIR4=../src/Model/Geometry -SOURCEDIR5=../src/Model/TransportModel -SOURCEDIR6=../src/Model/ModelUtilities -SOURCEDIR7=../src/Model/Connection -SOURCEDIR8=../src/Model/GroundWaterTransport -SOURCEDIR9=../src/Model/GroundWaterFlow -SOURCEDIR10=../src/Distributed -SOURCEDIR11=../src/Solution -SOURCEDIR12=../src/Solution/PETSc -SOURCEDIR13=../src/Solution/LinearMethods -SOURCEDIR14=../src/Timing -SOURCEDIR15=../src/Utilities -SOURCEDIR16=../src/Utilities/TimeSeries +SOURCEDIR3=../src/Distributed +SOURCEDIR4=../src/Solution +SOURCEDIR5=../src/Solution/LinearMethods +SOURCEDIR6=../src/Solution/ParticleTracker +SOURCEDIR7=../src/Solution/PETSc +SOURCEDIR8=../src/Timing +SOURCEDIR9=../src/Utilities +SOURCEDIR10=../src/Utilities/Idm +SOURCEDIR11=../src/Utilities/Idm/selector +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/sparsekit +SOURCEDIR19=../src/Utilities/Libraries/blas SOURCEDIR20=../src/Utilities/Libraries/sparskit2 -SOURCEDIR21=../src/Utilities/Libraries/blas -SOURCEDIR22=../src/Utilities/Libraries/daglib -SOURCEDIR23=../src/Utilities/Idm -SOURCEDIR24=../src/Utilities/Idm/selector -SOURCEDIR25=../src/Utilities/Idm/mf6blockfile -SOURCEDIR26=../src/Utilities/Matrix -SOURCEDIR27=../src/Utilities/Vector -SOURCEDIR28=../src/Utilities/Observation -SOURCEDIR29=../src/Utilities/OutputControl -SOURCEDIR30=../src/Utilities/Memory -SOURCEDIR31=../src/Utilities/ArrayRead +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/ParticleTracking +SOURCEDIR29=../src/Model/GroundWaterTransport +SOURCEDIR30=../src/Model/ModelUtilities +SOURCEDIR31=../src/Model/GroundWaterFlow +SOURCEDIR32=../src/Model/TransportModel +SOURCEDIR33=../src/Model/Geometry VPATH = \ ${SOURCEDIR1} \ @@ -67,7 +69,9 @@ ${SOURCEDIR27} \ ${SOURCEDIR28} \ ${SOURCEDIR29} \ ${SOURCEDIR30} \ -${SOURCEDIR31} +${SOURCEDIR31} \ +${SOURCEDIR32} \ +${SOURCEDIR33} .SUFFIXES: .f90 .F90 .o @@ -114,11 +118,28 @@ $(OBJDIR)/MemoryManagerExt.o \ $(OBJDIR)/MatrixBase.o \ $(OBJDIR)/ListReader.o \ $(OBJDIR)/Connections.o \ -$(OBJDIR)/InputDefinition.o \ $(OBJDIR)/TimeArray.o \ $(OBJDIR)/ObsOutput.o \ $(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)/InputDefinition.o \ +$(OBJDIR)/BudgetTerm.o \ +$(OBJDIR)/Budget.o \ +$(OBJDIR)/TimeArraySeriesManager.o \ +$(OBJDIR)/PackageMover.o \ +$(OBJDIR)/Obs3.o \ +$(OBJDIR)/NumericalPackage.o \ $(OBJDIR)/simnamidm.o \ +$(OBJDIR)/prt1idm.o \ +$(OBJDIR)/prt1mip1idm.o \ +$(OBJDIR)/prt1disv1idm.o \ +$(OBJDIR)/prt1dis1idm.o \ $(OBJDIR)/gwt1idm.o \ $(OBJDIR)/gwt1ic1idm.o \ $(OBJDIR)/gwt1dsp1idm.o \ @@ -142,45 +163,48 @@ $(OBJDIR)/gwf3disu8idm.o \ $(OBJDIR)/gwf3dis8idm.o \ $(OBJDIR)/gwf3chd8idm.o \ $(OBJDIR)/gwtgwtidm.o \ +$(OBJDIR)/gwfprtidm.o \ $(OBJDIR)/gwfgwtidm.o \ $(OBJDIR)/gwfgwfidm.o \ -$(OBJDIR)/TimeArraySeries.o \ -$(OBJDIR)/ObsOutputList.o \ -$(OBJDIR)/Observe.o \ +$(OBJDIR)/PackageBudget.o \ +$(OBJDIR)/HeadFileReader.o \ +$(OBJDIR)/BudgetObject.o \ +$(OBJDIR)/BoundaryPackage.o \ $(OBJDIR)/IdmSimDfnSelector.o \ +$(OBJDIR)/IdmPrtDfnSelector.o \ $(OBJDIR)/IdmGwtDfnSelector.o \ $(OBJDIR)/IdmGwfDfnSelector.o \ $(OBJDIR)/IdmExgDfnSelector.o \ -$(OBJDIR)/TimeArraySeriesLink.o \ -$(OBJDIR)/ObsUtility.o \ -$(OBJDIR)/ObsContainer.o \ -$(OBJDIR)/BudgetFileReader.o \ +$(OBJDIR)/CellDefn.o \ +$(OBJDIR)/Particle.o \ +$(OBJDIR)/gwf3disv8.o \ +$(OBJDIR)/FlowModelInterface.o \ $(OBJDIR)/IdmDfnSelector.o \ -$(OBJDIR)/TimeArraySeriesManager.o \ -$(OBJDIR)/PackageMover.o \ -$(OBJDIR)/Obs3.o \ -$(OBJDIR)/NumericalPackage.o \ -$(OBJDIR)/Budget.o \ -$(OBJDIR)/BudgetTerm.o \ +$(OBJDIR)/Subcell.o \ +$(OBJDIR)/TrackData.o \ +$(OBJDIR)/prt1fmi1.o \ +$(OBJDIR)/Cell.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ $(OBJDIR)/SourceCommon.o \ -$(OBJDIR)/BoundaryPackage.o \ +$(OBJDIR)/TernarySolveTrack.o \ +$(OBJDIR)/SubcellTri.o \ +$(OBJDIR)/Method.o \ +$(OBJDIR)/SubcellRect.o \ +$(OBJDIR)/gwf3dis8.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)/gwf3ic8.o \ $(OBJDIR)/Xt3dAlgorithm.o \ @@ -194,6 +218,10 @@ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf3ghb8.o \ $(OBJDIR)/gwf3drn8.o \ $(OBJDIR)/IndexMap.o \ +$(OBJDIR)/MethodSubcellPool.o \ +$(OBJDIR)/CellPoly.o \ +$(OBJDIR)/CellRectQuad.o \ +$(OBJDIR)/CellRect.o \ $(OBJDIR)/VirtualModel.o \ $(OBJDIR)/BaseExchange.o \ $(OBJDIR)/tsp1fmi1.o \ @@ -211,6 +239,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)/tsp1ssm1.o \ @@ -218,9 +250,7 @@ $(OBJDIR)/tsp1oc1.o \ $(OBJDIR)/tsp1obs1.o \ $(OBJDIR)/tsp1mvt1.o \ $(OBJDIR)/tsp1adv1.o \ -$(OBJDIR)/gwf3disv8.o \ $(OBJDIR)/gwf3disu8.o \ -$(OBJDIR)/gwf3dis8.o \ $(OBJDIR)/gwf3uzf8.o \ $(OBJDIR)/tsp1apt1.o \ $(OBJDIR)/gwt1mst1.o \ @@ -238,6 +268,8 @@ $(OBJDIR)/LinearSolverBase.o \ $(OBJDIR)/ims8reordering.o \ $(OBJDIR)/ModflowInput.o \ $(OBJDIR)/Integer2dReader.o \ +$(OBJDIR)/MethodCellPool.o \ +$(OBJDIR)/CellUtil.o \ $(OBJDIR)/VirtualExchange.o \ $(OBJDIR)/GridSorting.o \ $(OBJDIR)/DisConnExchange.o \ @@ -274,6 +306,8 @@ $(OBJDIR)/InputLoadType.o \ $(OBJDIR)/Integer1dReader.o \ $(OBJDIR)/Double2dReader.o \ $(OBJDIR)/Double1dReader.o \ +$(OBJDIR)/MethodDisv.o \ +$(OBJDIR)/MethodDis.o \ $(OBJDIR)/GridConnection.o \ $(OBJDIR)/DistributedVariable.o \ $(OBJDIR)/gwt1.o \ @@ -287,6 +321,11 @@ $(OBJDIR)/StructArray.o \ $(OBJDIR)/BoundInputContext.o \ $(OBJDIR)/AsciiInputLoadType.o \ $(OBJDIR)/LayeredArrayReader.o \ +$(OBJDIR)/prt1prp1.o \ +$(OBJDIR)/prt1oc1.o \ +$(OBJDIR)/prt1obs1.o \ +$(OBJDIR)/prt1mip.o \ +$(OBJDIR)/MethodPool.o \ $(OBJDIR)/ExplicitModel.o \ $(OBJDIR)/SpatialModelConnection.o \ $(OBJDIR)/GwtInterfaceModel.o \ @@ -299,6 +338,7 @@ $(OBJDIR)/MappedMemory.o \ $(OBJDIR)/StressListInput.o \ $(OBJDIR)/StressGridInput.o \ $(OBJDIR)/LoadMf6File.o \ +$(OBJDIR)/prt1.o \ $(OBJDIR)/ExplicitSolution.o \ $(OBJDIR)/GwtGwtConnection.o \ $(OBJDIR)/GwfGwfConnection.o \ @@ -312,6 +352,7 @@ $(OBJDIR)/VirtualGwfModel.o \ $(OBJDIR)/VirtualGwfExchange.o \ $(OBJDIR)/SolutionGroup.o \ $(OBJDIR)/SolutionFactory.o \ +$(OBJDIR)/GwfPrtExchange.o \ $(OBJDIR)/GwfGwtExchange.o \ $(OBJDIR)/RunControl.o \ $(OBJDIR)/SourceLoad.o \ 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 1539cf72583..cf092ae868f 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -95,12 +95,14 @@ + + @@ -203,6 +205,7 @@ + @@ -220,6 +223,18 @@ + + + + + + + + + + + + @@ -244,6 +259,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + @@ -298,6 +337,7 @@ + diff --git a/msvs/mf6lib.vfproj b/msvs/mf6lib.vfproj index dee2f209199..e6b30a2c23b 100644 --- a/msvs/mf6lib.vfproj +++ b/msvs/mf6lib.vfproj @@ -160,7 +160,6 @@ - diff --git a/src/Exchange/GwfPrtExchange.f90 b/src/Exchange/GwfPrtExchange.f90 new file mode 100644 index 00000000000..2ea62c71fb3 --- /dev/null +++ b/src/Exchange/GwfPrtExchange.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/Exchange/gwfprtidm.f90 b/src/Exchange/gwfprtidm.f90 new file mode 100644 index 00000000000..25f8c662a93 --- /dev/null +++ b/src/Exchange/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/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/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90 index 41237ddacf8..63752778967 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8.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/gwf3mvr8.f90 b/src/Model/GroundWaterFlow/gwf3mvr8.f90 index 4ed76cbd2d5..6be9a8ae9ca 100644 --- a/src/Model/GroundWaterFlow/gwf3mvr8.f90 +++ b/src/Model/GroundWaterFlow/gwf3mvr8.f90 @@ -559,7 +559,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 c55787568d1..886493ac70e 100644 --- a/src/Model/ModelUtilities/FlowModelInterface.f90 +++ b/src/Model/ModelUtilities/FlowModelInterface.f90 @@ -413,7 +413,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 @@ -525,7 +525,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 09782fd08d8..184336a2fe7 100644 --- a/src/Model/ModelUtilities/ModelPackageInput.f90 +++ b/src/Model/ModelUtilities/ModelPackageInput.f90 @@ -14,6 +14,8 @@ module ModelPackageInputModule GWF_BASEPKG, GWF_MULTIPKG use GwtModule, only: GWT_NBASEPKG, GWT_NMULTIPKG, & GWT_BASEPKG, GWT_MULTIPKG + use PrtModule, only: PRT_NBASEPKG, PRT_NMULTIPKG, & + PRT_BASEPKG, PRT_MULTIPKG implicit none private @@ -49,6 +51,11 @@ subroutine supported_model_packages(mtype, pkgtypes, numpkgs) allocate (pkgtypes(numpkgs)) pkgtypes = [GWT_BASEPKG, GWT_MULTIPKG] ! + case ('PRT6') + numpkgs = PRT_NBASEPKG + PRT_NMULTIPKG + allocate (pkgtypes(numpkgs)) + pkgtypes = [PRT_BASEPKG, PRT_MULTIPKG] + ! case default end select ! @@ -89,6 +96,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/TrackData.f90 b/src/Model/ModelUtilities/TrackData.f90 new file mode 100644 index 00000000000..1be324427fa --- /dev/null +++ b/src/Model/ModelUtilities/TrackData.f90 @@ -0,0 +1,297 @@ +module TrackModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DONE + use ParticleModule, only: ParticleType + + implicit none + + private save_record + public :: TrackControlType + public :: TrackFileType + + !> @brief Output file containing all or some particle pathlines. + !! + !! May be associated with a particle release point (PRP) package + !! or with an entire model. + !< + 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 + !! 1: TRANSIT + !! 2: TIMESTEP + !! 3: TERMINATE + !! 4: WEAKSINK + !! + !! An arbitrary number of files can be managed, internal + !! arrays are resized as needed. + !< + type :: TrackControlType + private + type(TrackFileType), public, allocatable :: trackfiles(:) !< output files + integer(I4B), public :: ntrackfiles !< number of output files + integer(I4B), public :: itrackevent !< track event selection + contains + procedure :: expand + procedure, public :: init_track_file + procedure, public :: save + procedure, public :: set_track_event + end type TrackControlType + + ! Track file headers + character(len=*), parameter, public :: TRACKHEADERS = & + 'kper,kstp,imdl,iprp,irpt,ilay,icell,izone,istatus,ireason,& + &trelease,t,x,y,z,name' + + ! Track file dtypes + character(len=*), parameter, public :: TRACKTYPES = & + ' @brief Initialize a new track file + subroutine init_track_file(this, iun, csv, iprp) + ! -- dummy + class(TrackControlType) :: 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(TrackControlType) :: this + integer(I4B), optional, intent(in) :: increment + ! -- local + integer(I4B) :: inclocal, isize, newsize + type(TrackFileType), allocatable, dimension(:) :: temp + + ! -- initialize + if (present(increment)) then + inclocal = increment + else + inclocal = 1 + end if + + ! -- increase size of array by inclocal + 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, kstp + integer(I4B), intent(in) :: reason + logical(LGP), intent(in) :: csv + ! -- local + real(DP) :: x, y, 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(TrackControlType), intent(inout) :: this + type(ParticleType), pointer, intent(in) :: particle + integer(I4B), intent(in) :: kper, 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 all events, or + ! if the specified event matches the reporting reason. + if (this%itrackevent > -1 .and. this%itrackevent /= reason) & + 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 needs to delegate to an even finer granularity, in + ! which case the tracking solution would recurse 1+ calls + ! deeper before advancing the particle and unwinding. + if (present(level)) then + if (level .ne. 3) return + end if + + ! -- Save all enabled model-level files and any + ! -- enabled and index-matching PRP-level 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 Set the event filter. + !! + !! Track event -1 indicates TRACKEVENT ALL and so on. + !! If track event >= 0, only events of the given type + !! will be recorded. Each non-negative tracking event + !! number corresponds to an "ireason" code as appears + !! in each row of output. + !< + subroutine set_track_event(this, itrackevent) + class(TrackControlType) :: this + integer(I4B), intent(in) :: itrackevent + this%itrackevent = itrackevent + end subroutine set_track_event + +end module TrackModule diff --git a/src/Model/ParticleTracking/prt1.f90 b/src/Model/ParticleTracking/prt1.f90 new file mode 100644 index 00000000000..dd5568b1f82 --- /dev/null +++ b/src/Model/ParticleTracking/prt1.f90 @@ -0,0 +1,1234 @@ +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 ExplicitModelModule, only: ExplicitModelType + 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: TrackControlType, 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(ExplicitModelType) :: 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(TrackControlType), pointer :: trackctl ! 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 :: flowja => null() !< intercell particle mass flows + 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 :: create_lstfile + 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%trackctl) + + ! -- 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) + + ! -- 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) + 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%trackctl) + 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, & + trackctl=this%trackctl, & + izone=this%mip%izone, & + flowja=this%flowja, & + porosity=this%mip%porosity, & + retfactor=this%mip%retfactor) + this%method => method_dis + type is (GwfDisvType) + call method_disv%init( & + fmi=this%fmi, & + trackctl=this%trackctl, & + izone=this%mip%izone, & + flowja=this%flowja, & + porosity=this%mip%porosity, & + retfactor=this%mip%retfactor) + this%method => method_disv + end select + + ! -- Initialize track output files and reporting options + if (this%oc%itrkout > 0) & + call this%trackctl%init_track_file(this%oc%itrkout) + if (this%oc%itrkcsv > 0) & + call this%trackctl%init_track_file(this%oc%itrkcsv, csv=.true.) + call this%trackctl%set_track_event(this%oc%itrkevent) + 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%flowja) + call mem_deallocate(this%masssto) + call mem_deallocate(this%massstoold) + call mem_deallocate(this%ratesto) + + ! -- Track file control + deallocate (this%trackctl) + + ! -- Parent type + call this%ExplicitModelType%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%ExplicitModelType%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 + call this%ExplicitModelType%allocate_arrays() + + ! -- Allocate and initialize arrays + call mem_allocate(this%flowja, this%dis%nja, & + 'FLOWJA', this%memoryPath) + 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) + do n = 1, size(this%flowja) + this%flowja(n) = DZERO + end do + do n = 1, this%dis%nodes + this%masssto(n) = DZERO + this%massstoold(n) = DZERO + this%ratesto(n) = DZERO + 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 (todo: do we really want PRP-specific track files?) + if (packobj%itrkout > 0) then + call this%trackctl%init_track_file( & + packobj%itrkout, & + iprp=iprp) + end if + if (packobj%itrkcsv > 0) then + call this%trackctl%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%trackctl%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 is to be released this time step, record its initial state + particle%istatus = 1 ! todo: necessary? + if (particle%trelease >= totimc) & + call this%trackctl%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 + + subroutine create_lstfile(this, lst_fname, model_fname, defined) + ! -- modules + use KindModule, only: LGP + use InputOutputModule, only: openfile, getunit + ! -- dummy + class(PrtModelType) :: this + character(len=*), intent(inout) :: lst_fname + character(len=*), intent(in) :: model_fname + logical(LGP), intent(in) :: defined + ! -- local + integer(I4B) :: i, istart, istop + + ! -- set list file name if not provided + if (.not. defined) then + + ! -- initialize + lst_fname = ' ' + istart = 0 + istop = len_trim(model_fname) + + ! -- identify '.' character position from back of string + do i = istop, 1, -1 + if (model_fname(i:i) == '.') then + istart = i + exit + end if + end do + + ! -- if not found start from string end + if (istart == 0) istart = istop + 1 + + ! -- set list file name + lst_fname = model_fname(1:istart) + istop = istart + 3 + lst_fname(istart:istop) = '.lst' + end if + + ! -- create the list file + this%iout = getunit() + call openfile(this%iout, 0, lst_fname, 'LIST', filstat_opt='REPLACE') + + ! -- write list file header + call write_listfile_header(this%iout, 'PARTICLE TRACKING MODEL (PRT)') + end subroutine create_lstfile + + !> @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/ParticleTracking/prt1dis1idm.f90 b/src/Model/ParticleTracking/prt1dis1idm.f90 new file mode 100644 index 00000000000..ff9c3ffc1c7 --- /dev/null +++ b/src/Model/ParticleTracking/prt1dis1idm.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/Model/ParticleTracking/prt1disv1idm.f90 b/src/Model/ParticleTracking/prt1disv1idm.f90 new file mode 100644 index 00000000000..69cfdcc58bf --- /dev/null +++ b/src/Model/ParticleTracking/prt1disv1idm.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/Model/ParticleTracking/prt1fmi1.f90 b/src/Model/ParticleTracking/prt1fmi1.f90 new file mode 100644 index 00000000000..60d9b5bca26 --- /dev/null +++ b/src/Model/ParticleTracking/prt1fmi1.f90 @@ -0,0 +1,224 @@ +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) + ! -- modules + use SimModule, only: store_error + ! -- dummy + class(PrtFmiType) :: this + class(DisBaseType), pointer, intent(in) :: dis + ! + ! -- Call parent class define + call this%FlowModelInterfaceType%fmi_df(dis) + ! + ! -- 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/prt1idm.f90 b/src/Model/ParticleTracking/prt1idm.f90 new file mode 100644 index 00000000000..e1414a1e7fc --- /dev/null +++ b/src/Model/ParticleTracking/prt1idm.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/Model/ParticleTracking/prt1mip.f90 b/src/Model/ParticleTracking/prt1mip.f90 new file mode 100644 index 00000000000..e66bf46acab --- /dev/null +++ b/src/Model/ParticleTracking/prt1mip.f90 @@ -0,0 +1,137 @@ +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 + contains + procedure :: mip_ar + procedure :: mip_da + 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) + ! -- dummy + 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) + + end subroutine mip_da + + !> @brief Allocate arrays + subroutine allocate_arrays(this, nodes) + ! -- dummy + 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) + ! + ! -- 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/prt1mip1idm.f90 b/src/Model/ParticleTracking/prt1mip1idm.f90 new file mode 100644 index 00000000000..8ddadc04c11 --- /dev/null +++ b/src/Model/ParticleTracking/prt1mip1idm.f90 @@ -0,0 +1,117 @@ +! ** 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 :: porosity = .false. + logical :: retfactor = .false. + logical :: izone = .false. + end type PrtMipParamFoundType + + logical :: prt_mip_multi_package = .false. + + 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_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/Model/ParticleTracking/prt1obs1.f90 b/src/Model/ParticleTracking/prt1obs1.f90 new file mode 100644 index 00000000000..b39beefa478 --- /dev/null +++ b/src/Model/ParticleTracking/prt1obs1.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/prt1oc1.f90 b/src/Model/ParticleTracking/prt1oc1.f90 new file mode 100644 index 00000000000..19ca610aef6 --- /dev/null +++ b/src/Model/ParticleTracking/prt1oc1.f90 @@ -0,0 +1,287 @@ +module PrtOcModule + + use BaseDisModule, only: DisBaseType + use KindModule, only: DP, I4B + 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 + use MemoryHelperModule, only: create_mem_path + + 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 :: itrkevent => null() !< track event option + + 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%itrkevent, 'ITRACKEVENT', 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%itrkevent = -1 + 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() + + ! -- Initialize variables + 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 + + 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%itrkevent) + 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: TRACKHEADERS, TRACKTYPES + 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) :: ierr + integer(I4B) :: ipos + logical :: isfound, found, endOfBlock + type(OutputControlDataType), pointer :: ocdobjptr + character(len=LINELENGTH) :: trkevent + ! -- 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' + 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)') TRACKHEADERS, TRACKTYPES + 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)') TRACKHEADERS + else + call store_error('OPTIONAL TRACKCSV KEYWORD MUST BE & + &FOLLOWED BY FILEOUT') + end if + found = .true. + case ('TRACKEVENT') + call this%parser%GetStringCaps(trkevent) + select case (trkevent) + case ('') + this%itrkevent = -1 + case ('ALL') + this%itrkevent = -1 + case ('RELEASE') + this%itrkevent = 0 + case ('TRANSIT') + this%itrkevent = 1 + case ('TIMESTEP') + this%itrkevent = 2 + case ('TERMINATE') + this%itrkevent = 3 + case ('WEAKSINK') + this%itrkevent = 4 + case default + write (errmsg, '(2a)') & + 'Looking for ALL, RELEASE, TRANSIT, TIMESTEP, & + &TERMINATE, or WEAKSINK. Found: ', & + trim(adjustl(trkevent)) + call store_error(errmsg, terminate=.TRUE.) + end select + found = .true. + case default + found = .false. + end select + + 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 + 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/prt1prp1.f90 b/src/Model/ParticleTracking/prt1prp1.f90 new file mode 100644 index 00000000000..4e57e1670a1 --- /dev/null +++ b/src/Model/ParticleTracking/prt1prp1.f90 @@ -0,0 +1,914 @@ +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: TrackControlType + use GeomUtilModule, only: point_in_polygon, get_ijk, get_jk + use MemoryManagerModule, only: mem_allocate, mem_deallocate, & + mem_reallocate + + 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(TrackControlType), pointer :: trackctl => 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 + logical(LGP), pointer :: rlsall => null() !< release in all time step + logical(LGP), pointer :: rlsfirst => null() !< release in first time step + logical(LGP), pointer :: use_rlstime => null() !< use global release time + real(DP), pointer :: rlstime => null() !< 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 + 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%rlstime) + call mem_deallocate(this%use_rlstime) + 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) + + ! -- 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) + end subroutine prp_da + + !> @ brief Set pointers to model variables + subroutine prp_set_pointers(this, ibound, izone, trackctl) + ! -- dummy variables + class(PrtPrpType) :: this + integer(I4B), dimension(:), pointer, contiguous :: ibound + integer(I4B), dimension(:), pointer, contiguous :: izone + type(TrackControlType), pointer :: trackctl + + this%ibound => ibound + this%rptzone => izone + this%trackctl => trackctl + 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 + + ! -- 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%rlstime, 'RLSTIME', this%memoryPath) + call mem_allocate(this%use_rlstime, 'USE_RLSTIME', 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) + + ! -- Set values + this%rlsall = .false. + this%rlsfirst = .false. + this%rlstime = DZERO + this%use_rlstime = .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 + 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, np, irow, icol, ilay, icpl + real(DP) :: x, y, z + real(DP), allocatable :: polyverts(:, :) + type(ParticleType), pointer :: particle + + ! -- Reset mass release for time step + do nps = 1, this%nreleasepts + this%rptmass(nps) = DZERO + end do + + ! -- 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))) return + + ! -- Resize particle store if another set + ! of particles will exceed its capacity + if ((this%nparticles + this%nreleasepts) > size(this%particles%irpt)) & + call this%particles%resize( & + size(this%particles%irpt) + this%nreleasepts, & + this%memoryPath) + + ! -- Release a particle from each point + do nps = 1, this%nreleasepts + ic = this%rptnode(nps) + icu = this%dis%get_nodeuser(ic) + 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) + ! Use global release time if enabled, otherwise + ! apply offset to start of the current time step + if (this%use_rlstime) then + particle%trelease = this%rlstime + else + particle%trelease = totimc + this%offset * delt + end if + ! 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 + 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) :: rval + 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, rval, -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() ! todo: check for nonnegative? + 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') + rval = this%parser%GetDouble() + this%offset = rval + 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: TRACKHEADERS, TRACKTYPES + ! -- dummy + class(PrtPrpType), intent(inout) :: this + character(len=*), intent(inout) :: option + logical, intent(inout) :: found + ! -- locals + character(len=MAXCHARLEN) :: fname + character(len=MAXCHARLEN) :: keyword + ! -- 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 ('RELEASETIME') + this%rlstime = this%parser%GetDouble() + this%use_rlstime = .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)') TRACKHEADERS, TRACKTYPES + 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)') TRACKHEADERS + 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/TransportModel/tsp1.f90 b/src/Model/TransportModel/tsp1.f90 index f1de33b333a..8fa9b658e02 100644 --- a/src/Model/TransportModel/tsp1.f90 +++ b/src/Model/TransportModel/tsp1.f90 @@ -773,7 +773,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/Model/TransportModel/tsp1mvt1.f90 b/src/Model/TransportModel/tsp1mvt1.f90 index a0b1530dc80..f16961666b2 100644 --- a/src/Model/TransportModel/tsp1mvt1.f90 +++ b/src/Model/TransportModel/tsp1mvt1.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/SimulationCreate.f90 b/src/SimulationCreate.f90 index ce5c0fc1a19..b9993f85241 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, & @@ -217,9 +217,12 @@ subroutine models_create() use SimVariablesModule, only: idm_context use GwfModule, only: gwf_cr use GwtModule, only: gwt_cr + use PrtModule, only: prt_cr use NumericalModelModule, only: NumericalModelType, GetNumericalModelFromList + use ExplicitModelModule, only: ExplicitModelType, GetExplicitModelFromList use VirtualGwfModelModule, only: add_virtual_gwf_model use VirtualGwtModelModule, only: add_virtual_gwt_model + ! use VirtualPrtModelModule, only: add_virtual_prt_model use ConstantsModule, only: LENMODELNAME ! -- dummy ! -- locals @@ -296,6 +299,12 @@ subroutine models_create() model_loc_idx(n) = im end if call add_virtual_gwt_model(n, model_names(n), num_model) + case ('PRT6') + call dev_feature("PRT is still under development, install the' & + &nightly build or compile from source with IDEVELOPMODE = 1.") + im = im + 1 + model_loc_idx(n) = im + call prt_cr(fname, n, model_names(n)) case default write (errmsg, '(a,a)') & 'Unknown simulation model type: ', trim(model_type) @@ -326,9 +335,11 @@ subroutine exchanges_create() use SimVariablesModule, only: idm_context use GwfGwfExchangeModule, only: gwfexchange_create use GwfGwtExchangeModule, only: gwfgwt_cr + use GwfPrtExchangeModule, only: gwfprt_cr use GwtGwtExchangeModule, only: gwtexchange_create use VirtualGwfExchangeModule, only: add_virtual_gwf_exchange use VirtualGwtExchangeModule, only: add_virtual_gwt_exchange + ! use VirtualPrtExchangeModule, only: add_virtual_prt_exchange ! -- dummy ! -- locals character(len=LENMEMPATH) :: input_mempath @@ -419,6 +430,8 @@ subroutine exchanges_create() if (both_local) then call gwfgwt_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/ParticleTracker/Cell.f90 b/src/Solution/ParticleTracker/Cell.f90 new file mode 100644 index 00000000000..a1e2b8e7a1b --- /dev/null +++ b/src/Solution/ParticleTracker/Cell.f90 @@ -0,0 +1,23 @@ +module CellModule + + use CellDefnModule, only: CellDefnType + implicit none + private + public :: CellType + + !> @brief A grid cell. Contains a cell-definition (composition over inheritance) + type, abstract :: CellType + character(len=40), pointer :: type ! tracking domain type + type(CellDefnType), pointer :: defn => null() ! cell definition + contains + procedure(destroy), deferred :: destroy ! destructor for 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..e522b89a61d --- /dev/null +++ b/src/Solution/ParticleTracker/CellRectQuad.f90 @@ -0,0 +1,221 @@ +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 + + ! todo: can these be removed? + 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..aa676102793 --- /dev/null +++ b/src/Solution/ParticleTracker/Method.f90 @@ -0,0 +1,204 @@ +!> @brief Particle tracking methods (strategy pattern) +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: TrackControlType + 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 advecting + !! 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(TrackControlType), pointer, public :: trackctl => null() ! ptr to track file control + 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, trackctl, & + 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(TrackControlType), intent(in), pointer, optional :: trackctl + 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(trackctl)) this%trackctl => trackctl + 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 :: level + real(DP), intent(in) :: tmax + ! local + logical :: advancing + integer :: next_level + class(methodType), pointer :: submethod + + advancing = .true. + next_level = level + 1 + do while (advancing) + call this%load(particle, next_level, submethod) + call submethod%apply(particle, tmax) + call this%try_pass(particle, next_level, advancing) + end do + end subroutine track + + !> @brief Try passing the particle to the next subdomain + subroutine try_pass(this, particle, next_level, advancing) + class(MethodType), intent(inout) :: this + type(ParticleType), pointer, intent(inout) :: particle + integer :: next_level + logical :: 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(next_level - 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 + 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%trackctl%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%trackctl%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%trackctl%save(particle, kper=kper, & + kstp=kstp, reason=3) ! reason=3: termination + else + call this%trackctl%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, intent(in) :: ncpl, icu + integer :: 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..4014ad45eab --- /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: TrackControlType + 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%trackctl%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..7e681a88abe --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPollock.f90 @@ -0,0 +1,191 @@ +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: TrackControlType + 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) + use SubcellModule, only: SubcellType + 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, trackctl=this%trackctl) + 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 :: exitFace, inface + + exitFace = particle%iboundary(3) + ! -- Map subcell exit face to cell face + select case (exitFace) ! note: exitFace uses Dave's iface convention + case (0) + inface = -1 + case (1) + inface = 1 + case (2) + inface = 3 + case (3) + inface = 4 + case (4) + inface = 2 + case (5) + inface = 6 ! note: inface=5 same as inface=1 due to wraparound + case (6) + inface = 7 + end select + if (inface .eq. -1) then + particle%iboundary(2) = 0 + else + if ((inface .ge. 1) .and. (inface .le. 4)) then + ! -- Account for local cell rotation + select type (cell => this%cell) + type is (CellRectType) + inface = inface + cell%ipvOrigin - 1 + end select + if (inface .gt. 4) inface = inface - 4 + end if + particle%iboundary(2) = inface + 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 + double precision :: xOrigin, yOrigin, zOrigin, sinrot, 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%trackctl%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..432f7efe799 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPollockQuad.f90 @@ -0,0 +1,360 @@ +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: TrackControlType + 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, trackctl=this%trackctl) + 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%trackctl%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..78a6f877d6a --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellPool.f90 @@ -0,0 +1,42 @@ +!> @brief Cell-level tracking methods. +!! todo: refactor into derived type? +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..b06449f2dcd --- /dev/null +++ b/src/Solution/ParticleTracker/MethodCellTernary.f90 @@ -0,0 +1,327 @@ +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: TrackControlType + implicit none + + private + public :: MethodCellTernaryType + public :: create_method_cell_ternary + + type, extends(MethodType) :: MethodCellTernaryType + private + double precision :: x_vert(99), y_vert(99) !< cell vertex coordinates (kluge 99, todo: allocate as needed) + double precision :: xctr, yctr !< cell center coordinates + double precision :: vx_vert_polygon(99), vy_vert_polygon(99) !< cell vertex velocities + double precision :: vxctr, vyctr !< cell center velocities + double precision :: ztop, zbot !< cell top and bottom elevations + double precision :: dz !< cell thickness + double precision :: vztop, vzbot !< cell top and bottom velocities + 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) + call create_cell_poly(cell) + method%cell => cell + method%type => method%cell%type + method%delegates = .true. + call create_subcell_tri(subcell) + method%subcell => subcell + 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) + class(MethodCellTernaryType), 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 (SubcellTriType) + call this%load_subcell(particle, subcell) + end select + call method_subcell_tern%init(subcell=this%subcell, trackctl=this%trackctl) + submethod => method_subcell_tern + 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 :: isc, exitFace, inface, 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 + double precision :: retfactor + integer :: npolyverts, iv, ivp1, ivm1 + double precision :: x0, y0, x1, y1, x2, y2, xsum, ysum + double precision :: vxsum, vysum, flow0, flow1, v0x, v0y + double precision :: d01x, d01y, d02x, d02y, det, area, 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 (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%trackctl%save(particle, kper=kper, & + kstp=kstp, reason=1) ! reason=1: cell transition + end if + + npolyverts = cell%defn%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 :: ic, isc, npolyverts + integer :: iv0, iv1, ipv0, ipv1 + integer :: iv + double precision :: x0, y0, x1, y1, x2, y2, x1rel, y1rel, x2rel, y2rel, xi, yi + double precision :: di2, d02, d12, di1, d01, alphai, betai + double precision :: 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..fde9e82057c --- /dev/null +++ b/src/Solution/ParticleTracker/MethodDis.f90 @@ -0,0 +1,403 @@ +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: TrackControlType + 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, public :: 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 (todo: needed?) + procedure, private :: load_nbrs_to_defn ! load face neighbors to a cell definition + procedure, private :: load_flows_to_defn ! loads face flows to a cell definition + procedure, private :: load_boundary_flows_to_defn ! loads BoundaryFlows to a cell definition + ! todo: maybe separate LoadCellDefn module? + 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, intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + ! -- local + integer :: ic, icu + integer :: irow, jcol, klay + double precision :: areax, areay, areaz + double precision :: dx, dy, dz + double precision :: factor, 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, trackctl=this%trackctl) + 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, trackctl=this%trackctl) + 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 :: inface, ipos, ic, icu, inbr, idiag, ilay, irow, icol + real(DP) :: z, zrel, topfrom, botfrom, top, bot, 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%trackctl%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, 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 :: ic1, ic2, icu1, icu2, j1, iloc, ipos + integer :: irow1, irow2, jcol1, jcol2, klay1, klay2 + integer :: 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 :: ic, m, n, 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 :: 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..a9444a109aa --- /dev/null +++ b/src/Solution/ParticleTracker/MethodDisv.f90 @@ -0,0 +1,705 @@ +module MethodDisvModule + + use KindModule, only: DP, I4B + 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: TrackControlType + use GeomUtilModule, only: get_jk + implicit none + + private + public :: MethodDisvType, create_method_disv + + type, extends(MethodType) :: MethodDisvType + 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 + ! todo: maybe separate LoadCellDefn module? + 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) + call create_cell_poly(cell) + method%cell => cell + method%type = "disv" + method%delegates = .true. + 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, intent(in) :: next_level + class(MethodType), pointer, intent(inout) :: submethod + ! -- local + integer :: 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, trackctl=this%trackctl) + 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, trackctl=this%trackctl) + 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, trackctl=this%trackctl) + submethod => method_cell_quad + else + call method_cell_tern%init(cell=this%cell, trackctl=this%trackctl) + submethod => method_cell_tern + 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 :: inface, ipos, ic, icu, inbr, idiag, icpl, ilay + double precision :: 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%trackctl%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, intent(inout) :: inface + double precision, intent(inout) :: z + ! local + integer :: icin, npolyvertsin + integer :: ic, npolyverts, inbr, inbrnbr, j, m + real(DP) :: zrel, topfrom, botfrom, top, bot, 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, intent(in) :: ic + ! -- local + integer :: icu, icu2d + integer :: ncpl + ! -- result + integer :: 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, intent(in) :: iatop + ! -- result + 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 Load cell definition from the grid + subroutine load_cell_defn(this, ic, defn) + ! -- dummy + class(MethodDisvType), intent(inout) :: this + integer, intent(in) :: ic + type(CellDefnType), pointer, intent(inout) :: defn + ! -- local + real(DP) :: top, bot, 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 :: ic, npolyverts + integer :: ic1, ic2, icu1, icu2, j1, j2, k1, k2, iloc, ipos + integer :: istart1, istart2, istop1, istop2, iedgeface + integer :: 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 :: 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 :: ic, npolyverts, m, 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 :: ic, npolyverts + integer :: 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 :: ic, npolyverts, m, n, nn + integer :: ioffset, nbf, m1, m2, mdiff + double precision :: qbf + integer :: 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 :: ic, npolyverts, ioffset, 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 :: npolyverts, m, m0, m1, m2 + integer :: ic + integer :: num90, num180, numacute + double precision :: x0, y0, x1, y1, x2, y2 + double precision :: epsang, epslen, s0x, s0y, & + s0mag, s2x, s2y, s2mag, sinang, dotprod + logical 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..c8714aaa70f --- /dev/null +++ b/src/Solution/ParticleTracker/MethodPool.f90 @@ -0,0 +1,31 @@ +!> @brief Model-level tracking methods. +!! todo: refactor into derived type? +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..452743fa809 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellPollock.f90 @@ -0,0 +1,383 @@ +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: TrackControlType + 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 + double precision, 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 + double precision :: xOrigin, yOrigin, zOrigin, sinrot, 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 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 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 + doubleprecision :: vx1, vx2, vy1, vy2, vz1, vz2 + doubleprecision :: vx, dvxdx, vy, dvydy, vz, dvzdz + doubleprecision :: dtexitx, dtexity, dtexitz, dtexit, texit, dt, t + doubleprecision :: x, y, z + integer :: statusVX, statusVY, statusVZ + doubleprecision :: initialX, initialY, initialZ + integer :: exitFace + integer :: reason + + reason = -1 + + ! -- Initial particle location in scaled subcell coordinates + initialX = particle%x / subcell%dx + initialY = particle%y / subcell%dy + initialZ = particle%z / subcell%dz + + ! -- Make local copies of face velocities for convenience + vx1 = subcell%vx1 + vx2 = subcell%vx2 + vy1 = subcell%vy1 + vy2 = subcell%vy2 + vz1 = subcell%vz1 + vz2 = subcell%vz2 + + ! -- Compute time of travel to each possible exit face + statusVX = calculate_dt(vx1, vx2, subcell%dx, initialX, vx, dvxdx, & + dtexitx) + statusVY = calculate_dt(vy1, vy2, subcell%dy, initialY, vy, dvydy, & + dtexity) + statusVZ = calculate_dt(vz1, vz2, subcell%dz, initialZ, vz, dvzdz, & + dtexitz) + + ! -- Check for no exit face + if ((statusVX .eq. 3) .and. (statusVY .eq. 3) .and. (statusVZ .eq. 3)) 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 + 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 + + 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 - particle%ttrack + x = new_x(vx, dvxdx, vx1, vx2, dt, initialX, subcell%dx, statusVX == 1) + y = new_x(vy, dvydy, vy1, vy2, dt, initialY, subcell%dy, statusVY == 1) + z = new_x(vz, dvzdz, vz1, 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, vy1, vy2, dt, initialY, subcell%dy, statusVY == 1) + z = new_x(vz, dvzdz, vz1, 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, vx1, vx2, dt, initialX, subcell%dx, statusVX == 1) + y = 0d0 + z = new_x(vz, dvzdz, vz1, 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, vx1, vx2, dt, initialX, subcell%dx, statusVX == 1) + y = new_x(vy, dvydy, vy1, 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%trackctl%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 + doubleprecision, intent(in) :: v1, v2, dx, xL + doubleprecision, intent(inout) :: v, dvdx, dt + ! result + integer :: status + ! local + doubleprecision :: v2a, v1a, dv, dva, vv, vvv, zro, zrom, x, tol + doubleprecision :: vr1, vr2, vr, v1v2 + logical :: 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, dvdx, v1, v2, dt, x, 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..3d1fe65ad91 --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellPool.f90 @@ -0,0 +1,32 @@ +!> @brief Subcell-level tracking methods. +!! todo: refactor into derived type? +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..aecb9736c6d --- /dev/null +++ b/src/Solution/ParticleTracker/MethodSubcellTernary.f90 @@ -0,0 +1,382 @@ +module MethodSubcellTernaryModule + use KindModule, only: DP, I4B + 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: TrackControlType + 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 + 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) + call create_subcell_tri(subcell) + method%subcell => subcell + method%type => method%subcell%type + method%delegates = .false. + 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 :: exitFace + logical :: lbary ! kluge + double precision :: x0, y0, x1, y1, x2, y2 + double precision :: v0x, v0y, v1x, v1y, v2x, v2y + double precision :: xi, yi, zi, zirel, ztop, zbot, dz + double precision :: rxx, rxy, ryx, ryy, sxx, sxy, syy + double precision :: rot(2, 2), res(2), loc(2) + double precision :: alp, bet, alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti + double precision :: vzbot, vztop, vzi, vziodz, az, dtexitz + double precision :: dt, t, dtexitxy, texit, x, y, z + integer :: izstatus, itopbotexit + integer :: ntmax, nsave, isolv, itrifaceenter, itrifaceexit + double precision :: diff, rdiff, tol, step, dtexit, alpexit, betexit + integer :: ntdebug ! kluge + integer :: reason + + lbary = .true. ! kluge + ntmax = 10000 + nsave = 1 ! needed??? + isolv = 1 + 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(ntmax, nsave, diff, rdiff, & + isolv, tol, step, & + dtexitxy, alpexit, betexit, & + itrifaceenter, itrifaceexit, & + rxx, rxy, ryx, ryy, & + sxx, sxy, syy, & + 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 + + 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 - particle%ttrack + 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%trackctl%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) + doubleprecision, intent(in) :: v1, v2, dx, xL + doubleprecision, intent(inout) :: v, dvdx, dt + doubleprecision :: v2a, v1a, dv, dva, vv, vvv, zro, zrom, x, tol + doubleprecision :: vr1, vr2, vr, v1v2 + integer :: status, itopbotexit + logical :: 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..397f2347bc4 --- /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..19f561e867a --- /dev/null +++ b/src/Solution/ParticleTracker/TernarySolveTrack.f90 @@ -0,0 +1,775 @@ +module TernarySolveTrack + + use KindModule, only: I4B, DP, LGP + use GeomUtilModule, only: skew + use MathUtilModule, only: zeroch, zeroin, zerotest + 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(ntmax, nsave, diff, rdiff, & + isolv, tol, step, texit, & + alpexit, betexit, & + itrifaceenter, itrifaceexit, & + rxx, rxy, ryx, ryy, & + sxx, sxy, syy, & + alp0, bet0, alp1, bet1, alp2, bet2, alpi, beti, & + vziodz, az, & + bary) + ! real(DP), intent(inout) :: pexit(2) !< ?? + ! real(DP), intent(inout) :: itrifaceenter, itrifaceexit !< ?? + ! real(DP), intent(inout) :: r(2, 2) !< rotation matrix + ! real(DP), intent(inout) :: s(2, 2) !< skew matrix + ! real(DP), intent(inout) :: t(4, 2) !< triangle points + ! logical(LGP), intent(in), optional :: bary !< barycentric coordinates + implicit double precision(a - h, o - z) + logical :: bary + intrinsic cpu_time + + ! -- 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, alp0, bet0, & + alp1, bet1, alpi, beti, & + rxx, rxy, ryx, ryy, tol, step, vziodz, az, & + texit0, alpexit0, betexit0) + call find_exit_bary(isolv, 1, itrifaceenter, alp1, bet1, & + alp2, bet2, alpi, beti, & + rxx, rxy, ryx, ryy, tol, step, vziodz, az, & + texit1, alpexit1, betexit1) + call find_exit_bary(isolv, 2, itrifaceenter, alp2, bet2, & + alp0, bet0, alpi, beti, & + rxx, rxy, ryx, ryy, 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) + ! real(DP), intent(inout) :: p(3, 2) !< ?? + ! real(DP), intent(inout) :: v(3, 2) !< ?? + ! real(DP), intent(inout) :: i(2) !< ?? + ! real(DP), intent(inout) :: r(2, 2) !< rotation matrix + ! real(DP), intent(inout) :: s(2, 2) !< skew matrix + ! real(DP), intent(inout) :: t(3, 2) !< triangle points + ! logical(LGP), intent(in), optional :: bary !< barycentric coordinates + implicit double precision(a - h, o - z) + logical :: bary + real(DP) :: rot(2, 2), res(2) + + ! if (present(bary)) then + ! lbary = bary + ! else + ! lbary = .true. + ! end if + + ! -- 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 + + ! todo refactor alp/bet vars + 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/)) + ! todo turn alpi/beti into array + 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), intent(in) :: alp1, bet1, alp2, bet2 !< triangle face points + real(DP), intent(inout) :: waa, wab, wba, wbb !< w matrix + ! real(DP), intent(inout) :: t1(2), t2(2) !< triangle face points + ! real(DP), intent(inout) :: w(2, 2) !< w matrix + logical(LGP), intent(in), optional :: bary !< barycentric coordinates + ! -- local + logical(LGP) :: lbary + real(DP) :: v1alpdiff, v2alpdiff, v2betdiff + real(DP) :: ooalp1, oobet2, 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) + implicit double precision(a - h, o - z) + + 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) + implicit double precision(a - h, o - z) + + 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) + implicit double precision(a - h, o - z) + + 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, alp1, bet1, & + alp2, bet2, alpi, beti, rxx, rxy, & + ryx, ryy, tol, step, vziodz, az, & + texit, alpexit, betexit) + implicit double precision(a - h, o - z) + character facename(0:2) * 7, cfail * 60 + data(facename(itri), itri=0, 2)/"beta=0 ", "gamma=0", "alpha=0"/ + common / debug / ntdebug + + ! -- 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) + cfail = "entered on face beta=0 (no exit)" + 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) + cfail = "inflow or no flow on face beta=0 (no exit)" + 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) + cfail = "cannot exit on face beta=0 (no exit)" + 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 + ntdebug = -111 ! kluge debug bludebug + else + ! -- alpt not within the edge, so not an exit + texit = huge(1d0) + cfail = "alpt not within face beta=0 (not an exit)" + 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) + cfail = "no outflow interval (no exit)" + 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) + cfail = "beta=const not within outflow interval (not an exit)" + 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) + cfail = "cannot exit on face gamma=0 (no exit)" + else if ((itriface .eq. 2) .and. (valpi .ge. 0d0)) then + ! -- Can't exit along alpha = 0. + texit = huge(1d0) + cfail = "cannot exit on face alpha=0 (no exit)" + 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 + ntdebug = -222 ! kluge debug bludebug + else + texit = (alpexit - alpi) / v0alpstar + ntdebug = -333 ! kluge debug bludebug + 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) + cfail = "No feasible interval for beta" + 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) + cfail = "Beta bounds betlo and bethi do not bracket a root" + 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, cfail) + 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, cfail) + 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, cfail) + else if (isolv .eq. -1) then + ! -- Use Euler integration to find exit + call soln_euler(itriface, alpi, beti, step, vziodz, az, & + texit, alpexit, betexit) + else + write (*, '(A)') "Invalid isolv = ", isolv ! kluge + write (69, '(A)') "Invalid isolv = ", isolv + !!pause + stop + 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) + double precision function fbary1(bet) + implicit double precision(a - h, o - z) + + ! -- Evaluate gamma{t{beta}} = 1. - alpha{t{beta}} - beta + call get_t_alpt(bet, t, alpt) + fbary1 = 1d0 - alpt - bet + end function + + !> @brief Brent's method applied to canonical face 2 (alpha = 0) + double precision function fbary2(bet) + implicit double precision(a - h, o - z) + + ! -- Evaluate alpha{t{beta}} + call get_t_alpt(bet, t, alpt) + fbary2 = alpt + end function + + !> @brief Given beta evaluate t and alpha depending on case + subroutine get_t_alpt(bet, t, alp) + implicit double precision(a - h, o - z) + + ! 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) + implicit double precision(a - h, o - z) + + 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) + implicit double precision(a - h, o - z) + + 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, cfail) + implicit double precision(a - h, o - z) + character cfail * 60 + + ! -- 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 + betexit = zeroin(blo, bhi, fbary1, tol) + else + betexit = zeroin(blo, bhi, fbary2, 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, cfail) + implicit double precision(a - h, o - z) + character cfail * 60 + + ! -- 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 + betexit = zeroch(blo, bhi, fbary1, tol) + else + betexit = zeroch(blo, bhi, fbary2, 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, cfail) + implicit double precision(a - h, o - z) + character cfail * 60 + + ! -- 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 + betexit = zerotest(blo, bhi, fbary1, tol) + else + betexit = zerotest(blo, bhi, fbary2, 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) + implicit double precision(a - h, o - z) + common / debug / ntdebug ! kluge debug + + 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 + ntdebug = nt ! kluge debug + if (nt .gt. 1000000000) then ! kluge hardwired + ! -- Exit not found after max number of time steps + write (*, '(A)') "Didn't find exit in soln_euler" ! kluge note: shouldn't get here + write (69, '(A)') "Didn't find exit in soln_euler" ! kluge note: shouldn't get here + stop + end if + + end subroutine + +end module TernarySolveTrack diff --git a/src/Utilities/GeomUtil.f90 b/src/Utilities/GeomUtil.f90 index 9d1bad53c2b..10b76510886 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 @@ -140,7 +145,7 @@ end subroutine get_jk pure function skew(v, s, invert) result(res) ! -- dummy real(DP), intent(in) :: v(2) !< vector - real(DP), intent(in) :: s(3) !< skew matrix entries (top left, top right, bottom right) + real(DP), intent(in) :: s(3) !< skew matrix entries (top left, top right, bottom left) logical(LGP), intent(in), optional :: invert real(DP) :: res(2) ! -- local diff --git a/src/Utilities/Idm/selector/IdmDfnSelector.f90 b/src/Utilities/Idm/selector/IdmDfnSelector.f90 index a7b6190f6ff..45362ddea95 100644 --- a/src/Utilities/Idm/selector/IdmDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmDfnSelector.f90 @@ -7,6 +7,7 @@ module IdmDfnSelectorModule InputBlockDefinitionType use IdmGwfDfnSelectorModule use IdmGwtDfnSelectorModule + use IdmPrtDfnSelectorModule use IdmExgDfnSelectorModule use IdmSimDfnSelectorModule @@ -31,6 +32,8 @@ function param_definitions(component, subcomponent) result(input_definition) input_definition => gwf_param_definitions(subcomponent) case ('GWT') input_definition => gwt_param_definitions(subcomponent) + case ('PRT') + input_definition => prt_param_definitions(subcomponent) case ('EXG') input_definition => exg_param_definitions(subcomponent) case ('SIM') @@ -50,6 +53,8 @@ function aggregate_definitions(component, subcomponent) result(input_definition) input_definition => gwf_aggregate_definitions(subcomponent) case ('GWT') input_definition => gwt_aggregate_definitions(subcomponent) + case ('PRT') + input_definition => prt_aggregate_definitions(subcomponent) case ('EXG') input_definition => exg_aggregate_definitions(subcomponent) case ('SIM') @@ -69,6 +74,8 @@ function block_definitions(component, subcomponent) result(input_definition) input_definition => gwf_block_definitions(subcomponent) case ('GWT') input_definition => gwt_block_definitions(subcomponent) + case ('PRT') + input_definition => prt_block_definitions(subcomponent) case ('EXG') input_definition => exg_block_definitions(subcomponent) case ('SIM') @@ -87,6 +94,8 @@ function idm_multi_package(component, subcomponent) result(multi_package) multi_package = gwf_idm_multi_package(subcomponent) case ('GWT') multi_package = gwt_idm_multi_package(subcomponent) + case ('PRT') + multi_package = prt_idm_multi_package(subcomponent) case ('EXG') multi_package = exg_idm_multi_package(subcomponent) case ('SIM') @@ -109,6 +118,8 @@ function idm_integrated(component, subcomponent) result(integrated) integrated = gwf_idm_integrated(subcomponent) case ('GWT') integrated = gwt_idm_integrated(subcomponent) + case ('PRT') + integrated = prt_idm_integrated(subcomponent) case ('EXG') integrated = exg_idm_integrated(subcomponent) case ('SIM') @@ -127,6 +138,8 @@ function idm_component(component) result(integrated) integrated = .true. case ('GWT') integrated = .true. + case ('PRT') + integrated = .true. case ('EXG') integrated = .true. case ('SIM') diff --git a/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 b/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 index fa6aea90bc6..f9409b2b04b 100644 --- a/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmExgDfnSelector.f90 @@ -8,6 +8,7 @@ module IdmExgDfnSelectorModule use ExgGwfgwfInputModule use ExgGwfgwtInputModule use ExgGwtgwtInputModule + use ExgGwfprtInputModule implicit none private @@ -42,6 +43,8 @@ function exg_param_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, exg_gwfgwt_param_definitions) case ('GWTGWT') call set_param_pointer(input_definition, exg_gwtgwt_param_definitions) + case ('GWFPRT') + call set_param_pointer(input_definition, exg_gwfprt_param_definitions) case default end select return @@ -58,6 +61,8 @@ function exg_aggregate_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, exg_gwfgwt_aggregate_definitions) case ('GWTGWT') call set_param_pointer(input_definition, exg_gwtgwt_aggregate_definitions) + case ('GWFPRT') + call set_param_pointer(input_definition, exg_gwfprt_aggregate_definitions) case default end select return @@ -74,6 +79,8 @@ function exg_block_definitions(subcomponent) result(input_definition) call set_block_pointer(input_definition, exg_gwfgwt_block_definitions) case ('GWTGWT') call set_block_pointer(input_definition, exg_gwtgwt_block_definitions) + case ('GWFPRT') + call set_block_pointer(input_definition, exg_gwfprt_block_definitions) case default end select return @@ -89,6 +96,8 @@ function exg_idm_multi_package(subcomponent) result(multi_package) multi_package = exg_gwfgwt_multi_package case ('GWTGWT') multi_package = exg_gwtgwt_multi_package + case ('GWFPRT') + multi_package = exg_gwfprt_multi_package case default call store_error('Idm selector subcomponent not found; '//& &'component="EXG"'//& @@ -108,6 +117,8 @@ function exg_idm_integrated(subcomponent) result(integrated) integrated = .true. case ('GWTGWT') integrated = .true. + case ('GWFPRT') + integrated = .true. case default end select return diff --git a/src/Utilities/Idm/selector/IdmPrtDfnSelector.f90 b/src/Utilities/Idm/selector/IdmPrtDfnSelector.f90 new file mode 100644 index 00000000000..5c4c732df5a --- /dev/null +++ b/src/Utilities/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 PrtDisInputModule + use PrtDisvInputModule + use PrtMipInputModule + use PrtNamInputModule + + 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 ('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 ('NAM') + call set_param_pointer(input_definition, prt_nam_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 ('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 ('NAM') + call set_param_pointer(input_definition, prt_nam_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 ('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 ('NAM') + call set_block_pointer(input_definition, prt_nam_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 ('DIS') + multi_package = prt_dis_multi_package + case ('DISV') + multi_package = prt_disv_multi_package + case ('MIP') + multi_package = prt_mip_multi_package + case ('NAM') + multi_package = prt_nam_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 ('DIS') + integrated = .true. + case ('DISV') + integrated = .true. + case ('MIP') + integrated = .true. + case ('NAM') + integrated = .true. + case default + end select + return + end function prt_idm_integrated + +end module IdmPrtDfnSelectorModule diff --git a/src/meson.build b/src/meson.build index 2816fef7f2b..0a09ff97953 100644 --- a/src/meson.build +++ b/src/meson.build @@ -31,10 +31,12 @@ modflow_sources = files( 'Exchange' / 'GwfGwfExchange.f90', 'Exchange' / 'GwfGwtExchange.f90', 'Exchange' / 'GwtGwtExchange.f90', + 'Exchange' / 'GwfPrtExchange.f90', 'Exchange' / 'NumericalExchange.f90', 'Exchange' / 'gwfgwfidm.f90', 'Exchange' / 'gwfgwtidm.f90', 'Exchange' / 'gwtgwtidm.f90', + 'Exchange' / 'gwfprtidm.f90', 'Model' / 'Connection' / 'ConnectionBuilder.f90', 'Model' / 'Connection' / 'CellWithNbrs.f90', 'Model' / 'Connection' / 'CsrUtils.f90', @@ -110,6 +112,17 @@ modflow_sources = files( 'Model' / 'GroundWaterTransport' / 'gwt1sft1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1src1.f90', 'Model' / 'GroundWaterTransport' / 'gwt1uzt1.f90', + 'Model' / 'ParticleTracking' / 'prt1.f90', + 'Model' / 'ParticleTracking' / 'prt1idm.f90', + 'Model' / 'ParticleTracking' / 'prt1fmi1.f90', + 'Model' / 'ParticleTracking' / 'prt1mip.f90', + 'Model' / 'ParticleTracking' / 'prt1obs1.f90', + 'Model' / 'ParticleTracking' / 'prt1oc1.f90', + 'Model' / 'ParticleTracking' / 'prt1prp1.f90', + 'Model' / 'ParticleTracking' / 'prt1dis1idm.f90', + # 'Model' / 'ParticleTracking' / 'prt1disu1idm.f90', + 'Model' / 'ParticleTracking' / 'prt1disv1idm.f90', + 'Model' / 'ParticleTracking' / 'prt1mip1idm.f90', 'Model' / 'ModelUtilities' / 'BoundaryPackage.f90', 'Model' / 'ModelUtilities' / 'BoundaryPackageExt.f90', 'Model' / 'ModelUtilities' / 'Connections.f90', @@ -129,6 +142,7 @@ modflow_sources = files( 'Model' / 'ModelUtilities' / 'SfrCrossSectionManager.f90', 'Model' / 'ModelUtilities' / 'SfrCrossSectionUtils.f90', 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90', + 'Model' / 'ModelUtilities' / 'TrackData.f90', 'Model' / 'ModelUtilities' / 'UzfCellGroup.f90', 'Model' / 'ModelUtilities' / 'Xt3dAlgorithm.f90', 'Model' / 'ModelUtilities' / 'Xt3dInterface.f90', @@ -159,6 +173,31 @@ 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', @@ -188,6 +227,7 @@ modflow_sources = files( 'Utilities' / 'Idm' / 'selector' / 'IdmExgDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmGwfDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmGwtDfnSelector.f90', + 'Utilities' / 'Idm' / 'selector' / 'IdmPrtDfnSelector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmSimDfnSelector.f90', 'Utilities' / 'Matrix' / 'MatrixBase.f90', 'Utilities' / 'Matrix' / 'SparseMatrix.f90', @@ -227,6 +267,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', @@ -249,7 +290,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', diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py index 5b5a0c58c99..495446adb1d 100644 --- a/utils/idmloader/scripts/dfn2f90.py +++ b/utils/idmloader/scripts/dfn2f90.py @@ -938,6 +938,18 @@ def _write_master_component(self, fh=None): DFN_PATH / "gwt-ic.dfn", SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1ic1idm.f90", ], + [ + DFN_PATH / "prt-dis.dfn", + SRC_PATH / "Model" / "ParticleTracking" / "prt1dis1idm.f90", + ], + [ + DFN_PATH / "prt-disv.dfn", + SRC_PATH / "Model" / "ParticleTracking" / "prt1disv1idm.f90", + ], + [ + DFN_PATH / "prt-mip.dfn", + SRC_PATH / "Model" / "ParticleTracking" / "prt1mip1idm.f90", + ], [ DFN_PATH / "gwf-nam.dfn", SRC_PATH / "Model" / "GroundWaterFlow" / "gwf3idm.f90", @@ -946,6 +958,10 @@ def _write_master_component(self, fh=None): DFN_PATH / "gwt-nam.dfn", SRC_PATH / "Model" / "GroundWaterTransport" / "gwt1idm.f90", ], + [ + DFN_PATH / "prt-nam.dfn", + SRC_PATH / "Model" / "ParticleTracking" / "prt1idm.f90", + ], [ DFN_PATH / "exg-gwfgwf.dfn", SRC_PATH / "Exchange" / "gwfgwfidm.f90", @@ -958,6 +974,10 @@ def _write_master_component(self, fh=None): DFN_PATH / "exg-gwtgwt.dfn", SRC_PATH / "Exchange" / "gwtgwtidm.f90", ], + [ + DFN_PATH / "exg-gwfprt.dfn", + SRC_PATH / "Exchange" / "gwfprtidm.f90", + ], [ DFN_PATH / "sim-nam.dfn", SRC_PATH / "simnamidm.f90", diff --git a/utils/mf5to6/make/makedefaults b/utils/mf5to6/make/makedefaults index e7b3710e4ab..99617e73c36 100644 --- a/utils/mf5to6/make/makedefaults +++ b/utils/mf5to6/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. +# makedefaults created by pymake (version 1.2.8) for the 'mf5to6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -64,9 +64,12 @@ else FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp MODSWITCH = -module $(MODDIR) endif + ifeq ($(FC), $(filter $(FC), ftn)) + FFLAGS ?= -h noheap_allocate + endif endif # set the ldflgs @@ -81,6 +84,9 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif + ifeq ($(FC), $(filter $(FC), ftn)) + LDFLAGS ?= -lc + endif endif # check for Windows error condition diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index ccf5741d638..6aacbfb92cc 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -1,14 +1,14 @@ -# makefile created by pymake (version 1.2.9.dev0) for the 'mf5to6' executable. +# makefile created by pymake (version 1.2.8) for the 'mf5to6' executable. include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/LGR -SOURCEDIR3=../src/Preproc -SOURCEDIR4=../src/MF2005 -SOURCEDIR5=../src/NWT +SOURCEDIR2=../src/NWT +SOURCEDIR3=../src/LGR +SOURCEDIR4=../src/Preproc +SOURCEDIR5=../src/MF2005 SOURCEDIR6=../../../src/Utilities/Memory SOURCEDIR7=../../../src/Utilities/TimeSeries SOURCEDIR8=../../../src/Utilities diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index c0eadf7ac21..90a04c0f7b3 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -1,4 +1,4 @@ -# makedefaults created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. +# makedefaults created by pymake (version 1.2.8) for the 'zbud6' executable. # determine OS ifeq ($(OS), Windows_NT) @@ -57,16 +57,19 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp MODSWITCH = -module $(MODDIR) endif + ifeq ($(FC), $(filter $(FC), ftn)) + FFLAGS ?= -h noheap_allocate + endif endif # set the ldflgs @@ -81,6 +84,9 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif + ifeq ($(FC), $(filter $(FC), ftn)) + LDFLAGS ?= -lc + endif endif # check for Windows error condition diff --git a/utils/zonebudget/make/makefile b/utils/zonebudget/make/makefile index 8a24ed1c082..65201a7afea 100644 --- a/utils/zonebudget/make/makefile +++ b/utils/zonebudget/make/makefile @@ -1,4 +1,4 @@ -# makefile created by pymake (version 1.2.9.dev0) for the 'zbud6' executable. +# makefile created by pymake (version 1.2.8) for the 'zbud6' executable. include ./makedefaults