diff --git a/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn b/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn
index 543433c1b3c..8c12234ac97 100644
--- a/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn
+++ b/doc/mf6io/mf6ivar/dfn/gwf-chd.dfn
@@ -1,5 +1,6 @@
# --------------------- gwf chd options ---------------------
# flopy multi-package
+# modflow6 aux-sfac-param head
block options
name auxiliary
@@ -35,6 +36,7 @@ reader urword
optional true
longname print input to listing file
description REPLACE print_input {'{#1}': 'constant-head'}
+mf6internal iprpak
block options
name print_flows
@@ -43,6 +45,7 @@ reader urword
optional true
longname print CHD flows to listing file
description REPLACE print_flows {'{#1}': 'constant-head'}
+mf6internal iprflow
block options
name save_flows
@@ -51,6 +54,7 @@ reader urword
optional true
longname save CHD flows to budget file
description REPLACE save_flows {'{#1}': 'constant-head'}
+mf6internal ipakcb
block options
name ts_filerecord
@@ -127,6 +131,15 @@ optional false
longname obs6 input filename
description REPLACE obs6_filename {'{#1}': 'constant-head'}
+# dev options
+block options
+name dev_no_newton
+type keyword
+reader urword
+optional true
+longname turn off Newton for unconfined cells
+description turn off Newton for unconfined cells
+mf6internal inewton
# --------------------- gwf chd dimensions ---------------------
@@ -161,6 +174,7 @@ shape (maxbound)
reader urword
longname
description
+mf6internal spd
block period
name cellid
@@ -194,6 +208,7 @@ optional true
time_series true
longname auxiliary variables
description REPLACE aux {'{#1}': 'constant head'}
+mf6internal auxvar
block period
name boundname
diff --git a/make/makefile b/make/makefile
index f82c2725180..2b0b60d316e 100644
--- a/make/makefile
+++ b/make/makefile
@@ -95,8 +95,21 @@ $(OBJDIR)/MemoryList.o \
$(OBJDIR)/TimeSeriesRecord.o \
$(OBJDIR)/BlockParser.o \
$(OBJDIR)/MemoryManager.o \
+$(OBJDIR)/InputDefinition.o \
$(OBJDIR)/TimeSeries.o \
$(OBJDIR)/ats.o \
+$(OBJDIR)/simnamidm.o \
+$(OBJDIR)/gwt1idm.o \
+$(OBJDIR)/gwt1dsp1idm.o \
+$(OBJDIR)/gwt1disv1idm.o \
+$(OBJDIR)/gwt1disu1idm.o \
+$(OBJDIR)/gwt1dis1idm.o \
+$(OBJDIR)/gwf3npf8idm.o \
+$(OBJDIR)/gwf3idm.o \
+$(OBJDIR)/gwf3disv8idm.o \
+$(OBJDIR)/gwf3disu8idm.o \
+$(OBJDIR)/gwf3dis8idm.o \
+$(OBJDIR)/gwf3chd8idm.o \
$(OBJDIR)/TimeSeriesLink.o \
$(OBJDIR)/TimeSeriesFileList.o \
$(OBJDIR)/tdis.o \
@@ -105,65 +118,62 @@ $(OBJDIR)/VectorBase.o \
$(OBJDIR)/Sparse.o \
$(OBJDIR)/DisvGeom.o \
$(OBJDIR)/ArrayReaders.o \
+$(OBJDIR)/IdmSimDfnSelector.o \
+$(OBJDIR)/IdmGwtDfnSelector.o \
+$(OBJDIR)/IdmGwfDfnSelector.o \
$(OBJDIR)/TimeSeriesManager.o \
$(OBJDIR)/SmoothingFunctions.o \
+$(OBJDIR)/MemoryManagerExt.o \
$(OBJDIR)/MatrixBase.o \
$(OBJDIR)/ListReader.o \
$(OBJDIR)/Connections.o \
-$(OBJDIR)/InputDefinition.o \
+$(OBJDIR)/IdmDfnSelector.o \
$(OBJDIR)/TimeArray.o \
+$(OBJDIR)/ArrayReaderBase.o \
$(OBJDIR)/ObsOutput.o \
$(OBJDIR)/DiscretizationBase.o \
-$(OBJDIR)/simnamidm.o \
-$(OBJDIR)/gwt1idm.o \
-$(OBJDIR)/gwt1dsp1idm.o \
-$(OBJDIR)/gwt1disv1idm.o \
-$(OBJDIR)/gwt1disu1idm.o \
-$(OBJDIR)/gwt1dis1idm.o \
-$(OBJDIR)/gwf3npf8idm.o \
-$(OBJDIR)/gwf3idm.o \
-$(OBJDIR)/gwf3disv8idm.o \
-$(OBJDIR)/gwf3disu8idm.o \
-$(OBJDIR)/gwf3dis8idm.o \
+$(OBJDIR)/STLVecInt.o \
+$(OBJDIR)/ModflowInput.o \
$(OBJDIR)/TimeArraySeries.o \
+$(OBJDIR)/Integer2dReader.o \
$(OBJDIR)/ObsOutputList.o \
$(OBJDIR)/Observe.o \
-$(OBJDIR)/IdmSimDfnSelector.o \
-$(OBJDIR)/IdmGwtDfnSelector.o \
-$(OBJDIR)/IdmGwfDfnSelector.o \
+$(OBJDIR)/StructVector.o \
+$(OBJDIR)/IdmLogger.o \
+$(OBJDIR)/DefinitionSelect.o \
+$(OBJDIR)/InputLoadType.o \
$(OBJDIR)/TimeArraySeriesLink.o \
+$(OBJDIR)/Integer1dReader.o \
+$(OBJDIR)/Double2dReader.o \
+$(OBJDIR)/Double1dReader.o \
$(OBJDIR)/ObsUtility.o \
$(OBJDIR)/ObsContainer.o \
$(OBJDIR)/BudgetFileReader.o \
-$(OBJDIR)/IdmDfnSelector.o \
-$(OBJDIR)/ArrayReaderBase.o \
+$(OBJDIR)/StructArray.o \
+$(OBJDIR)/BoundInputContext.o \
+$(OBJDIR)/AsciiInputLoadType.o \
$(OBJDIR)/TimeArraySeriesManager.o \
+$(OBJDIR)/SourceCommon.o \
+$(OBJDIR)/LayeredArrayReader.o \
$(OBJDIR)/PackageMover.o \
$(OBJDIR)/Obs3.o \
$(OBJDIR)/NumericalPackage.o \
$(OBJDIR)/Budget.o \
$(OBJDIR)/BudgetTerm.o \
+$(OBJDIR)/StressListInput.o \
+$(OBJDIR)/StressGridInput.o \
+$(OBJDIR)/LoadMf6File.o \
$(OBJDIR)/sort.o \
$(OBJDIR)/SfrCrossSectionUtils.o \
-$(OBJDIR)/STLVecInt.o \
-$(OBJDIR)/ModflowInput.o \
-$(OBJDIR)/MemoryManagerExt.o \
-$(OBJDIR)/Integer2dReader.o \
$(OBJDIR)/VirtualBase.o \
$(OBJDIR)/BoundaryPackage.o \
$(OBJDIR)/BaseModel.o \
$(OBJDIR)/PackageBudget.o \
$(OBJDIR)/HeadFileReader.o \
$(OBJDIR)/BudgetObject.o \
+$(OBJDIR)/IdmMf6File.o \
$(OBJDIR)/SfrCrossSectionManager.o \
$(OBJDIR)/dag_module.o \
-$(OBJDIR)/StructVector.o \
-$(OBJDIR)/IdmLogger.o \
-$(OBJDIR)/DefinitionSelect.o \
-$(OBJDIR)/InputLoadType.o \
-$(OBJDIR)/Integer1dReader.o \
-$(OBJDIR)/Double2dReader.o \
-$(OBJDIR)/Double1dReader.o \
$(OBJDIR)/VirtualDataLists.o \
$(OBJDIR)/VirtualDataContainer.o \
$(OBJDIR)/SimStages.o \
@@ -172,6 +182,8 @@ $(OBJDIR)/FlowModelInterface.o \
$(OBJDIR)/PrintSaveManager.o \
$(OBJDIR)/Xt3dAlgorithm.o \
$(OBJDIR)/gwf3tvbase8.o \
+$(OBJDIR)/SourceLoad.o \
+$(OBJDIR)/ModelPackageInputs.o \
$(OBJDIR)/gwf3sfr8.o \
$(OBJDIR)/gwf3riv8.o \
$(OBJDIR)/gwf3maw8.o \
@@ -181,11 +193,6 @@ $(OBJDIR)/GwfVscInputData.o \
$(OBJDIR)/gwf3ghb8.o \
$(OBJDIR)/gwf3drn8.o \
$(OBJDIR)/IndexMap.o \
-$(OBJDIR)/StructArray.o \
-$(OBJDIR)/BoundInputContext.o \
-$(OBJDIR)/AsciiInputLoadType.o \
-$(OBJDIR)/SourceCommon.o \
-$(OBJDIR)/LayeredArrayReader.o \
$(OBJDIR)/VirtualModel.o \
$(OBJDIR)/BaseExchange.o \
$(OBJDIR)/UzfCellGroup.o \
@@ -194,13 +201,11 @@ $(OBJDIR)/OutputControlData.o \
$(OBJDIR)/gwf3ic8.o \
$(OBJDIR)/Xt3dInterface.o \
$(OBJDIR)/gwf3tvk8.o \
+$(OBJDIR)/IdmLoad.o \
$(OBJDIR)/gwf3vsc8.o \
$(OBJDIR)/GwfNpfOptions.o \
$(OBJDIR)/InterfaceMap.o \
$(OBJDIR)/SeqVector.o \
-$(OBJDIR)/StressListInput.o \
-$(OBJDIR)/StressGridInput.o \
-$(OBJDIR)/LoadMf6File.o \
$(OBJDIR)/CellWithNbrs.o \
$(OBJDIR)/NumericalExchange.o \
$(OBJDIR)/gwf3uzf8.o \
@@ -218,18 +223,17 @@ $(OBJDIR)/Mover.o \
$(OBJDIR)/GwfMvrPeriodData.o \
$(OBJDIR)/ims8misc.o \
$(OBJDIR)/GwfBuyInputData.o \
+$(OBJDIR)/BoundaryPackageExt.o \
$(OBJDIR)/VirtualSolution.o \
$(OBJDIR)/SparseMatrix.o \
$(OBJDIR)/LinearSolverBase.o \
$(OBJDIR)/ims8reordering.o \
-$(OBJDIR)/IdmMf6File.o \
$(OBJDIR)/VirtualExchange.o \
$(OBJDIR)/gwf3disu8.o \
$(OBJDIR)/GridSorting.o \
$(OBJDIR)/DisConnExchange.o \
$(OBJDIR)/CsrUtils.o \
$(OBJDIR)/tsp1.o \
-$(OBJDIR)/ModelPackageInputs.o \
$(OBJDIR)/gwt1uzt1.o \
$(OBJDIR)/gwt1ssm1.o \
$(OBJDIR)/gwt1src1.o \
@@ -261,7 +265,6 @@ $(OBJDIR)/gwf3chd8.o \
$(OBJDIR)/RouterBase.o \
$(OBJDIR)/ImsLinearSolver.o \
$(OBJDIR)/ims8base.o \
-$(OBJDIR)/SourceLoad.o \
$(OBJDIR)/GridConnection.o \
$(OBJDIR)/DistributedVariable.o \
$(OBJDIR)/gwt1.o \
@@ -270,7 +273,6 @@ $(OBJDIR)/SerialRouter.o \
$(OBJDIR)/Timer.o \
$(OBJDIR)/LinearSolverFactory.o \
$(OBJDIR)/ims8linear.o \
-$(OBJDIR)/IdmLoad.o \
$(OBJDIR)/BaseSolution.o \
$(OBJDIR)/ExplicitModel.o \
$(OBJDIR)/SpatialModelConnection.o \
diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj
index 8270d990e13..275da841c99 100644
--- a/msvs/mf6core.vfproj
+++ b/msvs/mf6core.vfproj
@@ -122,6 +122,7 @@
+
@@ -179,6 +180,7 @@
+
diff --git a/src/Exchange/GwfGwtExchange.f90 b/src/Exchange/GwfGwtExchange.f90
index 986b84fd990..fe462a9c87a 100644
--- a/src/Exchange/GwfGwtExchange.f90
+++ b/src/Exchange/GwfGwtExchange.f90
@@ -551,7 +551,7 @@ subroutine gwfbnd2gwtfmi(this)
packobj => GetBndFromList(gwfmodel%bndlist, ip)
call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( &
'SIMVALS', &
- packobj%memoryPath)
+ packobj%memoryPath, packobj%input_mempath)
iterm = iterm + 1
!
! -- If a mover is active for this package, then establish a separate
@@ -561,7 +561,7 @@ subroutine gwfbnd2gwtfmi(this)
if (imover /= 0) then
call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( &
'SIMTOMVR', &
- packobj%memoryPath)
+ packobj%memoryPath, packobj%input_mempath)
iterm = iterm + 1
end if
end do
diff --git a/src/Model/GroundWaterFlow/gwf3.f90 b/src/Model/GroundWaterFlow/gwf3.f90
index 9a8057246be..cb25f0b16c6 100644
--- a/src/Model/GroundWaterFlow/gwf3.f90
+++ b/src/Model/GroundWaterFlow/gwf3.f90
@@ -1254,8 +1254,8 @@ end subroutine allocate_scalars
!! (2) add a pointer to the package
!!
!<
- subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
- iout)
+ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, &
+ inunit, iout)
! -- modules
use ConstantsModule, only: LINELENGTH
use SimModule, only: store_error
@@ -1278,6 +1278,7 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
integer(I4B), intent(in) :: ipakid
integer(I4B), intent(in) :: ipaknum
character(len=*), intent(in) :: pakname
+ character(len=*), intent(in) :: mempath
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
! -- local
@@ -1289,7 +1290,8 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
! -- This part creates the package object
select case (filtyp)
case ('CHD6')
- call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
+ call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
+ pakname, mempath)
case ('WEL6')
call wel_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
case ('DRN6')
@@ -1432,8 +1434,8 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, &
bndptype = pkgtype
end if
!
- call this%package_create(pkgtype, ipakid, ipaknum, pkgname, inunit, &
- this%iout)
+ call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
+ inunit, this%iout)
ipakid = ipakid + 1
ipaknum = ipaknum + 1
end do
@@ -1541,8 +1543,9 @@ subroutine create_packages(this)
this%inoc = inunit
case ('OBS6')
this%inobs = inunit
- case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', 'EVT6', &
- 'API6', 'CHD6', 'MAW6', 'SFR6', 'LAK6', 'UZF6')
+ case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', &
+ 'EVT6', 'API6', 'CHD6', 'MAW6', 'SFR6', &
+ 'LAK6', 'UZF6')
call expandarray(bndpkgs)
bndpkgs(size(bndpkgs)) = n
case default
diff --git a/src/Model/GroundWaterFlow/gwf3chd8.f90 b/src/Model/GroundWaterFlow/gwf3chd8.f90
index 5b55207e1cc..c3f79bc9129 100644
--- a/src/Model/GroundWaterFlow/gwf3chd8.f90
+++ b/src/Model/GroundWaterFlow/gwf3chd8.f90
@@ -3,9 +3,12 @@ module ChdModule
use KindModule, only: DP, I4B
use ConstantsModule, only: DZERO, DONE, NAMEDBOUNDFLAG, LENFTYPE, &
LINELENGTH, LENPACKAGENAME
+ use SimVariablesModule, only: errmsg
+ use SimModule, only: count_errors, store_error, store_error_filename
use MemoryHelperModule, only: create_mem_path
use ObsModule, only: DefaultObsIdProcessor
use BndModule, only: BndType
+ use BndExtModule, only: BndExtType
use ObserveModule, only: ObserveType
use TimeSeriesLinkModule, only: TimeSeriesLinkType, &
GetTimeSeriesLinkFromList
@@ -19,7 +22,8 @@ module ChdModule
character(len=LENFTYPE) :: ftype = 'CHD'
character(len=LENPACKAGENAME) :: text = ' CHD'
!
- type, extends(BndType) :: ChdType
+ type, extends(BndExtType) :: ChdType
+ real(DP), dimension(:), pointer, contiguous :: head => null() !< constant head array
real(DP), dimension(:), pointer, contiguous :: ratechdin => null() !simulated flows into constant head (excluding other chds)
real(DP), dimension(:), pointer, contiguous :: ratechdout => null() !simulated flows out of constant head (excluding to other chds)
contains
@@ -32,16 +36,16 @@ module ChdModule
procedure :: bnd_da => chd_da
procedure :: allocate_arrays => chd_allocate_arrays
procedure :: define_listlabel
+ procedure :: bound_value => chd_bound_value
! -- methods for observations
procedure, public :: bnd_obs_supported => chd_obs_supported
procedure, public :: bnd_df_obs => chd_df_obs
- ! -- method for time series
- procedure, public :: bnd_rp_ts => chd_rp_ts
end type ChdType
contains
- subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
+ subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
+ mempath)
! ******************************************************************************
! chd_create -- Create a New Constant Head Package
! Subroutine: (1) create new-style package
@@ -58,6 +62,7 @@ subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
+ character(len=*), intent(in) :: mempath
! -- local
type(ChdType), pointer :: chdobj
! ------------------------------------------------------------------------------
@@ -67,11 +72,11 @@ subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
packobj => chdobj
!
! -- create name and memory path
- call packobj%set_names(ibcnum, namemodel, pakname, ftype)
+ call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
packobj%text = text
!
! -- allocate scalars
- call packobj%allocate_scalars()
+ call chdobj%allocate_scalars()
!
! -- initialize package
call packobj%pack_initialize()
@@ -91,13 +96,13 @@ end subroutine chd_create
subroutine chd_allocate_arrays(this, nodelist, auxvar)
! ******************************************************************************
-! allocate_scalars -- allocate arrays
+! chd_allocate_arrays -- allocate arrays
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
- use MemoryManagerModule, only: mem_allocate
+ use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin
! -- dummy
class(ChdType) :: this
integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
@@ -107,7 +112,7 @@ subroutine chd_allocate_arrays(this, nodelist, auxvar)
! ------------------------------------------------------------------------------
!
! -- call standard BndType allocate scalars
- call this%BndType%allocate_arrays()
+ call this%BndExtType%allocate_arrays(nodelist, auxvar)
!
! -- allocate ratechdex
call mem_allocate(this%ratechdin, this%maxbound, 'RATECHDIN', this%memoryPath)
@@ -118,6 +123,13 @@ subroutine chd_allocate_arrays(this, nodelist, auxvar)
this%ratechdout(i) = DZERO
end do
!
+ ! -- set constant head array input context pointer
+ call mem_setptr(this%head, 'HEAD', this%input_mempath)
+ !
+ ! -- checkin constant head array input context pointer
+ call mem_checkin(this%head, 'HEAD', this%memoryPath, &
+ 'HEAD', this%input_mempath)
+ !
! -- return
return
end subroutine chd_allocate_arrays
@@ -129,23 +141,23 @@ subroutine chd_rp(this)
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
- use SimModule, only: store_error
+ use TdisModule, only: kper
! -- dummy
class(ChdType), intent(inout) :: this
! -- local
- character(len=LINELENGTH) :: errmsg
character(len=30) :: nodestr
integer(I4B) :: i, node, ibd, ierr
! ------------------------------------------------------------------------------
+ if (this%iper /= kper) return
!
! -- Reset previous CHDs to active cell
do i = 1, this%nbound
node = this%nodelist(i)
this%ibound(node) = this%ibcnum
end do
- !
+ !!
! -- Call the parent class read and prepare
- call this%BndType%bnd_rp()
+ call this%BndExtType%bnd_rp()
!
! -- Set ibound to -(ibcnum + 1) for constant head cells
ierr = 0
@@ -165,7 +177,12 @@ subroutine chd_rp(this)
!
! -- Stop if errors detected
if (ierr > 0) then
- call this%parser%StoreErrorUnit()
+ call store_error_filename(this%input_fname)
+ end if
+ !
+ ! -- Write the list to iout if requested
+ if (this%iprpak /= 0) then
+ call this%write_list()
end if
!
! -- return
@@ -187,14 +204,15 @@ subroutine chd_ad(this)
real(DP) :: hb
! -- formats
! ------------------------------------------------------------------------------
- !
- ! -- Advance the time series
- call this%TsManager%ad()
!
! -- Process each entry in the specified-head cell list
do i = 1, this%nbound
node = this%nodelist(i)
- hb = this%bound(1, i)
+ if (this%iauxmultcol > 0) then
+ hb = this%head(i) * this%auxvar(this%iauxmultcol, i)
+ else
+ hb = this%head(i)
+ end if
this%xnew(node) = hb
this%xold(node) = this%xnew(node)
end do
@@ -216,12 +234,9 @@ subroutine chd_ck(this)
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
- use ConstantsModule, only: LINELENGTH
- use SimModule, only: store_error, count_errors
! -- dummy
class(ChdType), intent(inout) :: this
! -- local
- character(len=LINELENGTH) :: errmsg
character(len=30) :: nodestr
integer(I4B) :: i
integer(I4B) :: node
@@ -237,16 +252,16 @@ subroutine chd_ck(this)
node = this%nodelist(i)
bt = this%dis%bot(node)
! -- accumulate errors
- if (this%bound(1, i) < bt .and. this%icelltype(node) /= 0) then
+ if (this%head(i) < bt .and. this%icelltype(node) /= 0) then
call this%dis%noder_to_string(node, nodestr)
- write (errmsg, fmt=fmtchderr) i, this%bound(1, i), bt, trim(nodestr)
+ write (errmsg, fmt=fmtchderr) i, this%head(i), bt, trim(nodestr)
call store_error(errmsg)
end if
end do
!
!write summary of chd package error messages
if (count_errors() > 0) then
- call this%parser%StoreErrorUnit()
+ call store_error_filename(this%input_fname)
end if
!
! -- return
@@ -375,11 +390,12 @@ subroutine chd_da(this)
! ------------------------------------------------------------------------------
!
! -- Deallocate parent package
- call this%BndType%bnd_da()
+ call this%BndExtType%bnd_da()
!
! -- arrays
call mem_deallocate(this%ratechdin)
call mem_deallocate(this%ratechdout)
+ call mem_deallocate(this%head, 'HEAD', this%memoryPath)
!
! -- return
return
@@ -455,31 +471,34 @@ subroutine chd_df_obs(this)
return
end subroutine chd_df_obs
- ! -- Procedure related to time series
-
- subroutine chd_rp_ts(this)
- ! -- Assign tsLink%Text appropriately for
- ! all time series in use by package.
- ! In CHD package variable HEAD
- ! can be controlled by time series.
- ! -- dummy
- class(ChdType), intent(inout) :: this
- ! -- local
- integer(I4B) :: i, nlinks
- type(TimeSeriesLinkType), pointer :: tslink => null()
- !
- nlinks = this%TsManager%boundtslinks%Count()
- do i = 1, nlinks
- tslink => GetTimeSeriesLinkFromList(this%TsManager%boundtslinks, i)
- if (associated(tslink)) then
- select case (tslink%JCol)
- case (1)
- tslink%Text = 'HEAD'
- end select
- end if
- end do
+ !> @ brief Return a bound value
+ !!
+ !! Return a bound value associated with an ncolbnd index
+ !! and row.
+ !!
+ !<
+ function chd_bound_value(this, col, row) result(bndval)
+ ! -- modules
+ use ConstantsModule, only: DZERO
+ ! -- dummy variables
+ class(ChdType), intent(inout) :: this !< BndType object
+ integer(I4B), intent(in) :: col
+ integer(I4B), intent(in) :: row
+ ! -- result
+ real(DP) :: bndval
!
+ select case (col)
+ case (1)
+ bndval = this%head(row)
+ case default
+ errmsg = 'Programming error. CHD bound value requested column '&
+ &'outside range of ncolbnd (1).'
+ call store_error(errmsg)
+ call store_error_filename(this%input_fname)
+ end select
+ !
+ ! -- return
return
- end subroutine chd_rp_ts
+ end function chd_bound_value
end module ChdModule
diff --git a/src/Model/GroundWaterFlow/gwf3chd8idm.f90 b/src/Model/GroundWaterFlow/gwf3chd8idm.f90
new file mode 100644
index 00000000000..788b84b4c41
--- /dev/null
+++ b/src/Model/GroundWaterFlow/gwf3chd8idm.f90
@@ -0,0 +1,433 @@
+! ** Do Not Modify! MODFLOW 6 system generated file. **
+module GwfChdInputModule
+ use ConstantsModule, only: LENVARNAME
+ use InputDefinitionModule, only: InputParamDefinitionType, &
+ InputBlockDefinitionType
+ private
+ public gwf_chd_param_definitions
+ public gwf_chd_aggregate_definitions
+ public gwf_chd_block_definitions
+ public GwfChdParamFoundType
+ public gwf_chd_multi_package
+ public gwf_chd_aux_sfac_param
+
+ type GwfChdParamFoundType
+ logical :: auxiliary = .false.
+ logical :: auxmultname = .false.
+ logical :: boundnames = .false.
+ logical :: iprpak = .false.
+ logical :: iprflow = .false.
+ logical :: ipakcb = .false.
+ logical :: ts_filerecord = .false.
+ logical :: ts6 = .false.
+ logical :: filein = .false.
+ logical :: ts6_filename = .false.
+ logical :: obs_filerecord = .false.
+ logical :: obs6 = .false.
+ logical :: obs6_filename = .false.
+ logical :: inewton = .false.
+ logical :: maxbound = .false.
+ logical :: cellid = .false.
+ logical :: head = .false.
+ logical :: auxvar = .false.
+ logical :: boundname = .false.
+ end type GwfChdParamFoundType
+
+ logical :: gwf_chd_multi_package = .true.
+
+ character(len=LENVARNAME) :: gwf_chd_aux_sfac_param = 'HEAD'
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_auxiliary = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'AUXILIARY', & ! tag name
+ 'AUXILIARY', & ! fortran variable
+ 'STRING', & ! type
+ 'NAUX', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_auxmultname = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'AUXMULTNAME', & ! tag name
+ 'AUXMULTNAME', & ! fortran variable
+ 'STRING', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_boundnames = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'BOUNDNAMES', & ! tag name
+ 'BOUNDNAMES', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_iprpak = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'PRINT_INPUT', & ! tag name
+ 'IPRPAK', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_iprflow = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'PRINT_FLOWS', & ! tag name
+ 'IPRFLOW', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_ipakcb = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'SAVE_FLOWS', & ! tag name
+ 'IPAKCB', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_ts_filerecord = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'TS_FILERECORD', & ! tag name
+ 'TS_FILERECORD', & ! fortran variable
+ 'RECORD TS6 FILEIN TS6_FILENAME', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_ts6 = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'TS6', & ! tag name
+ 'TS6', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_filein = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'FILEIN', & ! tag name
+ 'FILEIN', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_ts6_filename = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'TS6_FILENAME', & ! tag name
+ 'TS6_FILENAME', & ! fortran variable
+ 'STRING', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .true., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_obs_filerecord = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'OBS_FILERECORD', & ! tag name
+ 'OBS_FILERECORD', & ! fortran variable
+ 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_obs6 = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'OBS6', & ! tag name
+ 'OBS6', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_obs6_filename = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'OBS6_FILENAME', & ! tag name
+ 'OBS6_FILENAME', & ! fortran variable
+ 'STRING', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .true., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_inewton = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'OPTIONS', & ! block
+ 'DEV_NO_NEWTON', & ! tag name
+ 'INEWTON', & ! fortran variable
+ 'KEYWORD', & ! type
+ '', & ! shape
+ .false., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_maxbound = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'DIMENSIONS', & ! block
+ 'MAXBOUND', & ! tag name
+ 'MAXBOUND', & ! fortran variable
+ 'INTEGER', & ! type
+ '', & ! shape
+ .true., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_cellid = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'PERIOD', & ! block
+ 'CELLID', & ! tag name
+ 'CELLID', & ! fortran variable
+ 'INTEGER1D', & ! type
+ 'NCELLDIM', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_head = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'PERIOD', & ! block
+ 'HEAD', & ! tag name
+ 'HEAD', & ! fortran variable
+ 'DOUBLE', & ! type
+ '', & ! shape
+ .true., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .true. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_auxvar = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'PERIOD', & ! block
+ 'AUX', & ! tag name
+ 'AUXVAR', & ! fortran variable
+ 'DOUBLE1D', & ! type
+ 'NAUX', & ! shape
+ .false., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .true. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_boundname = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'PERIOD', & ! block
+ 'BOUNDNAME', & ! tag name
+ 'BOUNDNAME', & ! fortran variable
+ 'STRING', & ! type
+ '', & ! shape
+ .false., & ! required
+ .true., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwf_chd_param_definitions(*) = &
+ [ &
+ gwfchd_auxiliary, &
+ gwfchd_auxmultname, &
+ gwfchd_boundnames, &
+ gwfchd_iprpak, &
+ gwfchd_iprflow, &
+ gwfchd_ipakcb, &
+ gwfchd_ts_filerecord, &
+ gwfchd_ts6, &
+ gwfchd_filein, &
+ gwfchd_ts6_filename, &
+ gwfchd_obs_filerecord, &
+ gwfchd_obs6, &
+ gwfchd_obs6_filename, &
+ gwfchd_inewton, &
+ gwfchd_maxbound, &
+ gwfchd_cellid, &
+ gwfchd_head, &
+ gwfchd_auxvar, &
+ gwfchd_boundname &
+ ]
+
+ type(InputParamDefinitionType), parameter :: &
+ gwfchd_spd = InputParamDefinitionType &
+ ( &
+ 'GWF', & ! component
+ 'CHD', & ! subcomponent
+ 'PERIOD', & ! block
+ 'STRESS_PERIOD_DATA', & ! tag name
+ 'SPD', & ! fortran variable
+ 'RECARRAY CELLID HEAD AUX BOUNDNAME', & ! type
+ 'MAXBOUND', & ! shape
+ .true., & ! required
+ .false., & ! multi-record
+ .false., & ! preserve case
+ .false., & ! layered
+ .false. & ! timeseries
+ )
+
+ type(InputParamDefinitionType), parameter :: &
+ gwf_chd_aggregate_definitions(*) = &
+ [ &
+ gwfchd_spd &
+ ]
+
+ type(InputBlockDefinitionType), parameter :: &
+ gwf_chd_block_definitions(*) = &
+ [ &
+ InputBlockDefinitionType( &
+ 'OPTIONS', & ! blockname
+ .false., & ! required
+ .false., & ! aggregate
+ .false. & ! block_variable
+ ), &
+ InputBlockDefinitionType( &
+ 'DIMENSIONS', & ! blockname
+ .true., & ! required
+ .false., & ! aggregate
+ .false. & ! block_variable
+ ), &
+ InputBlockDefinitionType( &
+ 'PERIOD', & ! blockname
+ .true., & ! required
+ .true., & ! aggregate
+ .true. & ! block_variable
+ ) &
+ ]
+
+end module GwfChdInputModule
diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90
index 0d3e1d334c7..1380a9503b5 100644
--- a/src/Model/GroundWaterFlow/gwf3dis8.f90
+++ b/src/Model/GroundWaterFlow/gwf3dis8.f90
@@ -84,22 +84,16 @@ subroutine dis_cr(dis, name_model, input_mempath, inunit, iout)
integer(I4B), intent(in) :: iout
! -- locals
type(GwfDisType), pointer :: disnew
- logical(LGP) :: found_fname
character(len=*), parameter :: fmtheader = &
"(1X, /1X, 'DIS -- STRUCTURED GRID DISCRETIZATION PACKAGE,', &
&' VERSION 2 : 3/27/2014 - INPUT READ FROM MEMPATH: ', A, /)"
! ------------------------------------------------------------------------------
allocate (disnew)
dis => disnew
- call disnew%allocate_scalars(name_model)
- dis%input_mempath = input_mempath
+ call disnew%allocate_scalars(name_model, input_mempath)
dis%inunit = inunit
dis%iout = iout
!
- ! -- set name of input file
- call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, &
- found_fname)
- !
! -- If dis enabled
if (inunit > 0) then
!
@@ -872,7 +866,7 @@ function get_nodenumber_idx3(this, k, i, j, icheck) &
return
end function get_nodenumber_idx3
- subroutine allocate_scalars(this, name_model)
+ subroutine allocate_scalars(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalars
! ******************************************************************************
@@ -883,10 +877,11 @@ subroutine allocate_scalars(this, name_model)
! -- dummy
class(GwfDisType) :: this
character(len=*), intent(in) :: name_model
+ character(len=*), intent(in) :: input_mempath
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
- call this%DisBaseType%allocate_scalars(name_model)
+ call this%DisBaseType%allocate_scalars(name_model, input_mempath)
!
! -- Allocate
call mem_allocate(this%nlay, 'NLAY', this%memoryPath)
diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90
index 404ea357340..d33bf55eb2a 100644
--- a/src/Model/GroundWaterFlow/gwf3disu8.f90
+++ b/src/Model/GroundWaterFlow/gwf3disu8.f90
@@ -100,7 +100,6 @@ subroutine disu_cr(dis, name_model, input_mempath, inunit, iout)
integer(I4B), intent(in) :: iout
! -- local
type(GwfDisuType), pointer :: disnew
- logical(LGP) :: found_fname
character(len=*), parameter :: fmtheader = &
"(1X, /1X, 'DISU -- UNSTRUCTURED GRID DISCRETIZATION PACKAGE,', &
&' VERSION 2 : 3/27/2014 - INPUT READ FROM MEMPATH: ', A, //)"
@@ -111,15 +110,10 @@ subroutine disu_cr(dis, name_model, input_mempath, inunit, iout)
dis => disnew
!
! -- Allocate scalars and assign data
- call dis%allocate_scalars(name_model)
- dis%input_mempath = input_mempath
+ call dis%allocate_scalars(name_model, input_mempath)
dis%inunit = inunit
dis%iout = iout
!
- ! -- set name of input file
- call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, &
- found_fname)
- !
! -- If disu is enabled
if (inunit > 0) then
!
@@ -1311,7 +1305,7 @@ subroutine get_dis_type(this, dis_type)
end subroutine get_dis_type
- subroutine allocate_scalars(this, name_model)
+ subroutine allocate_scalars(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalar variables in this class
! ******************************************************************************
@@ -1323,11 +1317,12 @@ subroutine allocate_scalars(this, name_model)
! -- dummy
class(GwfDisuType) :: this
character(len=*), intent(in) :: name_model
+ character(len=*), intent(in) :: input_mempath
! -- local
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
- call this%DisBaseType%allocate_scalars(name_model)
+ call this%DisBaseType%allocate_scalars(name_model, input_mempath)
!
! -- Allocate variables for DISU
call mem_allocate(this%njausr, 'NJAUSR', this%memoryPath)
diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90
index 25b1d7d1758..06d07c8d78f 100644
--- a/src/Model/GroundWaterFlow/gwf3disv8.f90
+++ b/src/Model/GroundWaterFlow/gwf3disv8.f90
@@ -88,22 +88,16 @@ subroutine disv_cr(dis, name_model, input_mempath, inunit, iout)
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
type(GwfDisvType), pointer :: disnew
- logical(LGP) :: found_fname
character(len=*), parameter :: fmtheader = &
"(1X, /1X, 'DISV -- VERTEX GRID DISCRETIZATION PACKAGE,', &
&' VERSION 1 : 12/23/2015 - INPUT READ FROM MEMPATH: ', A, //)"
! ------------------------------------------------------------------------------
allocate (disnew)
dis => disnew
- call disnew%allocate_scalars(name_model)
- dis%input_mempath = input_mempath
+ call disnew%allocate_scalars(name_model, input_mempath)
dis%inunit = inunit
dis%iout = iout
!
- ! -- set name of input file
- call mem_set_value(dis%input_fname, 'INPUT_FNAME', dis%input_mempath, &
- found_fname)
- !
! -- If disv enabled
if (inunit > 0) then
!
@@ -1240,7 +1234,7 @@ subroutine get_dis_type(this, dis_type)
end subroutine get_dis_type
- subroutine allocate_scalars(this, name_model)
+ subroutine allocate_scalars(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalars
! ******************************************************************************
@@ -1252,10 +1246,11 @@ subroutine allocate_scalars(this, name_model)
! -- dummy
class(GwfDisvType) :: this
character(len=*), intent(in) :: name_model
+ character(len=*), intent(in) :: input_mempath
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
- call this%DisBaseType%allocate_scalars(name_model)
+ call this%DisBaseType%allocate_scalars(name_model, input_mempath)
!
! -- Allocate
call mem_allocate(this%nlay, 'NLAY', this%memoryPath)
diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90
index 56358e2e9b2..8aad85144af 100644
--- a/src/Model/GroundWaterFlow/gwf3npf8.f90
+++ b/src/Model/GroundWaterFlow/gwf3npf8.f90
@@ -166,7 +166,6 @@ subroutine npf_cr(npfobj, name_model, input_mempath, inunit, iout)
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
! -- locals
- logical(LGP) :: found_fname
! -- formats
character(len=*), parameter :: fmtheader = &
"(1x, /1x, 'NPF -- NODE PROPERTY FLOW PACKAGE, VERSION 1, 3/30/2015', &
@@ -177,20 +176,15 @@ subroutine npf_cr(npfobj, name_model, input_mempath, inunit, iout)
allocate (npfobj)
!
! -- create name and memory path
- call npfobj%set_names(1, name_model, 'NPF', 'NPF')
+ call npfobj%set_names(1, name_model, 'NPF', 'NPF', input_mempath)
!
! -- Allocate scalars
call npfobj%allocate_scalars()
!
! -- Set variables
- npfobj%input_mempath = input_mempath
npfobj%inunit = inunit
npfobj%iout = iout
!
- ! -- set name of input file
- call mem_set_value(npfobj%input_fname, 'INPUT_FNAME', npfobj%input_mempath, &
- found_fname)
- !
! -- check if npf is enabled
if (inunit > 0) then
!
@@ -1481,16 +1475,14 @@ subroutine source_options(this)
use MemoryManagerExtModule, only: mem_set_value
use CharacterStringModule, only: CharacterStringType
use GwfNpfInputModule, only: GwfNpfParamFoundType
+ use IdmLoadModule, only: filein_fname
! -- dummy
class(GwfNpftype) :: this
! -- locals
character(len=LENVARNAME), dimension(3) :: cellavg_method = &
&[character(len=LENVARNAME) :: 'LOGARITHMIC', 'AMT-LMK', 'AMT-HMK']
type(GwfNpfParamFoundType) :: found
- type(CharacterStringType), dimension(:), pointer, &
- contiguous :: tvk6_fnames
character(len=LINELENGTH) :: tvk6_filename
- integer(I4B) :: tvk6_isize, n
! ------------------------------------------------------------------------------
!
! -- update defaults with idm sourced values
@@ -1542,24 +1534,11 @@ subroutine source_options(this)
this%iasym = 0
end if
!
- call get_isize('TVK6_FILENAME', this%input_mempath, tvk6_isize)
- !
- if (tvk6_isize > 0) then
- !
- if (tvk6_isize /= 1) then
- errmsg = 'Multiple TVK6 keywords detected in OPTIONS block.'// &
- ' Only one TVK6 entry allowed.'
- call store_error(errmsg)
- call store_error_filename(this%input_fname)
- end if
- !
- call mem_setptr(tvk6_fnames, 'TVK6_FILENAME', this%input_mempath)
- !
- do n = 1, tvk6_isize
- tvk6_filename = tvk6_fnames(n)
- call openfile(this%intvk, this%iout, tvk6_filename, 'TVK')
- call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout)
- end do
+ ! -- enforce 0 or 1 TVK6_FILENAME entries in option block
+ if (filein_fname(tvk6_filename, 'TVK6_FILENAME', this%input_mempath, &
+ this%input_fname)) then
+ call openfile(this%intvk, this%iout, tvk6_filename, 'TVK')
+ call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout)
end if
!
! -- log options
diff --git a/src/Model/GroundWaterTransport/gwt1dsp1.f90 b/src/Model/GroundWaterTransport/gwt1dsp1.f90
index 50881f867c7..acf48a88052 100644
--- a/src/Model/GroundWaterTransport/gwt1dsp1.f90
+++ b/src/Model/GroundWaterTransport/gwt1dsp1.f90
@@ -90,7 +90,6 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
integer(I4B), intent(in) :: iout
type(GwtFmiType), intent(in), target :: fmi
! -- locals
- logical(LGP) :: found_fname
! -- formats
character(len=*), parameter :: fmtdsp = &
"(1x,/1x,'DSP-- DISPERSION PACKAGE, VERSION 1, 1/24/2018', &
@@ -101,21 +100,16 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
allocate (dspobj)
!
! -- create name and memory path
- call dspobj%set_names(1, name_model, 'DSP', 'DSP')
+ call dspobj%set_names(1, name_model, 'DSP', 'DSP', input_mempath)
!
! -- Allocate scalars
call dspobj%allocate_scalars()
!
! -- Set variables
- dspobj%input_mempath = input_mempath
dspobj%inunit = inunit
dspobj%iout = iout
dspobj%fmi => fmi
!
- ! -- set name of input file
- call mem_set_value(dspobj%input_fname, 'INPUT_FNAME', dspobj%input_mempath, &
- found_fname)
- !
if (dspobj%inunit > 0) then
!
! -- Print a message identifying the dispersion package.
diff --git a/src/Model/ModelUtilities/BoundaryPackageExt.f90 b/src/Model/ModelUtilities/BoundaryPackageExt.f90
new file mode 100644
index 00000000000..4451669250d
--- /dev/null
+++ b/src/Model/ModelUtilities/BoundaryPackageExt.f90
@@ -0,0 +1,767 @@
+!> @brief This module contains the extended boundary package
+!!
+!! This module contains the extended boundary type that itself
+!! should be extended by model boundary packages that have been
+!! updated to source static and dynamic input data from the
+!! input context.
+!!
+!<
+module BndExtModule
+
+ use KindModule, only: DP, LGP, I4B
+ use ConstantsModule, only: LENMEMPATH, LENBOUNDNAME, LENAUXNAME, LINELENGTH
+ use ObsModule, only: obs_cr
+ use SimVariablesModule, only: errmsg
+ use SimModule, only: store_error, count_errors, store_error_filename
+ use BndModule, only: BndType
+
+ implicit none
+
+ private
+ public :: BndExtType
+
+ !> @ brief BndExtType
+ !!
+ !! Generic extended boundary package type. This derived type can be
+ !! overriden to define concrete boundary package types that source
+ !! all input from the input context.
+ !<
+ type, extends(BndType) :: BndExtType
+ ! -- characters
+ ! -- scalars
+ integer(I4B), pointer :: iper
+ ! -- arrays
+ integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null()
+ contains
+ procedure :: bnd_df => bndext_df
+ procedure :: bnd_rp => bndext_rp
+ procedure :: bnd_da => bndext_da
+ procedure :: allocate_scalars => bndext_allocate_scalars
+ procedure :: allocate_arrays => bndext_allocate_arrays
+ procedure :: source_options
+ procedure :: source_dimensions
+ procedure :: log_options
+ procedure :: nodelist_update
+ procedure :: check_cellid
+ procedure :: write_list
+ procedure :: bound_value
+ end type BndExtType
+
+contains
+
+ !> @ brief Define boundary package options and dimensions
+ !!
+ !! Define base boundary package options and dimensions for
+ !! a model boundary package.
+ !!
+ !<
+ subroutine bndext_df(this, neq, dis)
+ ! -- modules
+ use BaseDisModule, only: DisBaseType
+ use TimeArraySeriesManagerModule, only: TimeArraySeriesManagerType, &
+ tasmanager_cr
+ use TimeSeriesManagerModule, only: TimeSeriesManagerType, tsmanager_cr
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ integer(I4B), intent(inout) :: neq !< number of equations
+ class(DisBaseType), pointer :: dis !< discretization object
+ !
+ ! -- set pointer to dis object for the model
+ this%dis => dis
+ !
+ ! -- Create time series managers
+ ! -- Not in use by this type but BndType uses and deallocates
+ call tsmanager_cr(this%TsManager, this%iout)
+ call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout)
+ !
+ ! -- create obs package
+ call obs_cr(this%obs, this%inobspkg)
+ !
+ ! -- Write information to model list file
+ write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%input_mempath
+1 format(1X, /1X, a, ' -- ', a, ' PACKAGE, VERSION 8, 2/22/2014', &
+ ' INPUT READ FROM MEMPATH: ', a)
+ !
+ ! -- source options
+ call this%source_options()
+ !
+ ! -- Define time series managers
+ call this%tsmanager%tsmanager_df()
+ call this%tasmanager%tasmanager_df()
+ !
+ ! -- source dimensions
+ call this%source_dimensions()
+ !
+ ! -- update package moffset for packages that add rows
+ if (this%npakeq > 0) then
+ this%ioffset = neq - this%dis%nodes
+ end if
+ !
+ ! -- update neq
+ neq = neq + this%npakeq
+ !
+ ! -- Store information needed for observations
+ if (this%bnd_obs_supported()) then
+ call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
+ call this%bnd_df_obs()
+ end if
+ !
+ ! -- return
+ return
+ end subroutine bndext_df
+
+ subroutine bndext_rp(this)
+ ! -- modules
+ use TdisModule, only: kper
+ use MemoryManagerModule, only: mem_deallocate, mem_reallocate
+ use MemoryManagerExtModule, only: mem_set_value
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ ! -- local variables
+ logical(LGP) :: found
+ integer(I4B) :: n
+ !
+ if (this%iper /= kper) return
+ !
+ ! -- copy nbound from input context
+ call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, &
+ found)
+ !
+ ! -- convert cellids to node numbers
+ call this%nodelist_update()
+ !
+ ! -- update boundname string list
+ if (this%inamedbound /= 0) then
+ do n = 1, size(this%boundname_cst)
+ this%boundname(n) = this%boundname_cst(n)
+ end do
+ end if
+ !
+ ! -- return
+ return
+ end subroutine bndext_rp
+
+ !> @ brief Deallocate package memory
+ !<
+ subroutine bndext_da(this)
+ ! -- modules
+ use MemoryManagerModule, only: mem_deallocate, mem_setptr
+ ! -- dummy variables
+ class(BndExtType) :: this !< BndExtType object
+ !
+ ! -- deallocate checkin paths
+ call mem_deallocate(this%cellid, 'CELLID', this%memoryPath)
+ call mem_deallocate(this%boundname_cst, 'BOUNDNAME_IDM', this%memoryPath)
+ call mem_deallocate(this%auxvar, 'AUXVAR_IDM', this%memoryPath)
+ !
+ ! -- reassign pointers for base class _da
+ call mem_setptr(this%boundname_cst, 'BOUNDNAME_CST', this%memoryPath)
+ call mem_setptr(this%auxvar, 'AUXVAR', this%memoryPath)
+ !
+ ! -- scalars
+ nullify (this%iper)
+ !
+ ! -- deallocate
+ call this%BndType%bnd_da()
+ !
+ ! -- return
+ return
+ end subroutine bndext_da
+
+ !> @ brief Allocate package scalars
+ !!
+ !! Allocate and initialize base boundary package scalars. This method
+ !! only needs to be overridden if additional scalars are defined
+ !! for a specific package.
+ !!
+ !<
+ subroutine bndext_allocate_scalars(this)
+ ! -- modules
+ use MemoryManagerModule, only: mem_setptr
+ use MemoryManagerExtModule, only: mem_set_value
+ use MemoryHelperModule, only: create_mem_path
+ use SimVariablesModule, only: idm_context
+ ! -- dummy variables
+ class(BndExtType) :: this !< BndExtType object
+ ! -- local variables
+ character(len=LENMEMPATH) :: input_mempath
+ !
+ ! -- set memory path
+ input_mempath = create_mem_path(this%name_model, this%packName, idm_context)
+ !
+ ! -- allocate base BndType scalars
+ call this%BndType%allocate_scalars()
+ !
+ ! -- set pointers to period input data scalars
+ call mem_setptr(this%iper, 'IPER', input_mempath)
+ !
+ ! -- return
+ return
+ end subroutine bndext_allocate_scalars
+
+ !> @ brief Allocate package arrays
+ !!
+ !! Allocate and initialize base boundary package arrays. This method
+ !! only needs to be overridden if additional arrays are defined
+ !! for a specific package.
+ !!
+ !<
+ subroutine bndext_allocate_arrays(this, nodelist, auxvar)
+ ! -- modules
+ use MemoryManagerModule, only: mem_deallocate, mem_setptr, mem_checkin
+ ! -- dummy variables
+ class(BndExtType) :: this !< BndExtType object
+ ! -- local variables
+ integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist !< package nodelist
+ real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar !< package aux variable array
+ !
+ ! -- allocate base BndType arrays
+ call this%BndType%allocate_arrays(nodelist, auxvar)
+ !
+ ! -- set input context pointers
+ call mem_setptr(this%cellid, 'CELLID', this%input_mempath)
+ call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%input_mempath)
+ !
+ ! -- checkin input context pointers
+ call mem_checkin(this%cellid, 'CELLID', this%memoryPath, &
+ 'CELLID', this%input_mempath)
+ call mem_checkin(this%boundname_cst, LENBOUNDNAME, 'BOUNDNAME_IDM', &
+ this%memoryPath, 'BOUNDNAME', this%input_mempath)
+ !
+ if (present(auxvar)) then
+ ! no-op
+ else
+ ! -- set auxvar input context pointer
+ call mem_setptr(this%auxvar, 'AUXVAR', this%input_mempath)
+ !
+ ! -- checkin auxvar input context pointer
+ call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, &
+ 'AUXVAR', this%input_mempath)
+ end if
+ !
+ ! -- return
+ return
+ end subroutine bndext_allocate_arrays
+
+ !> @ brief Source package options from input context
+ !<
+ subroutine source_options(this)
+ ! -- modules
+ use MemoryManagerModule, only: mem_reallocate, mem_setptr !, get_isize
+ use MemoryManagerExtModule, only: mem_set_value
+ use InputOutputModule, only: GetUnit, openfile
+ use CharacterStringModule, only: CharacterStringType
+ use IdmLoadModule, only: filein_fname
+ use IdmGwfDfnSelectorModule, only: GwfParamFoundType
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ ! -- local variables
+ character(len=LENAUXNAME) :: sfacauxname
+ integer(I4B) :: n
+ type(GwfParamFoundType) :: found
+ logical :: found_naux
+ !
+ ! -- update defaults with idm sourced values
+ call mem_set_value(this%naux, 'NAUX', this%input_mempath, found_naux)
+ call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb)
+ call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak)
+ call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow)
+ call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, &
+ found%boundnames)
+ call mem_set_value(sfacauxname, 'AUXMULTNAME', this%input_mempath, &
+ found%auxmultname)
+ call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton)
+ !
+ ! -- log found options
+ call this%log_options(found, sfacauxname)
+ !
+ ! -- reallocate aux arrays if aux variables provided
+ if (found_naux .and. this%naux > 0) then
+ call mem_reallocate(this%auxname, LENAUXNAME, this%naux, &
+ 'AUXNAME', this%memoryPath)
+ call mem_reallocate(this%auxname_cst, LENAUXNAME, this%naux, &
+ 'AUXNAME_CST', this%memoryPath)
+ call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, &
+ found%auxiliary)
+ !
+ do n = 1, this%naux
+ this%auxname(n) = this%auxname_cst(n)
+ end do
+ end if
+ !
+ ! -- save flows option active
+ if (found%ipakcb) this%ipakcb = -1
+ !
+ ! -- auxmultname provided
+ if (found%auxmultname) this%iauxmultcol = -1
+ !
+ !
+ ! -- enforce 0 or 1 OBS6_FILENAME entries in option block
+ if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', &
+ this%input_mempath, this%input_fname)) then
+ this%obs%active = .true.
+ this%obs%inUnitObs = GetUnit()
+ call openfile(this%obs%inUnitObs, this%iout, this%obs%inputFilename, 'OBS')
+ end if
+ !
+ ! -- no newton specified
+ if (found%inewton) this%inewton = 0
+ !
+ ! -- AUXMULTNAME was specified, so find column of auxvar that will be multiplier
+ if (this%iauxmultcol < 0) then
+ !
+ ! -- Error if no aux variable specified
+ if (this%naux == 0) then
+ write (errmsg, '(a,2(1x,a))') &
+ 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
+ 'but no AUX variables specified.'
+ call store_error(errmsg)
+ end if
+ !
+ ! -- Assign mult column
+ this%iauxmultcol = 0
+ do n = 1, this%naux
+ if (sfacauxname == this%auxname(n)) then
+ this%iauxmultcol = n
+ exit
+ end if
+ end do
+ !
+ ! -- Error if aux variable cannot be found
+ if (this%iauxmultcol == 0) then
+ write (errmsg, '(a,2(1x,a))') &
+ 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
+ 'but no AUX variable found with this name.'
+ call store_error(errmsg)
+ end if
+ end if
+ !
+ ! -- terminate if errors were detected
+ if (count_errors() > 0) then
+ call store_error_filename(this%input_fname)
+ end if
+ !
+ ! -- return
+ return
+ end subroutine source_options
+
+ !> @ brief Log package options
+ !<
+ subroutine log_options(this, found, sfacauxname)
+ ! -- modules
+ use IdmGwfDfnSelectorModule, only: GwfParamFoundType
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ type(GwfParamFoundType), intent(in) :: found
+ character(len=*), intent(in) :: sfacauxname
+ ! -- local variables
+ ! -- format
+ character(len=*), parameter :: fmtflow = &
+ &"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
+ character(len=*), parameter :: fmttas = &
+ &"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
+ character(len=*), parameter :: fmtts = &
+ &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
+ character(len=*), parameter :: fmtnme = &
+ &"(a, i0, a)"
+ !
+ ! -- log found options
+ write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
+ //' OPTIONS'
+ !
+ if (found%ipakcb) then
+ write (this%iout, fmtflow)
+ end if
+ !
+ if (found%iprpak) then
+ write (this%iout, '(4x,a)') &
+ 'LISTS OF '//trim(adjustl(this%text))//' CELLS WILL BE PRINTED.'
+ end if
+ !
+ if (found%iprflow) then
+ write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
+ ' FLOWS WILL BE PRINTED TO LISTING FILE.'
+ end if
+ !
+ if (found%boundnames) then
+ write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
+ ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
+ end if
+ !
+ if (found%auxmultname) then
+ write (this%iout, '(4x,a,a)') &
+ 'AUXILIARY MULTIPLIER NAME: ', sfacauxname
+ end if
+ !
+ if (found%inewton) then
+ write (this%iout, '(4x,a)') &
+ 'NEWTON-RAPHSON method disabled for unconfined cells'
+ end if
+ !
+ ! -- close logging block
+ write (this%iout, '(1x,a)') &
+ 'END OF '//trim(adjustl(this%text))//' OPTIONS'
+ !
+ ! -- return
+ return
+ end subroutine log_options
+
+ !> @ brief Source package dimensions from input context
+ !<
+ subroutine source_dimensions(this)
+ use MemoryManagerExtModule, only: mem_set_value
+ use IdmGwfDfnSelectorModule, only: GwfParamFoundType
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ ! -- local variables
+ type(GwfParamFoundType) :: found
+ !
+ ! -- open dimensions logging block
+ write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
+ ' DIMENSIONS'
+ !
+ ! -- update defaults with idm sourced values
+ call mem_set_value(this%maxbound, 'MAXBOUND', this%input_mempath, &
+ found%maxbound)
+ !
+ write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound
+ !
+ ! -- close logging block
+ write (this%iout, '(1x,a)') &
+ 'END OF '//trim(adjustl(this%text))//' DIMENSIONS'
+ !
+ ! -- verify dimensions were set
+ if (this%maxbound <= 0) then
+ write (errmsg, '(a)') 'MAXBOUND must be an integer greater than zero.'
+ call store_error(errmsg)
+ call store_error_filename(this%input_fname)
+ end if
+ !
+ ! -- Call define_listlabel to construct the list label that is written
+ ! when PRINT_INPUT option is used.
+ call this%define_listlabel()
+ !
+ ! -- return
+ return
+ end subroutine source_dimensions
+
+ !> @ brief Update package nodelist
+ !!
+ !! Convert period updated cellids to node numbers.
+ !!
+ !<
+ subroutine nodelist_update(this)
+ ! -- modules
+ use SimVariablesModule, only: errmsg
+ use InputOutputModule, only: get_node
+ ! -- dummy
+ class(BndExtType) :: this !< BndExtType object
+ ! -- local
+ integer(I4B), dimension(:), pointer :: cellid
+ integer(I4B) :: n, nodeu, noder
+ character(len=LINELENGTH) :: nodestr
+ !
+ ! -- update nodelist
+ do n = 1, this%nbound
+ !
+ ! -- set cellid
+ cellid => this%cellid(:, n)
+ !
+ ! -- ensure cellid is valid, store an error otherwise
+ call this%check_cellid(n, cellid, this%dis%mshape, this%dis%ndim)
+ !
+ ! -- Determine user node number
+ if (this%dis%ndim == 1) then
+ nodeu = cellid(1)
+ elseif (this%dis%ndim == 2) then
+ nodeu = get_node(cellid(1), 1, cellid(2), &
+ this%dis%mshape(1), 1, &
+ this%dis%mshape(2))
+ else
+ nodeu = get_node(cellid(1), cellid(2), cellid(3), &
+ this%dis%mshape(1), &
+ this%dis%mshape(2), &
+ this%dis%mshape(3))
+ end if
+ !
+ ! -- update the nodelist
+ if (this%dis%nodes < this%dis%nodesuser) then
+ ! -- convert user to reduced node numbers
+ noder = this%dis%get_nodenumber(nodeu, 0)
+ if (noder <= 0) then
+ call this%dis%nodeu_to_string(nodeu, nodestr)
+ write (errmsg, *) &
+ ' Cell is outside active grid domain: '// &
+ trim(adjustl(nodestr))
+ call store_error(errmsg)
+ end if
+ this%nodelist(n) = noder
+ else
+ this%nodelist(n) = nodeu
+ end if
+ end do
+ !
+ ! -- exit if errors were found
+ if (count_errors() > 0) then
+ write (errmsg, *) count_errors(), ' errors encountered.'
+ call store_error(errmsg)
+ call store_error_filename(this%input_fname)
+ end if
+ !
+ ! -- return
+ return
+ end subroutine nodelist_update
+
+ !> @ brief Check for valid cellid
+ !<
+ subroutine check_cellid(this, ii, cellid, mshape, ndim)
+ ! -- modules
+ use SimVariablesModule, only: errmsg
+ use InputOutputModule, only: get_node
+ ! -- dummy
+ class(BndExtType) :: this !< BndExtType object
+ ! -- local
+ integer(I4B), intent(in) :: ii
+ integer(I4B), dimension(:), intent(in) :: cellid !< cellid
+ integer(I4B), dimension(:), intent(in) :: mshape !< model shape
+ integer(I4B), intent(in) :: ndim !< size of mshape
+ character(len=20) :: cellstr, mshstr
+ character(len=*), parameter :: fmterr = &
+ "('List entry ',i0,' contains cellid ',a,' but this cellid is invalid &
+ &for model with shape ', a)"
+ character(len=*), parameter :: fmtndim1 = &
+ "('(',i0,')')"
+ character(len=*), parameter :: fmtndim2 = &
+ "('(',i0,',',i0,')')"
+ character(len=*), parameter :: fmtndim3 = &
+ "('(',i0,',',i0,',',i0,')')"
+ select case (ndim)
+ case (1)
+ !
+ if (cellid(1) < 1 .or. cellid(1) > mshape(1)) then
+ write (cellstr, fmtndim1) cellid(1)
+ write (mshstr, fmtndim1) mshape(1)
+ write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
+ call store_error(errmsg)
+ end if
+ !
+ case (2)
+ !
+ if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. &
+ cellid(2) < 1 .or. cellid(2) > mshape(2)) then
+ write (cellstr, fmtndim2) cellid(1), cellid(2)
+ write (mshstr, fmtndim2) mshape(1), mshape(2)
+ write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
+ call store_error(errmsg)
+ end if
+ !
+ case (3)
+ !
+ if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. &
+ cellid(2) < 1 .or. cellid(2) > mshape(2) .or. &
+ cellid(3) < 1 .or. cellid(3) > mshape(3)) then
+ write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3)
+ write (mshstr, fmtndim3) mshape(1), mshape(2), mshape(3)
+ write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
+ call store_error(errmsg)
+ end if
+ !
+ case default
+ end select
+ !
+ ! -- return
+ return
+ end subroutine check_cellid
+
+ !> @ brief Log package list input
+ !!
+ !! Log period list based input. This routine requires a package specific
+ !! bound_value() routine to report accurate bound values.
+ !!
+ !<
+ subroutine write_list(this)
+ ! -- modules
+ use ConstantsModule, only: LINELENGTH, LENBOUNDNAME, &
+ TABLEFT, TABCENTER, DZERO
+ use InputOutputModule, only: ulstlb, get_ijk
+ use TableModule, only: TableType, table_cr
+ ! -- dummy
+ class(BndExtType) :: this !< BndExtType object
+ ! -- local
+ character(len=10) :: cpos
+ character(len=LINELENGTH) :: tag
+ character(len=LINELENGTH), allocatable, dimension(:) :: words
+ integer(I4B) :: ntabrows
+ integer(I4B) :: ntabcols
+ integer(I4B) :: ipos
+ integer(I4B) :: ii, jj, i, j, k, nod
+ integer(I4B) :: ldim
+ integer(I4B) :: naux
+ type(TableType), pointer :: inputtab => null()
+ ! -- formats
+ character(len=LINELENGTH) :: fmtlstbn
+! ------------------------------------------------------------------------------
+ !
+ ! -- Determine sizes
+ ldim = this%ncolbnd
+ naux = size(this%auxvar, 1)
+ !
+ ! -- dimension table
+ ntabrows = this%nbound
+ !
+ ! -- start building format statement to parse this%label, which
+ ! contains the column headers (except for boundname and auxnames)
+ ipos = index(this%listlabel, 'NO.')
+ if (ipos /= 0) then
+ write (cpos, '(i10)') ipos + 3
+ fmtlstbn = '(a'//trim(adjustl(cpos))
+ else
+ fmtlstbn = '(a7'
+ end if
+ ! -- sequence number, layer, row, and column.
+ if (size(this%dis%mshape) == 3) then
+ ntabcols = 4
+ fmtlstbn = trim(fmtlstbn)//',a7,a7,a7'
+ !
+ ! -- sequence number, layer, and cell2d.
+ else if (size(this%dis%mshape) == 2) then
+ ntabcols = 3
+ fmtlstbn = trim(fmtlstbn)//',a7,a7'
+ !
+ ! -- sequence number and node.
+ else
+ ntabcols = 2
+ fmtlstbn = trim(fmtlstbn)//',a7'
+ end if
+ !
+ ! -- Add fields for non-optional real values
+ ntabcols = ntabcols + ldim
+ do i = 1, ldim
+ fmtlstbn = trim(fmtlstbn)//',a16'
+ end do
+ !
+ ! -- Add field for boundary name
+ if (this%inamedbound == 1) then
+ ntabcols = ntabcols + 1
+ fmtlstbn = trim(fmtlstbn)//',a16'
+ end if
+ !
+ ! -- Add fields for auxiliary variables
+ ntabcols = ntabcols + naux
+ do i = 1, naux
+ fmtlstbn = trim(fmtlstbn)//',a16'
+ end do
+ fmtlstbn = trim(fmtlstbn)//')'
+ !
+ ! -- allocate words
+ allocate (words(ntabcols))
+ !
+ ! -- parse this%listlabel into words
+ read (this%listlabel, fmtlstbn) (words(i), i=1, ntabcols)
+ !
+ ! -- initialize the input table object
+ call table_cr(inputtab, ' ', ' ')
+ call inputtab%table_df(ntabrows, ntabcols, this%iout)
+ !
+ ! -- add the columns
+ ipos = 1
+ call inputtab%initialize_column(words(ipos), 10, alignment=TABCENTER)
+ !
+ ! -- discretization
+ do i = 1, size(this%dis%mshape)
+ ipos = ipos + 1
+ call inputtab%initialize_column(words(ipos), 7, alignment=TABCENTER)
+ end do
+ !
+ ! -- non-optional variables
+ do i = 1, ldim
+ ipos = ipos + 1
+ call inputtab%initialize_column(words(ipos), 16, alignment=TABCENTER)
+ end do
+ !
+ ! -- boundname
+ if (this%inamedbound == 1) then
+ ipos = ipos + 1
+ tag = 'BOUNDNAME'
+ call inputtab%initialize_column(tag, LENBOUNDNAME, alignment=TABLEFT)
+ end if
+ !
+ ! -- aux variables
+ do i = 1, naux
+ call inputtab%initialize_column(this%auxname(i), 16, alignment=TABCENTER)
+ end do
+ !
+ ! -- Write the table
+ do ii = 1, this%nbound
+ call inputtab%add_term(ii)
+ !
+ ! -- discretization
+ if (size(this%dis%mshape) == 3) then
+ nod = this%nodelist(ii)
+ call get_ijk(nod, this%dis%mshape(2), this%dis%mshape(3), &
+ this%dis%mshape(1), i, j, k)
+ call inputtab%add_term(k)
+ call inputtab%add_term(i)
+ call inputtab%add_term(j)
+ else if (size(this%dis%mshape) == 2) then
+ nod = this%nodelist(ii)
+ call get_ijk(nod, 1, this%dis%mshape(2), this%dis%mshape(1), i, j, k)
+ call inputtab%add_term(k)
+ call inputtab%add_term(j)
+ else
+ nod = this%nodelist(ii)
+ call inputtab%add_term(nod)
+ end if
+ !
+ ! -- non-optional variables
+ do jj = 1, ldim
+ call inputtab%add_term(this%bound_value(jj, ii))
+ end do
+ !
+ ! -- boundname
+ if (this%inamedbound == 1) then
+ call inputtab%add_term(this%boundname(ii))
+ end if
+ !
+ ! -- aux variables
+ do jj = 1, naux
+ call inputtab%add_term(this%auxvar(jj, ii))
+ end do
+ end do
+ !
+ ! -- deallocate the local variables
+ call inputtab%table_da()
+ deallocate (inputtab)
+ nullify (inputtab)
+ deallocate (words)
+ !
+ ! -- return
+ return
+ end subroutine write_list
+
+ !> @ brief Return a bound value
+ !!
+ !! Return a bound value associated with an ncolbnd index
+ !! and row. This function should be overridden in the
+ !! derived package class.
+ !!
+ !<
+ function bound_value(this, col, row) result(bndval)
+ ! -- modules
+ use ConstantsModule, only: DNODATA
+ ! -- dummy variables
+ class(BndExtType), intent(inout) :: this !< BndExtType object
+ integer(I4B), intent(in) :: col
+ integer(I4B), intent(in) :: row
+ ! -- result
+ real(DP) :: bndval
+ !
+ ! -- override this return value by redefining this
+ ! routine in the derived package.
+ bndval = DNODATA
+ !
+ ! -- return
+ return
+ end function bound_value
+
+end module BndExtModule
diff --git a/src/Model/ModelUtilities/DiscretizationBase.f90 b/src/Model/ModelUtilities/DiscretizationBase.f90
index 03c807dc1fd..ab19fd6afe5 100644
--- a/src/Model/ModelUtilities/DiscretizationBase.f90
+++ b/src/Model/ModelUtilities/DiscretizationBase.f90
@@ -1,6 +1,6 @@
module BaseDisModule
- use KindModule, only: DP, I4B
+ use KindModule, only: DP, I4B, LGP
use ConstantsModule, only: LENMODELNAME, LENAUXNAME, LINELENGTH, &
DZERO, LENMEMPATH, DPIO180
use SmoothingModule, only: sQuadraticSaturation
@@ -24,8 +24,8 @@ module BaseDisModule
type :: DisBaseType
character(len=LENMEMPATH) :: memoryPath !< path for memory allocation
+ character(len=LENMEMPATH) :: input_mempath = '' !< input context mempath
character(len=LENMODELNAME), pointer :: name_model => null() !< name of the model
- character(len=LENMEMPATH), pointer :: input_mempath => null() !< input context mempath
character(len=LINELENGTH), pointer :: input_fname => null() !< input file name
integer(I4B), pointer :: inunit => null() !< unit number for input file
integer(I4B), pointer :: iout => null() !< unit number for output file
@@ -262,7 +262,6 @@ subroutine dis_da(this)
!
! -- Strings
deallocate (this%name_model)
- deallocate (this%input_mempath)
deallocate (this%input_fname)
!
! -- Scalars
@@ -553,7 +552,7 @@ subroutine get_dis_type(this, dis_type)
end subroutine get_dis_type
- subroutine allocate_scalars(this, name_model)
+ subroutine allocate_scalars(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalar variables in this class
! ******************************************************************************
@@ -562,9 +561,12 @@ subroutine allocate_scalars(this, name_model)
! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
+ use MemoryManagerExtModule, only: mem_set_value
! -- dummy
class(DisBaseType) :: this
character(len=*), intent(in) :: name_model
+ character(len=*), intent(in) :: input_mempath
+ logical(LGP) :: found
! -- local
! ------------------------------------------------------------------------------
!
@@ -573,7 +575,6 @@ subroutine allocate_scalars(this, name_model)
!
! -- Allocate
allocate (this%name_model)
- allocate (this%input_mempath)
allocate (this%input_fname)
!
call mem_allocate(this%inunit, 'INUNIT', this%memoryPath)
@@ -592,7 +593,7 @@ subroutine allocate_scalars(this, name_model)
!
! -- Initialize
this%name_model = name_model
- this%input_mempath = ''
+ this%input_mempath = input_mempath
this%input_fname = ''
this%inunit = 0
this%iout = 0
@@ -608,6 +609,10 @@ subroutine allocate_scalars(this, name_model)
this%njas = 0
this%lenuni = 0
!
+ ! -- update input filename
+ call mem_set_value(this%input_fname, 'INPUT_FNAME', &
+ this%input_mempath, found)
+ !
! -- Return
return
end subroutine allocate_scalars
diff --git a/src/Model/NumericalPackage.f90 b/src/Model/NumericalPackage.f90
index 114256a4778..1d9e66decf0 100644
--- a/src/Model/NumericalPackage.f90
+++ b/src/Model/NumericalPackage.f90
@@ -6,7 +6,7 @@
!<
module NumericalPackageModule
! -- modules
- use KindModule, only: DP, I4B
+ use KindModule, only: DP, I4B, LGP
use ConstantsModule, only: LENPACKAGENAME, LENMODELNAME, &
LENMEMPATH, LENFTYPE, LINELENGTH, &
LENVARNAME
@@ -28,7 +28,7 @@ module NumericalPackageModule
character(len=LENMEMPATH) :: memoryPath = '' !< the location in the memory manager where the variables are stored
character(len=LENMEMPATH) :: memoryPathModel = '' !< the location in the memory manager where the variables
!! of the parent model are stored
- character(len=LENMEMPATH), pointer :: input_mempath => null() !< input context mempath
+ character(len=LENMEMPATH) :: input_mempath = '' !< input context mempath
character(len=LINELENGTH), pointer :: input_fname => null() !< input file name
character(len=LENFTYPE) :: filtyp = '' !< file type (CHD, DRN, RIV, etc.)
character(len=LENFTYPE), pointer :: package_type => null() !< package type (same as filtyp) stored in memory manager
@@ -66,17 +66,19 @@ module NumericalPackageModule
!! is used by the memory manager when variables are allocated.
!!
!<
- subroutine set_names(this, ibcnum, name_model, pakname, ftype)
+ subroutine set_names(this, ibcnum, name_model, pakname, ftype, input_mempath)
! -- dummy variables
class(NumericalPackageType), intent(inout) :: this !< NumericalPackageType object
integer(I4B), intent(in) :: ibcnum !< unique package number
character(len=*), intent(in) :: name_model !< name of the model
character(len=*), intent(in) :: pakname !< name of the package
character(len=*), intent(in) :: ftype !< package type
+ character(len=*), optional, intent(in) :: input_mempath !< input_mempath
!
! -- set names
this%filtyp = ftype
this%name_model = name_model
+ if (present(input_mempath)) this%input_mempath = input_mempath
if (pakname == '') then
write (this%packName, '(a, i0)') trim(ftype)//'-', ibcnum
else
@@ -106,6 +108,7 @@ end subroutine set_names
subroutine allocate_scalars(this)
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
+ use MemoryManagerExtModule, only: mem_set_value
! -- dummy variables
class(NumericalPackageType) :: this !< NumericalPackageType object
! -- local variables
@@ -113,10 +116,9 @@ subroutine allocate_scalars(this)
integer(I4B), pointer :: imodelprpak => null()
integer(I4B), pointer :: imodelprflow => null()
integer(I4B), pointer :: imodelpakcb => null()
+ logical(LGP) :: found
!
! -- allocate scalars
- call mem_allocate(this%input_mempath, LENMEMPATH, 'INPUT_MEMPATH', &
- this%memoryPath)
call mem_allocate(this%input_fname, LINELENGTH, 'INPUT_FNAME', &
this%memoryPath)
call mem_allocate(this%package_type, LENFTYPE, 'PACKAGE_TYPE', &
@@ -140,7 +142,6 @@ subroutine allocate_scalars(this)
call mem_setptr(imodelpakcb, 'IPAKCB', this%memoryPathModel)
!
! -- initialize
- this%input_mempath = ''
this%input_fname = ''
this%package_type = this%filtyp
this%id = 0
@@ -160,6 +161,12 @@ subroutine allocate_scalars(this)
imodelprflow => null()
imodelpakcb => null()
!
+ ! -- update input filename
+ if (this%input_mempath /= '') then
+ call mem_set_value(this%input_fname, 'INPUT_FNAME', &
+ this%input_mempath, found)
+ end if
+ !
! -- return
return
end subroutine allocate_scalars
@@ -176,7 +183,6 @@ subroutine da(this)
class(NumericalPackageType) :: this !< NumericalPackageType object
!
! -- deallocate
- call mem_deallocate(this%input_mempath, 'INPUT_MEMPATH', this%memoryPath)
call mem_deallocate(this%input_fname, 'INPUT_FNAME', this%memoryPath)
call mem_deallocate(this%package_type, 'PACKAGE_TYPE', this%memoryPath)
call mem_deallocate(this%id)
diff --git a/src/Utilities/Idm/IdmLoad.f90 b/src/Utilities/Idm/IdmLoad.f90
index 63690c9863b..fe6d5b263e6 100644
--- a/src/Utilities/Idm/IdmLoad.f90
+++ b/src/Utilities/Idm/IdmLoad.f90
@@ -21,6 +21,7 @@ module IdmLoadModule
private
public :: simnam_load
public :: load_models
+ public :: filein_fname
public :: idm_df
public :: idm_rp
public :: idm_ad
@@ -30,6 +31,56 @@ module IdmLoadModule
contains
+ !> @brief enforce and set a single input filename provided via FILEIN keyword
+ !!
+ !! Set a FILEIN filename provided via an OPTIONS block.
+ !! Only use this function if a maximum of one FILEIN file name
+ !! string is expected.
+ !!
+ !! Return true if single FILEIN file name found and set, return
+ !! false if FILEIN tag not found.
+ !!
+ !<
+ function filein_fname(filename, tagname, input_mempath, input_fname) &
+ result(found)
+ use SimModule, only: store_error, store_error_filename
+ use MemoryManagerModule, only: mem_setptr, get_isize
+ use CharacterStringModule, only: CharacterStringType
+ character(len=*), intent(inout) :: filename
+ character(len=*), intent(in) :: tagname
+ character(len=*), intent(in) :: input_mempath
+ character(len=*), intent(in) :: input_fname
+ logical(LGP) :: found
+ type(CharacterStringType), dimension(:), pointer, &
+ contiguous :: fnames
+ integer(I4B) :: isize
+ !
+ ! -- initialize
+ found = .false.
+ filename = ''
+ !
+ call get_isize(tagname, input_mempath, isize)
+ !
+ if (isize > 0) then
+ !
+ if (isize /= 1) then
+ errmsg = 'Multiple FILEIN keywords detected for tag "'//trim(tagname)// &
+ '" in OPTIONS block. Only one entry allowed.'
+ call store_error(errmsg)
+ call store_error_filename(input_fname)
+ end if
+ !
+ call mem_setptr(fnames, tagname, input_mempath)
+ !
+ filename = fnames(1)
+ found = .true.
+ !
+ end if
+ !
+ ! -- return
+ return
+ end function filein_fname
+
!> @brief advance package dynamic data for period steps
!<
subroutine idm_df()
diff --git a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90
index 5d79675b9e8..bb58e47e741 100644
--- a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90
+++ b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90
@@ -5,6 +5,7 @@ module IdmGwfDfnSelectorModule
use SimModule, only: store_error
use InputDefinitionModule, only: InputParamDefinitionType, &
InputBlockDefinitionType
+ use GwfChdInputModule
use GwfDisInputModule
use GwfDisuInputModule
use GwfDisvInputModule
@@ -22,6 +23,25 @@ module IdmGwfDfnSelectorModule
public :: gwf_idm_integrated
type GwfParamFoundType
+ logical :: auxiliary = .false.
+ logical :: auxmultname = .false.
+ logical :: boundnames = .false.
+ logical :: iprpak = .false.
+ logical :: iprflow = .false.
+ logical :: ipakcb = .false.
+ logical :: ts_filerecord = .false.
+ logical :: ts6 = .false.
+ logical :: filein = .false.
+ logical :: ts6_filename = .false.
+ logical :: obs_filerecord = .false.
+ logical :: obs6 = .false.
+ logical :: obs6_filename = .false.
+ logical :: inewton = .false.
+ logical :: maxbound = .false.
+ logical :: cellid = .false.
+ logical :: head = .false.
+ logical :: auxvar = .false.
+ logical :: boundname = .false.
logical :: length_units = .false.
logical :: nogrb = .false.
logical :: xorigin = .false.
@@ -56,8 +76,6 @@ module IdmGwfDfnSelectorModule
logical :: ncvert = .false.
logical :: icvert = .false.
logical :: ncpl = .false.
- logical :: ipakcb = .false.
- logical :: iprflow = .false.
logical :: cellavg = .false.
logical :: ithickstrt = .false.
logical :: cvoptions = .false.
@@ -78,9 +96,7 @@ module IdmGwfDfnSelectorModule
logical :: ik33overk = .false.
logical :: tvk_filerecord = .false.
logical :: tvk6 = .false.
- logical :: filein = .false.
logical :: tvk6_filename = .false.
- logical :: inewton = .false.
logical :: iusgnrhc = .false.
logical :: inwtupw = .false.
logical :: satmin = .false.
@@ -124,6 +140,8 @@ function gwf_param_definitions(subcomponent) result(input_definition)
type(InputParamDefinitionType), dimension(:), pointer :: input_definition
nullify (input_definition)
select case (subcomponent)
+ case ('CHD')
+ call set_param_pointer(input_definition, gwf_chd_param_definitions)
case ('DIS')
call set_param_pointer(input_definition, gwf_dis_param_definitions)
case ('DISU')
@@ -144,6 +162,8 @@ function gwf_aggregate_definitions(subcomponent) result(input_definition)
type(InputParamDefinitionType), dimension(:), pointer :: input_definition
nullify (input_definition)
select case (subcomponent)
+ case ('CHD')
+ call set_param_pointer(input_definition, gwf_chd_aggregate_definitions)
case ('DIS')
call set_param_pointer(input_definition, gwf_dis_aggregate_definitions)
case ('DISU')
@@ -164,6 +184,8 @@ function gwf_block_definitions(subcomponent) result(input_definition)
type(InputBlockDefinitionType), dimension(:), pointer :: input_definition
nullify (input_definition)
select case (subcomponent)
+ case ('CHD')
+ call set_block_pointer(input_definition, gwf_chd_block_definitions)
case ('DIS')
call set_block_pointer(input_definition, gwf_dis_block_definitions)
case ('DISU')
@@ -183,6 +205,8 @@ function gwf_idm_multi_package(subcomponent) result(multi_package)
character(len=*), intent(in) :: subcomponent
logical :: multi_package
select case (subcomponent)
+ case ('CHD')
+ multi_package = gwf_chd_multi_package
case ('DIS')
multi_package = gwf_dis_multi_package
case ('DISU')
@@ -205,6 +229,8 @@ function gwf_idm_sfac_param(subcomponent) result(sfac_param)
character(len=*), intent(in) :: subcomponent
character(len=LENVARNAME) :: sfac_param
select case (subcomponent)
+ case ('CHD')
+ sfac_param = gwf_chd_aux_sfac_param
case ('DIS')
sfac_param = gwf_dis_aux_sfac_param
case ('DISU')
@@ -228,6 +254,8 @@ function gwf_idm_integrated(subcomponent) result(integrated)
logical :: integrated
integrated = .false.
select case (subcomponent)
+ case ('CHD')
+ integrated = .true.
case ('DIS')
integrated = .true.
case ('DISU')
diff --git a/src/Utilities/Memory/MemoryManager.f90 b/src/Utilities/Memory/MemoryManager.f90
index 0961dfc8533..7e617a3e478 100644
--- a/src/Utilities/Memory/MemoryManager.f90
+++ b/src/Utilities/Memory/MemoryManager.f90
@@ -69,7 +69,8 @@ module MemoryManagerModule
checkin_int1d, &
checkin_int2d, &
checkin_dbl1d, &
- checkin_dbl2d
+ checkin_dbl2d, &
+ checkin_charstr1d
end interface mem_checkin
interface mem_reallocate
@@ -1126,6 +1127,50 @@ subroutine checkin_dbl2d(adbl2d, name, mem_path, name2, mem_path2)
return
end subroutine checkin_dbl2d
+ !> @brief Check in an existing 1d CharacterStringType array with a new address (name + path)
+ !<
+ subroutine checkin_charstr1d(acharstr1d, ilen, name, mem_path, name2, mem_path2)
+ type(CharacterStringType), dimension(:), &
+ pointer, contiguous, intent(inout) :: acharstr1d !< the existing array
+ integer(I4B), intent(in) :: ilen
+ character(len=*), intent(in) :: name !< new variable name
+ character(len=*), intent(in) :: mem_path !< new path where variable is stored
+ character(len=*), intent(in) :: name2 !< existing variable name
+ character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
+ ! --local
+ type(MemoryType), pointer :: mt
+ integer(I4B) :: isize
+ ! -- code
+ !
+ ! -- check variable name length
+ call mem_check_length(name, LENVARNAME, "variable")
+ !
+ ! -- set isize
+ isize = size(acharstr1d)
+ !
+ ! -- allocate memory type
+ allocate (mt)
+ !
+ ! -- set memory type
+ mt%acharstr1d => acharstr1d
+ mt%element_size = ilen
+ mt%isize = isize
+ mt%name = name
+ mt%path = mem_path
+ write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, isize
+ !
+ ! -- set master information
+ mt%master = .false.
+ mt%mastername = name2
+ mt%masterPath = mem_path2
+ !
+ ! -- add memory type to the memory list
+ call memorylist%add(mt)
+ !
+ ! -- return
+ return
+ end subroutine checkin_charstr1d
+
!> @brief Reallocate a 1-dimensional defined length string array
!<
subroutine reallocate_str1d(astr, ilen, nrow, name, mem_path)
diff --git a/src/Utilities/PackageBudget.f90 b/src/Utilities/PackageBudget.f90
index 93f1f5b2c6b..c6485cd904b 100644
--- a/src/Utilities/PackageBudget.f90
+++ b/src/Utilities/PackageBudget.f90
@@ -119,10 +119,20 @@ end subroutine set_auxname
!! GWF Package members stored in BndType.
!!
!<
- subroutine set_pointers(this, flowvarname, mem_path_target)
+ subroutine set_pointers(this, flowvarname, mem_path_target, input_mempath)
+ use ConstantsModule, only: LENVARNAME
class(PackageBudgetType) :: this !< PackageBudgetType object
character(len=*), intent(in) :: flowvarname !< name of variable storing flow (SIMVALS, SIMTOMVR)
character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
+ character(len=*), intent(in) :: input_mempath
+ character(len=LENVARNAME) :: auxvarname
+ !
+ ! -- set memory manager aux varname
+ if (input_mempath /= '') then
+ auxvarname = 'AUXVAR_IDM'
+ else
+ auxvarname = 'AUXVAR'
+ end if
!
! -- Reassign pointers to variables in the flow model
call mem_reassignptr(this%nbound, 'NBOUND', this%memoryPath, &
@@ -132,7 +142,8 @@ subroutine set_pointers(this, flowvarname, mem_path_target)
call mem_reassignptr(this%flow, 'FLOW', this%memoryPath, &
flowvarname, mem_path_target)
call mem_reassignptr(this%auxvar, 'AUXVAR', this%memoryPath, &
- 'AUXVAR', mem_path_target)
+ auxvarname, mem_path_target)
+ !
return
end subroutine set_pointers
diff --git a/src/meson.build b/src/meson.build
index 232e58c7bcc..dd170a1ae59 100644
--- a/src/meson.build
+++ b/src/meson.build
@@ -50,6 +50,7 @@ modflow_sources = files(
'Model' / 'GroundWaterFlow' / 'gwf3api8.f90',
'Model' / 'GroundWaterFlow' / 'gwf3buy8.f90',
'Model' / 'GroundWaterFlow' / 'gwf3chd8.f90',
+ 'Model' / 'GroundWaterFlow' / 'gwf3chd8idm.f90',
'Model' / 'GroundWaterFlow' / 'gwf3csub8.f90',
'Model' / 'GroundWaterFlow' / 'gwf3dis8.f90',
'Model' / 'GroundWaterFlow' / 'gwf3dis8idm.f90',
@@ -104,6 +105,7 @@ modflow_sources = files(
'Model' / 'GroundWaterTransport' / 'gwt1ssm1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1uzt1.f90',
'Model' / 'ModelUtilities' / 'BoundaryPackage.f90',
+ 'Model' / 'ModelUtilities' / 'BoundaryPackageExt.f90',
'Model' / 'ModelUtilities' / 'Connections.f90',
'Model' / 'ModelUtilities' / 'DiscretizationBase.f90',
'Model' / 'ModelUtilities' / 'DisvGeom.f90',
diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py
index 3e8e063e04e..9799280b03e 100644
--- a/utils/idmloader/scripts/dfn2f90.py
+++ b/utils/idmloader/scripts/dfn2f90.py
@@ -968,6 +968,10 @@ def _write_master_component(self, fh=None):
dfns = [
# ** Add a new dfn parameter set to MODFLOW 6 by adding a new entry to this list **
# [relative path of input dnf, relative path of output f90 definition file]
+ [
+ Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-chd.dfn"),
+ Path("../../../src/Model/GroundWaterFlow", "gwf3chd8idm.f90"),
+ ],
[
Path("../../../doc/mf6io/mf6ivar/dfn", "gwf-dis.dfn"),
Path("../../../src/Model/GroundWaterFlow", "gwf3dis8idm.f90"),