diff --git a/make/makefile b/make/makefile
index 2743fb98deb..de28f4e7b34 100644
--- a/make/makefile
+++ b/make/makefile
@@ -1,40 +1,40 @@
-# makefile created by pymake (version 1.2.9.dev0) for the 'mf6' executable.
+# makefile created by pymake (version 1.2.7) for the 'mf6' executable.
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
+SOURCEDIR2=../src/Distributed
+SOURCEDIR3=../src/Exchange
+SOURCEDIR4=../src/Model
+SOURCEDIR5=../src/Model/Connection
+SOURCEDIR6=../src/Model/Geometry
+SOURCEDIR7=../src/Model/GroundWaterFlow
SOURCEDIR8=../src/Model/GroundWaterTransport
-SOURCEDIR9=../src/Model/GroundWaterFlow
-SOURCEDIR10=../src/Distributed
+SOURCEDIR9=../src/Model/ModelUtilities
+SOURCEDIR10=../src/Model/TransportModel
SOURCEDIR11=../src/Solution
-SOURCEDIR12=../src/Solution/PETSc
-SOURCEDIR13=../src/Solution/LinearMethods
+SOURCEDIR12=../src/Solution/LinearMethods
+SOURCEDIR13=../src/Solution/PETSc
SOURCEDIR14=../src/Timing
SOURCEDIR15=../src/Utilities
-SOURCEDIR16=../src/Utilities/TimeSeries
-SOURCEDIR17=../src/Utilities/Libraries
-SOURCEDIR18=../src/Utilities/Libraries/rcm
-SOURCEDIR19=../src/Utilities/Libraries/sparsekit
-SOURCEDIR20=../src/Utilities/Libraries/sparskit2
+SOURCEDIR16=../src/Utilities/ArrayRead
+SOURCEDIR17=../src/Utilities/Idm
+SOURCEDIR18=../src/Utilities/Idm/mf6blockfile
+SOURCEDIR19=../src/Utilities/Idm/selector
+SOURCEDIR20=../src/Utilities/Libraries
SOURCEDIR21=../src/Utilities/Libraries/blas
SOURCEDIR22=../src/Utilities/Libraries/daglib
-SOURCEDIR23=../src/Utilities/Idm
-SOURCEDIR24=../src/Utilities/Idm/selector
-SOURCEDIR25=../src/Utilities/Idm/mf6blockfile
+SOURCEDIR23=../src/Utilities/Libraries/rcm
+SOURCEDIR24=../src/Utilities/Libraries/sparsekit
+SOURCEDIR25=../src/Utilities/Libraries/sparskit2
SOURCEDIR26=../src/Utilities/Matrix
-SOURCEDIR27=../src/Utilities/Vector
+SOURCEDIR27=../src/Utilities/Memory
SOURCEDIR28=../src/Utilities/Observation
SOURCEDIR29=../src/Utilities/OutputControl
-SOURCEDIR30=../src/Utilities/Memory
-SOURCEDIR31=../src/Utilities/ArrayRead
+SOURCEDIR30=../src/Utilities/TimeSeries
+SOURCEDIR31=../src/Utilities/Vector
VPATH = \
${SOURCEDIR1} \
@@ -184,6 +184,7 @@ $(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 \
@@ -192,7 +193,8 @@ $(OBJDIR)/VirtualDataContainer.o \
$(OBJDIR)/SimStages.o \
$(OBJDIR)/NumericalModel.o \
$(OBJDIR)/FlowModelInterface.o \
-$(OBJDIR)/PrintSaveManager.o \
+$(OBJDIR)/OutputControlData.o \
+$(OBJDIR)/gwf3ic8.o \
$(OBJDIR)/Xt3dAlgorithm.o \
$(OBJDIR)/gwf3tvbase8.o \
$(OBJDIR)/gwf3sfr8.o \
@@ -206,10 +208,12 @@ $(OBJDIR)/gwf3drn8.o \
$(OBJDIR)/IndexMap.o \
$(OBJDIR)/VirtualModel.o \
$(OBJDIR)/BaseExchange.o \
+$(OBJDIR)/tsp1fmi1.o \
+$(OBJDIR)/GwtSpc.o \
+$(OBJDIR)/OutputControl.o \
+$(OBJDIR)/tsp1ic1.o \
+$(OBJDIR)/TspAdvOptions.o \
$(OBJDIR)/UzfCellGroup.o \
-$(OBJDIR)/gwt1fmi1.o \
-$(OBJDIR)/OutputControlData.o \
-$(OBJDIR)/gwf3ic8.o \
$(OBJDIR)/Xt3dInterface.o \
$(OBJDIR)/gwf3tvk8.o \
$(OBJDIR)/gwf3vsc8.o \
@@ -220,15 +224,19 @@ $(OBJDIR)/ImsLinearSettings.o \
$(OBJDIR)/ConvergenceSummary.o \
$(OBJDIR)/CellWithNbrs.o \
$(OBJDIR)/NumericalExchange.o \
+$(OBJDIR)/tsp1ssm1.o \
+$(OBJDIR)/tsp1oc1.o \
+$(OBJDIR)/tsp1obs1.o \
+$(OBJDIR)/tsp1mvt1.o \
+$(OBJDIR)/tsp1adv1.o \
+$(OBJDIR)/gwf3disv8.o \
+$(OBJDIR)/gwf3disu8.o \
+$(OBJDIR)/gwf3dis8.o \
$(OBJDIR)/gwf3uzf8.o \
-$(OBJDIR)/gwt1apt1.o \
-$(OBJDIR)/GwtSpc.o \
-$(OBJDIR)/OutputControl.o \
-$(OBJDIR)/gwt1ic1.o \
+$(OBJDIR)/tsp1apt1.o \
$(OBJDIR)/gwt1mst1.o \
$(OBJDIR)/GwtDspOptions.o \
$(OBJDIR)/gwf3npf8.o \
-$(OBJDIR)/GwtAdvOptions.o \
$(OBJDIR)/gwf3tvs8.o \
$(OBJDIR)/GwfStorageUtils.o \
$(OBJDIR)/Mover.o \
@@ -240,26 +248,18 @@ $(OBJDIR)/SparseMatrix.o \
$(OBJDIR)/LinearSolverBase.o \
$(OBJDIR)/ims8reordering.o \
$(OBJDIR)/VirtualExchange.o \
-$(OBJDIR)/gwf3disu8.o \
$(OBJDIR)/GridSorting.o \
$(OBJDIR)/DisConnExchange.o \
$(OBJDIR)/CsrUtils.o \
+$(OBJDIR)/tsp1cnc1.o \
$(OBJDIR)/tsp1.o \
$(OBJDIR)/gwt1uzt1.o \
-$(OBJDIR)/gwt1ssm1.o \
$(OBJDIR)/gwt1src1.o \
$(OBJDIR)/gwt1sft1.o \
-$(OBJDIR)/gwt1oc1.o \
-$(OBJDIR)/gwt1obs1.o \
$(OBJDIR)/gwt1mwt1.o \
-$(OBJDIR)/gwt1mvt1.o \
$(OBJDIR)/gwt1lkt1.o \
$(OBJDIR)/gwt1ist1.o \
$(OBJDIR)/gwt1dsp1.o \
-$(OBJDIR)/gwt1cnc1.o \
-$(OBJDIR)/gwt1adv1.o \
-$(OBJDIR)/gwf3disv8.o \
-$(OBJDIR)/gwf3dis8.o \
$(OBJDIR)/gwf3api8.o \
$(OBJDIR)/gwf3wel8.o \
$(OBJDIR)/gwf3rch8.o \
diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj
index 0949f90e7d7..ee5ef0b323a 100644
--- a/msvs/mf6core.vfproj
+++ b/msvs/mf6core.vfproj
@@ -163,29 +163,19 @@
-
-
-
-
-
-
-
-
-
-
-
+
@@ -198,18 +188,27 @@
-
+
-
+
+
+
+
+
+
+
+
+
+
diff --git a/src/Exchange/GwtGwtExchange.f90 b/src/Exchange/GwtGwtExchange.f90
index faf7d1345ba..bf93edda837 100644
--- a/src/Exchange/GwtGwtExchange.f90
+++ b/src/Exchange/GwtGwtExchange.f90
@@ -22,7 +22,7 @@ module GwtGwtExchangeModule
use VirtualModelModule, only: get_virtual_model
use DisConnExchangeModule, only: DisConnExchangeType
use GwtModule, only: GwtModelType
- use GwtMvtModule, only: GwtMvtType
+ use TspMvtModule, only: TspMvtType
use ObserveModule, only: ObserveType
use ObsModule, only: ObsType
use SimModule, only: count_errors, store_error, &
@@ -66,7 +66,7 @@ module GwtGwtExchangeModule
!
! -- Mover transport package
integer(I4B), pointer :: inmvt => null() !< unit number for mover transport (0 if off)
- type(GwtMvtType), pointer :: mvt => null() !< water mover object
+ type(TspMvtType), pointer :: mvt => null() !< water mover object
!
! -- Observation package
integer(I4B), pointer :: inobs => null() !< unit number for GWT-GWT observations
@@ -937,7 +937,7 @@ end function parse_option
!<
subroutine read_mvt(this, iout)
! -- modules
- use GwtMvtModule, only: mvt_cr
+ use TspMvtModule, only: mvt_cr
! -- dummy
class(GwtExchangeType) :: this !< GwtExchangeType
integer(I4B), intent(in) :: iout
@@ -947,6 +947,7 @@ subroutine read_mvt(this, iout)
! for gwtmodel1 so that a call to save flows has an associated dis
! object.
call mvt_cr(this%mvt, this%name, this%inmvt, iout, this%gwtmodel1%fmi, &
+ this%gwtmodel1%eqnsclfac, &
gwfmodelname1=this%gwfmodelname1, &
gwfmodelname2=this%gwfmodelname2, &
fmi2=this%gwtmodel2%fmi)
diff --git a/src/Model/Connection/GwtInterfaceModel.f90 b/src/Model/Connection/GwtInterfaceModel.f90
index 81d08b1a064..34e8beb0c1d 100644
--- a/src/Model/Connection/GwtInterfaceModel.f90
+++ b/src/Model/Connection/GwtInterfaceModel.f90
@@ -1,17 +1,18 @@
module GwtInterfaceModelModule
use KindModule, only: I4B, DP
+ use ConstantsModule, only: DONE
use MemoryManagerModule, only: mem_allocate, mem_deallocate, mem_reallocate
use MemoryHelperModule, only: create_mem_path
use NumericalModelModule, only: NumericalModelType
use GwtModule, only: GwtModelType, CastAsGwtModel
use GwfDisuModule, only: disu_cr, CastAsDisuType
- use GwtFmiModule, only: fmi_cr, GwtFmiType
- use GwtAdvModule, only: adv_cr, GwtAdvType
- use GwtAdvOptionsModule, only: GwtAdvOptionsType
+ use TspFmiModule, only: fmi_cr, TspFmiType
+ use TspAdvModule, only: adv_cr, TspAdvType
+ use TspAdvOptionsModule, only: TspAdvOptionsType
use GwtDspModule, only: dsp_cr, GwtDspType
use GwtDspOptionsModule, only: GwtDspOptionsType
use GwtMstModule, only: mst_cr
- use GwtObsModule, only: gwt_obs_cr
+ use TspObsModule, only: tsp_obs_cr
use GridConnectionModule
implicit none
@@ -25,12 +26,16 @@ module GwtInterfaceModelModule
integer(i4B), pointer :: iAdvScheme => null() !< the advection scheme: 0 = up, 1 = central, 2 = tvd
integer(i4B), pointer :: ixt3d => null() !< xt3d setting: 0 = off, 1 = lhs, 2 = rhs
+ real(DP), pointer :: ieqnsclfac => null() !< governing eqn scaling factor: 1: GWT, >1: GWE
class(GridConnectionType), pointer :: gridConnection => null() !< The grid connection class will provide the interface grid
class(GwtModelType), private, pointer :: owner => null() !< the real GWT model for which the exchange coefficients
!! are calculated with this interface model
+ real(DP), dimension(:), pointer, contiguous :: porosity => null() !< to be filled with MST porosity
+
contains
+
procedure, pass(this) :: gwtifmod_cr
procedure :: model_df => gwtifmod_df
procedure :: model_ar => gwtifmod_ar
@@ -59,6 +64,7 @@ subroutine gwtifmod_cr(this, name, iout, gridConn)
! defaults
this%iAdvScheme = 0
this%ixt3d = 0
+ this%ieqnsclfac = DONE
this%iout = iout
this%gridConnection => gridConn
@@ -79,10 +85,12 @@ subroutine gwtifmod_cr(this, name, iout, gridConn)
! create dis and packages
call disu_cr(this%dis, this%name, '', -1, this%iout)
- call fmi_cr(this%fmi, this%name, 0, this%iout)
- call adv_cr(this%adv, this%name, adv_unit, this%iout, this%fmi)
+ call fmi_cr(this%fmi, this%name, 0, this%iout, this%ieqnsclfac, &
+ this%depvartype)
+ call adv_cr(this%adv, this%name, adv_unit, this%iout, this%fmi, &
+ this%ieqnsclfac)
call dsp_cr(this%dsp, this%name, '', -dsp_unit, this%iout, this%fmi)
- call gwt_obs_cr(this%obs, inobs)
+ call tsp_obs_cr(this%obs, inobs)
end subroutine gwtifmod_cr
@@ -94,6 +102,7 @@ subroutine allocate_scalars(this, modelname)
call mem_allocate(this%iAdvScheme, 'ADVSCHEME', this%memoryPath)
call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath)
+ call mem_allocate(this%ieqnsclfac, 'IEQNSCLFAC', this%memoryPath)
end subroutine allocate_scalars
@@ -117,7 +126,7 @@ subroutine gwtifmod_df(this)
class(GwtInterfaceModelType) :: this !< the GWT interface model
! local
class(*), pointer :: disPtr
- type(GwtAdvOptionsType) :: adv_options
+ type(TspAdvOptionsType) :: adv_options
type(GwtDspOptionsType) :: dsp_options
this%moffset = 0
@@ -127,7 +136,7 @@ subroutine gwtifmod_df(this)
! define DISU
disPtr => this%dis
call this%gridConnection%getDiscretization(CastAsDisuType(disPtr))
- call this%fmi%fmi_df(this%dis)
+ call this%fmi%fmi_df(this%dis, 1)
if (this%inadv > 0) then
call this%adv%adv_df(adv_options)
@@ -192,6 +201,7 @@ subroutine gwtifmod_da(this)
! this
call mem_deallocate(this%iAdvScheme)
call mem_deallocate(this%ixt3d)
+ call mem_deallocate(this%ieqnsclfac)
! gwt packages
call this%dis%dis_da()
@@ -219,6 +229,7 @@ subroutine gwtifmod_da(this)
call mem_deallocate(this%inmvt)
call mem_deallocate(this%inoc)
call mem_deallocate(this%inobs)
+ call mem_deallocate(this%eqnsclfac)
! base
call this%NumericalModelType%model_da()
diff --git a/src/Model/GroundWaterTransport/gwt1.f90 b/src/Model/GroundWaterTransport/gwt1.f90
index 29bc7bbadce..b53b2562c50 100644
--- a/src/Model/GroundWaterTransport/gwt1.f90
+++ b/src/Model/GroundWaterTransport/gwt1.f90
@@ -8,22 +8,16 @@
module GwtModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: LENFTYPE, LENMEMPATH, DZERO, LENPAKLOC
+ use ConstantsModule, only: LENFTYPE, LENMEMPATH, DZERO, LENPAKLOC, DONE, &
+ LENVARNAME
use VersionModule, only: write_listfile_header
use NumericalModelModule, only: NumericalModelType
- use TransportModelModule, only: TransportModelType
use BaseModelModule, only: BaseModelType
use BndModule, only: BndType, AddBndToList, GetBndFromList
- use GwtIcModule, only: GwtIcType
- use GwtFmiModule, only: GwtFmiType
- use GwtAdvModule, only: GwtAdvType
use GwtDspModule, only: GwtDspType
- use GwtSsmModule, only: GwtSsmType
- use GwtMvtModule, only: GwtMvtType
use GwtMstModule, only: GwtMstType
- use GwtOcModule, only: GwtOcType
- use GwtObsModule, only: GwtObsType
use BudgetModule, only: BudgetType
+ use TransportModelModule
use MatrixBaseModule
implicit none
@@ -32,28 +26,17 @@ module GwtModule
public :: gwt_cr
public :: GwtModelType
public :: CastAsGwtModel
+ public :: niunit
+ character(len=LENVARNAME), parameter :: dvt = 'CONCENTRATION ' !< dependent variable type, varies based on model type
+ character(len=LENVARNAME), parameter :: dvu = 'MASS ' !< dependent variable unit of measure, either "mass" or "energy"
+ character(len=LENVARNAME), parameter :: dvua = 'M ' !< abbreviation of the dependent variable unit of measure, either "M" or "E"
type, extends(TransportModelType) :: GwtModelType
- type(GwtIcType), pointer :: ic => null() ! initial conditions package
- type(GwtFmiType), pointer :: fmi => null() ! flow model interface
type(GwtMstType), pointer :: mst => null() ! mass storage and transfer package
- type(GwtAdvType), pointer :: adv => null() ! advection package
type(GwtDspType), pointer :: dsp => null() ! dispersion package
- type(GwtSsmType), pointer :: ssm => null() ! source sink mixing package
- type(GwtMvtType), pointer :: mvt => null() ! mover transport package
- type(GwtOcType), pointer :: oc => null() ! output control package
- type(GwtObsType), pointer :: obs => null() ! observation package
- type(BudgetType), pointer :: budget => null() ! budget object
- integer(I4B), pointer :: inic => null() ! unit number IC
- integer(I4B), pointer :: infmi => null() ! unit number FMI
- integer(I4B), pointer :: inmvt => null() ! unit number MVT
integer(I4B), pointer :: inmst => null() ! unit number MST
- integer(I4B), pointer :: inadv => null() ! unit number ADV
integer(I4B), pointer :: indsp => null() ! DSP enabled flag
- integer(I4B), pointer :: inssm => null() ! unit number SSM
- integer(I4B), pointer :: inoc => null() ! unit number OC
- integer(I4B), pointer :: inobs => null() ! unit number OBS
contains
@@ -71,101 +54,67 @@ module GwtModule
procedure :: model_ot => gwt_ot
procedure :: model_da => gwt_da
procedure :: model_bdentry => gwt_bdentry
+ procedure :: create_packages => create_gwt_packages
procedure :: allocate_scalars
procedure, private :: package_create
- procedure, private :: ftype_check
procedure :: get_iasym => gwt_get_iasym
- procedure, private :: gwt_ot_flow
- procedure, private :: gwt_ot_flowja
- procedure, private :: gwt_ot_dv
- procedure, private :: gwt_ot_bdsummary
- procedure, private :: gwt_ot_obs
- procedure, private :: create_packages
procedure, private :: create_bndpkgs
- procedure, private :: create_lstfile
- procedure, private :: log_namfile_options
+
end type GwtModelType
contains
!> @brief Create a new groundwater transport model object
+ !<
subroutine gwt_cr(filename, id, modelname)
! -- modules
use ListsModule, only: basemodellist
use BaseModelModule, only: AddBaseModelToList
- use ConstantsModule, only: LINELENGTH
+ use ConstantsModule, only: LINELENGTH, LENPACKAGENAME
use MemoryHelperModule, only: create_mem_path
use MemoryManagerExtModule, only: mem_set_value
- use SimVariablesModule, only: idm_context
use GwfNamInputModule, only: GwfNamParamFoundType
use BudgetModule, only: budget_cr
+ use GwtMstModule, only: mst_cr
+ use GwtDspModule, only: dsp_cr
! -- dummy
character(len=*), intent(in) :: filename
integer(I4B), intent(in) :: id
character(len=*), intent(in) :: modelname
! -- local
+ integer(I4B) :: indis
type(GwtModelType), pointer :: this
class(BaseModelType), pointer :: model
- character(len=LENMEMPATH) :: input_mempath
- character(len=LINELENGTH) :: lst_fname
- type(GwfNamParamFoundType) :: found
!
- ! -- Allocate a new GWT Model (this)
+ ! -- Allocate a new GWT Model (this) and add it to basemodellist
allocate (this)
!
! -- Set memory path before allocation in memory manager can be done
this%memoryPath = create_mem_path(modelname)
!
- ! -- Allocate scalars and add model to basemodellist
call this%allocate_scalars(modelname)
- model => this
- call AddBaseModelToList(basemodellist, model)
!
- ! -- Assign values
- this%filename = filename
- this%name = modelname
- this%macronym = 'GWT'
- this%id = id
- !
- ! -- set input model namfile memory path
- input_mempath = create_mem_path(modelname, 'NAM', idm_context)
- !
- ! -- copy option params from input context
- call mem_set_value(lst_fname, 'LIST', input_mempath, found%list)
- call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, &
- found%print_input)
- call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, &
- found%print_flows)
- call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, found%save_flows)
- !
- ! -- create the list file
- call this%create_lstfile(lst_fname, filename, found%list)
- !
- ! -- activate save_flows if found
- if (found%save_flows) then
- this%ipakcb = -1
- end if
+ ! -- set labels for transport model - needed by create_packages() below
+ call this%set_tsp_labels(this%macronym, dvt, dvu, dvua)
!
- ! -- log set options
- if (this%iout > 0) then
- call this%log_namfile_options(found)
- end if
+ model => this
+ call AddBaseModelToList(basemodellist, model)
!
- ! -- Create utility objects
- call budget_cr(this%budget, this%name)
+ ! -- Call parent class routine
+ call this%tsp_cr(filename, id, modelname, 'GWT', indis)
!
- ! -- create model packages
- call this%create_packages()
+ ! -- Create model packages
+ call this%create_packages(indis)
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_cr
- !> @brief Define packages of the model
- !
- ! (1) call df routines for each package
- ! (2) set variables and pointers
- !
+ !> @brief Define packages of the GWT model
+ !!
+ !! This subroutine defines a gwt model type. Steps include:
+ !! (1) call df routines for each package
+ !! (2) set variables and pointers
!<
subroutine gwt_df(this)
! -- modules
@@ -179,13 +128,14 @@ subroutine gwt_df(this)
!
! -- Define packages and utility objects
call this%dis%dis_df()
- call this%fmi%fmi_df(this%dis)
+ call this%fmi%fmi_df(this%dis, 1)
if (this%inmvt > 0) call this%mvt%mvt_df(this%dis)
if (this%inadv > 0) call this%adv%adv_df()
if (this%indsp > 0) call this%dsp%dsp_df(this%dis)
if (this%inssm > 0) call this%ssm%ssm_df()
call this%oc%oc_df()
- call this%budget%budget_df(NIUNIT_GWT, 'MASS', 'M')
+ call this%budget%budget_df(niunit, this%depvarunit, &
+ this%depvarunitabbrev)
!
! -- Check for SSM package
if (this%inssm == 0) then
@@ -195,6 +145,7 @@ subroutine gwt_df(this)
terminate=.TRUE.)
end if
end if
+
!
! -- Assign or point model members to dis members
this%neq = this%dis%nodes
@@ -216,7 +167,7 @@ subroutine gwt_df(this)
! -- Store information needed for observations
call this%obs%obs_df(this%iout, this%name, 'GWT', this%dis)
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_df
@@ -243,11 +194,13 @@ subroutine gwt_ac(this, sparse)
call packobj%bnd_ac(this%moffset, sparse)
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_ac
- !> @brief Map connection positions in numerical solution coefficient matrix.
+ !> @brief Map the positions of the GWT model connections in the numerical
+ !! solution coefficient matrix.
+ !<
subroutine gwt_mc(this, matrix_sln)
! -- dummy
class(GwtModelType) :: this
@@ -259,6 +212,7 @@ subroutine gwt_mc(this, matrix_sln)
! -- Find the position of each connection in the global ia, ja structure
! and store them in idxglo.
call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln)
+ !
if (this%indsp > 0) call this%dsp%dsp_mc(this%moffset, matrix_sln)
!
! -- Map any package connections
@@ -267,15 +221,15 @@ subroutine gwt_mc(this, matrix_sln)
call packobj%bnd_mc(this%moffset, matrix_sln)
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_mc
- !> @brief Allocate and Read
- !
- ! (1) allocates and reads packages part of this model,
- ! (2) allocates memory for arrays part of this model object
- !
+ !> @brief GWT Model Allocate and Read
+ !!
+ !! This subroutine:
+ !! - allocates and reads packages that are part of this model,
+ !! - allocates memory for arrays used by this model object
!<
subroutine gwt_ar(this)
! -- modules
@@ -294,13 +248,22 @@ subroutine gwt_ar(this)
if (this%inadv > 0) call this%adv%adv_ar(this%dis, this%ibound)
if (this%indsp > 0) call this%dsp%dsp_ar(this%ibound, this%mst%thetam)
if (this%inssm > 0) call this%ssm%ssm_ar(this%dis, this%ibound, this%x)
- if (this%inobs > 0) call this%obs%gwt_obs_ar(this%ic, this%x, this%flowja)
+ if (this%inobs > 0) call this%obs%tsp_obs_ar(this%ic, this%x, this%flowja)
+ !
+ ! -- Set governing equation scale factor. Note that this scale factor
+ ! -- cannot be set arbitrarily. For solute transport, it must be set
+ ! -- to 1. Setting it to a different value will NOT automatically
+ ! -- scale all the terms of the governing equation correctly by that
+ ! -- value. This is because much of the coding in the associated
+ ! -- packages implicitly assumes the governing equation for solute
+ ! -- transport is scaled by 1. (effectively unscaled).
+ this%eqnsclfac = DONE
!
! -- Call dis_ar to write binary grid file
!call this%dis%dis_ar(this%npf%icelltype)
!
! -- set up output control
- call this%oc%oc_ar(this%x, this%dis, DHNOFLO)
+ call this%oc%oc_ar(this%x, this%dis, DHNOFLO, this%depvartype)
call this%budget%set_ibudcsv(this%oc%ibudcsv)
!
! -- Package input files now open, so allocate and read
@@ -312,11 +275,13 @@ subroutine gwt_ar(this)
call packobj%bnd_ar()
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_ar
- !> @brief Read and prepare (calls package read and prepare routines)
+ !> @brief GWT Model Read and Prepare
+ !!
+ !! Call the read and prepare routines of the attached packages
!<
subroutine gwt_rp(this)
! -- modules
@@ -347,7 +312,9 @@ subroutine gwt_rp(this)
return
end subroutine gwt_rp
- !> @brief Time step advance (calls package advance subroutines)
+ !> @brief GWT Model Time Step Advance
+ !!
+ !! Call the advance subroutines of the attached packages
!<
subroutine gwt_ad(this)
! -- modules
@@ -398,13 +365,16 @@ subroutine gwt_ad(this)
! -- Push simulated values to preceding time/subtime step
call this%obs%obs_ad()
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_ad
- !> @brief Calculate coefficients
+ !> @brief GWT Model calculate coefficients
+ !!
+ !! Call the calculate coefficients subroutines of the attached packages
!<
subroutine gwt_cf(this, kiter)
+ ! -- modules
! -- dummy
class(GwtModelType) :: this
integer(I4B), intent(in) :: kiter
@@ -418,13 +388,16 @@ subroutine gwt_cf(this, kiter)
call packobj%bnd_cf()
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_cf
- !> @brief Fill coefficients
+ !> @brief GWT Model fill coefficients
+ !!
+ !! Call the fill coefficients subroutines attached packages
!<
subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
+ ! -- modules
! -- dummy
class(GwtModelType) :: this
integer(I4B), intent(in) :: kiter
@@ -462,11 +435,13 @@ subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
call packobj%bnd_fc(this%rhs, this%ia, this%idxglo, matrix_sln)
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_fc
- !> @brief Final convergence check (calls package cc routines)
+ !> @brief GWT Model Final Convergence Check
+ !!
+ !! If MVR/MVT is active, call the MVR convergence check subroutines
!<
subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
! -- dummy
@@ -479,24 +454,18 @@ subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
integer(I4B), intent(inout) :: ipak
real(DP), intent(inout) :: dpak
! -- local
- ! class(BndType), pointer :: packobj
- ! integer(I4B) :: ip
! -- formats
!
! -- If mover is on, then at least 2 outers required
if (this%inmvt > 0) call this%mvt%mvt_cc(kiter, iend, icnvgmod, cpak, dpak)
!
- ! -- Call package cc routines
- ! do ip = 1, this%bndlist%Count()
- ! packobj => GetBndFromList(this%bndlist, ip)
- ! call packobj%bnd_cc(iend, icnvg, hclose, rclose)
- ! enddo
- !
- ! -- return
+ ! -- Return
return
end subroutine gwt_cc
- !> @brief Calculate intercell flows (flowja)
+ !> @brief GWT Model calculate flow
+ !!
+ !! Call the intercell flows (flow ja) subroutine
!<
subroutine gwt_cq(this, icnvg, isuppress_output)
! -- modules
@@ -543,11 +512,11 @@ subroutine gwt_cq(this, icnvg, isuppress_output)
return
end subroutine gwt_cq
- !> @brief Model budget
- !
- ! (1) Calculate intercell flows (flowja)
- ! (2) Calculate package contributions to model budget
- !
+ !> @brief GWT Model Budget
+ !!
+ !! This subroutine:
+ !! (1) calculates intercell flows (flowja)
+ !! (2) calculates package contributions to the model budget
!<
subroutine gwt_bd(this, icnvg, isuppress_output)
use ConstantsModule, only: DZERO
@@ -575,233 +544,41 @@ subroutine gwt_bd(this, icnvg, isuppress_output)
packobj => GetBndFromList(this%bndlist, ip)
call packobj%bnd_bd(this%budget)
end do
-
!
! -- Return
return
end subroutine gwt_bd
!> @brief Print and/or save model output
+ !!
+ !! Call the parent class output routine
!<
subroutine gwt_ot(this)
- ! -- modules
- use TdisModule, only: kstp, kper, tdis_ot, endofperiod
! -- dummy
class(GwtModelType) :: this
! -- local
- integer(I4B) :: idvsave
- integer(I4B) :: idvprint
integer(I4B) :: icbcfl
integer(I4B) :: icbcun
- integer(I4B) :: ibudfl
- integer(I4B) :: ipflag
- ! -- formats
- character(len=*), parameter :: fmtnocnvg = &
- "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
- &I0,' OF STRESS PERIOD ',I0,'****')"
!
- ! -- Set write and print flags
- idvsave = 0
- idvprint = 0
+ !
+ ! -- Initialize
icbcfl = 0
- ibudfl = 0
- if (this%oc%oc_save('CONCENTRATION')) idvsave = 1
- if (this%oc%oc_print('CONCENTRATION')) idvprint = 1
+ !
+ ! -- Because mst belongs to gwt, call mst_ot_flow directly (and not from parent)
if (this%oc%oc_save('BUDGET')) icbcfl = 1
- if (this%oc%oc_print('BUDGET')) ibudfl = 1
icbcun = this%oc%oc_save_unit('BUDGET')
- !
- ! -- Override ibudfl and idvprint flags for nonconvergence
- ! and end of period
- ibudfl = this%oc%set_print_flag('BUDGET', this%icnvg, endofperiod)
- idvprint = this%oc%set_print_flag('CONCENTRATION', this%icnvg, endofperiod)
- !
- ! Calculate and save observations
- call this%gwt_ot_obs()
- !
- ! Save and print flows
- call this%gwt_ot_flow(icbcfl, ibudfl, icbcun)
- !
- ! Save and print dependent variables
- call this%gwt_ot_dv(idvsave, idvprint, ipflag)
- !
- ! Print budget summaries
- call this%gwt_ot_bdsummary(ibudfl, ipflag)
- !
- ! -- Timing Output; if any dependendent variables or budgets
- ! are printed, then ipflag is set to 1.
- if (ipflag == 1) call tdis_ot(this%iout)
- !
- ! -- Write non-convergence message
- if (this%icnvg == 0) then
- write (this%iout, fmtnocnvg) kstp, kper
- end if
- !
- ! -- Return
- return
- end subroutine gwt_ot
-
- !> @brief Calculate and save observations
- !<
- subroutine gwt_ot_obs(this)
- class(GwtModelType) :: this
- class(BndType), pointer :: packobj
- integer(I4B) :: ip
-
- ! -- Calculate and save observations
- call this%obs%obs_bd()
- call this%obs%obs_ot()
-
- ! -- Calculate and save package obserations
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_bd_obs()
- call packobj%bnd_ot_obs()
- end do
-
- end subroutine gwt_ot_obs
-
- !> @brief Save flows
- !<
- subroutine gwt_ot_flow(this, icbcfl, ibudfl, icbcun)
- class(GwtModelType) :: this
- integer(I4B), intent(in) :: icbcfl
- integer(I4B), intent(in) :: ibudfl
- integer(I4B), intent(in) :: icbcun
- class(BndType), pointer :: packobj
- integer(I4B) :: ip
-
- ! -- Save GWT flows
- call this%gwt_ot_flowja(this%nja, this%flowja, icbcfl, icbcun)
if (this%inmst > 0) call this%mst%mst_ot_flow(icbcfl, icbcun)
- if (this%infmi > 0) call this%fmi%fmi_ot_flow(icbcfl, icbcun)
- if (this%inssm > 0) then
- call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
- end if
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
- end do
-
- ! -- Save advanced package flows
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
- end do
- if (this%inmvt > 0) then
- call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl)
- end if
-
- ! -- Print GWF flows
- ! no need to print flowja
- ! no need to print mst
- ! no need to print fmi
- if (this%inssm > 0) then
- call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
- end if
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
- end do
-
- ! -- Print advanced package flows
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
- end do
- if (this%inmvt > 0) then
- call this%mvt%mvt_ot_printflow(icbcfl, ibudfl)
- end if
-
- end subroutine gwt_ot_flow
-
- !> @brief Write intercell flows
- !<
- subroutine gwt_ot_flowja(this, nja, flowja, icbcfl, icbcun)
- ! -- dummy
- class(GwtModelType) :: this
- integer(I4B), intent(in) :: nja
- real(DP), dimension(nja), intent(in) :: flowja
- integer(I4B), intent(in) :: icbcfl
- integer(I4B), intent(in) :: icbcun
- ! -- local
- integer(I4B) :: ibinun
- ! -- formats
- !
- ! -- Set unit number for binary output
- if (this%ipakcb < 0) then
- ibinun = icbcun
- elseif (this%ipakcb == 0) then
- ibinun = 0
- else
- ibinun = this%ipakcb
- end if
- if (icbcfl == 0) ibinun = 0
!
- ! -- Write the face flows if requested
- if (ibinun /= 0) then
- call this%dis%record_connection_array(flowja, ibinun, this%iout)
- end if
+ ! -- Call parent class _ot routines.
+ call this%tsp_ot(this%inmst)
!
! -- Return
return
- end subroutine gwt_ot_flowja
-
- !> @brief Print dependent variables
- !<
- subroutine gwt_ot_dv(this, idvsave, idvprint, ipflag)
- class(GwtModelType) :: this
- integer(I4B), intent(in) :: idvsave
- integer(I4B), intent(in) :: idvprint
- integer(I4B), intent(inout) :: ipflag
- class(BndType), pointer :: packobj
- integer(I4B) :: ip
-
- ! -- Print advanced package dependent variables
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_dv(idvsave, idvprint)
- end do
-
- ! -- save head and print head
- call this%oc%oc_ot(ipflag)
-
- end subroutine gwt_ot_dv
-
- !> @brief Print budget summary
- !<
- subroutine gwt_ot_bdsummary(this, ibudfl, ipflag)
- use TdisModule, only: kstp, kper, totim
- class(GwtModelType) :: this
- integer(I4B), intent(in) :: ibudfl
- integer(I4B), intent(inout) :: ipflag
- class(BndType), pointer :: packobj
- integer(I4B) :: ip
-
- !
- ! -- Package budget summary
- do ip = 1, this%bndlist%Count()
- packobj => GetBndFromList(this%bndlist, ip)
- call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl)
- end do
-
- ! -- mover budget summary
- if (this%inmvt > 0) then
- call this%mvt%mvt_ot_bdsummary(ibudfl)
- end if
-
- ! -- model budget summary
- if (ibudfl /= 0) then
- ipflag = 1
- call this%budget%budget_ot(kstp, kper, this%iout)
- end if
-
- ! -- Write to budget csv
- call this%budget%writecsv(totim)
-
- end subroutine gwt_ot_bdsummary
+ end subroutine gwt_ot
!> @brief Deallocate
+ !!
+ !! Deallocate memmory at conclusion of model run
!<
subroutine gwt_da(this)
! -- modules
@@ -814,6 +591,10 @@ subroutine gwt_da(this)
integer(I4B) :: ip
class(BndType), pointer :: packobj
!
+ ! -- Scalars
+ call mem_deallocate(this%inmst)
+ call mem_deallocate(this%indsp)
+ !
! -- Deallocate idm memory
call memorylist_remove(this%name, 'NAM', idm_context)
call memorylist_remove(component=this%name, context=idm_context)
@@ -851,21 +632,13 @@ subroutine gwt_da(this)
deallocate (packobj)
end do
!
- ! -- Scalars
- call mem_deallocate(this%inic)
- call mem_deallocate(this%infmi)
- call mem_deallocate(this%inadv)
- call mem_deallocate(this%indsp)
- call mem_deallocate(this%inssm)
- call mem_deallocate(this%inmst)
- call mem_deallocate(this%inmvt)
- call mem_deallocate(this%inoc)
- call mem_deallocate(this%inobs)
+ ! -- Parent class members
+ call this%TransportModelType%tsp_da()
!
! -- NumericalModelType
call this%NumericalModelType%model_da()
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_da
@@ -874,8 +647,6 @@ end subroutine gwt_da
!! This subroutine adds a budget entry to the flow budget. It was added as
!! a method for the gwt model object so that the exchange object could add its
!! contributions.
- !!
- !! (1) adds the entry to the budget object
!<
subroutine gwt_bdentry(this, budterm, budtxt, rowlabel)
! -- modules
@@ -889,7 +660,7 @@ subroutine gwt_bdentry(this, budterm, budtxt, rowlabel)
!
call this%budget%addentry(budterm, delt, budtxt, rowlabel=rowlabel)
!
- ! -- return
+ ! -- Return
return
end subroutine gwt_bdentry
@@ -922,11 +693,15 @@ function gwt_get_iasym(this) result(iasym)
if (packobj%iasym /= 0) iasym = 1
end do
!
- ! -- return
+ ! -- Return
return
end function gwt_get_iasym
- !> @brief Allocate memory for non-allocatable members
+ !> Allocate memory for non-allocatable members
+ !!
+ !! A subroutine for allocating the scalars specific to the GWT model type.
+ !! Additional scalars used by the parent class are allocated by the parent
+ !! class.
!<
subroutine allocate_scalars(this, modelname)
! -- modules
@@ -935,42 +710,30 @@ subroutine allocate_scalars(this, modelname)
class(GwtModelType) :: this
character(len=*), intent(in) :: modelname
!
- ! -- allocate members from parent class
- call this%NumericalModelType%allocate_scalars(modelname)
+ ! -- allocate parent class scalars
+ call this%allocate_tsp_scalars(modelname)
!
- ! -- allocate members that are part of model class
- call mem_allocate(this%inic, 'INIC', this%memoryPath)
- call mem_allocate(this%infmi, 'INFMI', this%memoryPath)
- call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
+ ! -- allocate additional members specific to GWT model type
call mem_allocate(this%inmst, 'INMST', this%memoryPath)
- call mem_allocate(this%inadv, 'INADV', this%memoryPath)
call mem_allocate(this%indsp, 'INDSP', this%memoryPath)
- call mem_allocate(this%inssm, 'INSSM', this%memoryPath)
- call mem_allocate(this%inoc, 'INOC ', this%memoryPath)
- call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
!
- this%inic = 0
- this%infmi = 0
- this%inmvt = 0
this%inmst = 0
- this%inadv = 0
this%indsp = 0
- this%inssm = 0
- this%inoc = 0
- this%inobs = 0
!
- ! -- return
+ ! -- Return
return
end subroutine allocate_scalars
!> @brief Create boundary condition packages for this model
+ !!
+ !! Call the package create routines for packages activated by the user.
!<
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
iout)
! -- modules
use ConstantsModule, only: LINELENGTH
use SimModule, only: store_error
- use GwtCncModule, only: cnc_create
+ use TspCncModule, only: cnc_create
use GwtSrcModule, only: src_create
use GwtIstModule, only: ist_create
use GwtLktModule, only: lkt_create
@@ -995,26 +758,29 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
! -- This part creates the package object
select case (filtyp)
case ('CNC6')
- call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
+ call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
+ pakname, dvt)
case ('SRC6')
- call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
+ call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
+ pakname, dvt)
case ('LKT6')
call lkt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
- pakname, this%fmi)
+ pakname, this%fmi, this%eqnsclfac, dvt, dvu, dvua)
case ('SFT6')
call sft_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
- pakname, this%fmi)
+ pakname, this%fmi, this%eqnsclfac, dvt, dvu, dvua)
case ('MWT6')
call mwt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
- pakname, this%fmi)
+ pakname, this%fmi, this%eqnsclfac, dvt, dvu, dvua)
case ('UZT6')
call uzt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
- pakname, this%fmi)
+ pakname, this%fmi, this%eqnsclfac, dvt, dvu, dvua)
case ('IST6')
call ist_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
pakname, this%fmi, this%mst)
case ('API6')
- call api_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
+ 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.)
@@ -1033,50 +799,12 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
end do
call AddBndToList(this%bndlist, packobj)
!
- ! -- return
+ ! -- Return
return
end subroutine package_create
- !> @brief Make sure required input files have been specified
- !<
- subroutine ftype_check(this, indis)
- ! -- modules
- use ConstantsModule, only: LINELENGTH
- use SimModule, only: store_error, count_errors, store_error_filename
- ! -- dummy
- class(GwtModelType) :: this
- integer(I4B), intent(in) :: indis
- ! -- local
- character(len=LINELENGTH) :: errmsg
- !
- ! -- Check for IC6, DIS(u), and MST. Stop if not present.
- if (this%inic == 0) then
- write (errmsg, '(a)') &
- 'Initial conditions (IC6) package not specified.'
- call store_error(errmsg)
- end if
- if (indis == 0) then
- write (errmsg, '(a)') &
- 'Discretization (DIS6 or DISU6) package not specified.'
- call store_error(errmsg)
- end if
- if (this%inmst == 0) then
- write (errmsg, '(a)') 'Mass storage and transfer (MST6) &
- &package not specified.'
- call store_error(errmsg)
- end if
- !
- if (count_errors() > 0) then
- write (errmsg, '(a)') 'Required package(s) not specified.'
- call store_error(errmsg)
- call store_error_filename(this%filename)
- end if
- !
- ! -- return
- return
- end subroutine ftype_check
-
!> @brief Cast to GwtModelType
+ !<
function CastAsGwtModel(model) result(gwtmodel)
class(*), pointer :: model !< The object to be cast
class(GwtModelType), pointer :: gwtmodel !< The GWT model
@@ -1087,7 +815,9 @@ function CastAsGwtModel(model) result(gwtmodel)
type is (GwtModelType)
gwtmodel => model
end select
-
+ !
+ ! -- Return
+ return
end function CastAsGwtModel
!> @brief Source package info and begin to process
@@ -1143,13 +873,13 @@ subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, &
deallocate (bndpkgs)
end if
!
- ! -- return
+ ! -- Return
return
end subroutine create_bndpkgs
!> @brief Source package info and begin to process
!<
- subroutine create_packages(this)
+ subroutine create_gwt_packages(this, indis)
! -- modules
use ConstantsModule, only: LINELENGTH, LENPACKAGENAME
use CharacterStringModule, only: CharacterStringType
@@ -1157,20 +887,11 @@ subroutine create_packages(this)
use MemoryManagerModule, only: mem_setptr
use MemoryHelperModule, only: create_mem_path
use SimVariablesModule, only: idm_context
- use GwfDisModule, only: dis_cr
- use GwfDisvModule, only: disv_cr
- use GwfDisuModule, only: disu_cr
- use GwtIcModule, only: ic_cr
- use GwtFmiModule, only: fmi_cr
use GwtMstModule, only: mst_cr
- use GwtAdvModule, only: adv_cr
use GwtDspModule, only: dsp_cr
- use GwtSsmModule, only: ssm_cr
- use GwtMvtModule, only: mvt_cr
- use GwtOcModule, only: oc_cr
- use GwtObsModule, only: gwt_obs_cr
! -- dummy
class(GwtModelType) :: this
+ integer(I4B), intent(in) :: indis
! -- local
type(CharacterStringType), dimension(:), contiguous, &
pointer :: pkgtypes => null()
@@ -1187,7 +908,6 @@ subroutine create_packages(this)
integer(I4B), pointer :: inunit
integer(I4B), dimension(:), allocatable :: bndpkgs
integer(I4B) :: n
- integer(I4B) :: indis = 0 ! DIS enabled flag
character(len=LENMEMPATH) :: mempathdsp = ''
!
! -- set input memory paths, input/model and input/model/namfile
@@ -1207,36 +927,13 @@ subroutine create_packages(this)
mempath = mempaths(n)
inunit => inunits(n)
!
- ! -- create dis package first as it is a prerequisite for other packages
+ ! -- create dis package as it is a prerequisite for other packages
select case (pkgtype)
- case ('DIS6')
- indis = 1
- call dis_cr(this%dis, this%name, mempath, indis, this%iout)
- case ('DISV6')
- indis = 1
- call disv_cr(this%dis, this%name, mempath, indis, this%iout)
- case ('DISU6')
- indis = 1
- call disu_cr(this%dis, this%name, mempath, indis, this%iout)
- case ('IC6')
- this%inic = inunit
- case ('FMI6')
- this%infmi = inunit
- case ('MVT6')
- this%inmvt = inunit
case ('MST6')
this%inmst = inunit
- case ('ADV6')
- this%inadv = inunit
case ('DSP6')
this%indsp = 1
mempathdsp = mempath
- case ('SSM6')
- this%inssm = inunit
- case ('OC6')
- this%inoc = inunit
- case ('OBS6')
- this%inobs = inunit
case ('CNC6', 'SRC6', 'LKT6', 'SFT6', &
'MWT6', 'UZT6', 'IST6', 'API6')
call expandarray(bndpkgs)
@@ -1247,107 +944,17 @@ subroutine create_packages(this)
end do
!
! -- Create packages that are tied directly to model
- call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis)
- call fmi_cr(this%fmi, this%name, this%infmi, this%iout)
call mst_cr(this%mst, this%name, this%inmst, this%iout, this%fmi)
- call adv_cr(this%adv, this%name, this%inadv, this%iout, this%fmi)
call dsp_cr(this%dsp, this%name, mempathdsp, this%indsp, this%iout, &
this%fmi)
- call ssm_cr(this%ssm, this%name, this%inssm, this%iout, this%fmi)
- call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi)
- call oc_cr(this%oc, this%name, this%inoc, this%iout)
- call gwt_obs_cr(this%obs, this%inobs)
!
! -- Check to make sure that required ftype's have been specified
- call this%ftype_check(indis)
+ call this%ftype_check(indis, this%inmst)
!
call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
-
- end subroutine create_packages
-
- subroutine create_lstfile(this, lst_fname, model_fname, defined)
- ! -- modules
- use KindModule, only: LGP
- use InputOutputModule, only: openfile, getunit
- ! -- dummy
- class(GwtModelType) :: this
- character(len=*), intent(inout) :: lst_fname
- character(len=*), intent(in) :: model_fname
- logical(LGP), intent(in) :: defined
- ! -- local
- integer(I4B) :: i, istart, istop
!
- ! -- set list file name if not provided
- if (.not. defined) then
- !
- ! -- initialize
- lst_fname = ' '
- istart = 0
- istop = len_trim(model_fname)
- !
- ! -- identify '.' character position from back of string
- do i = istop, 1, -1
- if (model_fname(i:i) == '.') then
- istart = i
- exit
- end if
- end do
- !
- ! -- if not found start from string end
- if (istart == 0) istart = istop + 1
- !
- ! -- set list file name
- lst_fname = model_fname(1:istart)
- istop = istart + 3
- lst_fname(istart:istop) = '.lst'
- end if
- !
- ! -- create the list file
- this%iout = getunit()
- call openfile(this%iout, 0, lst_fname, 'LIST', filstat_opt='REPLACE')
- !
- ! -- write list file header
- call write_listfile_header(this%iout, 'GROUNDWATER TRANSPORT MODEL (GWT)')
- !
- ! -- return
+ ! -- Return
return
- end subroutine create_lstfile
-
- !> @brief Write model namfile options to list file
- !<
- subroutine log_namfile_options(this, found)
- use GwfNamInputModule, only: GwfNamParamFoundType
- class(GwtModelType) :: this
- type(GwfNamParamFoundType), intent(in) :: found
-
- write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:'
-
- if (found%newton) then
- write (this%iout, '(4x,a)') &
- 'NEWTON-RAPHSON method enabled for the model.'
- if (found%under_relaxation) then
- write (this%iout, '(4x,a,a)') &
- 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', &
- 'elevation of the model will be applied to the model.'
- end if
- end if
-
- if (found%print_input) then
- write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// &
- 'FOR ALL MODEL STRESS PACKAGES'
- end if
-
- if (found%print_flows) then
- write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// &
- 'FOR ALL MODEL PACKAGES'
- end if
-
- if (found%save_flows) then
- write (this%iout, '(4x,a)') &
- 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
- end if
-
- write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:'
- end subroutine log_namfile_options
+ end subroutine create_gwt_packages
end module GwtModule
diff --git a/src/Model/GroundWaterTransport/gwt1dsp1.f90 b/src/Model/GroundWaterTransport/gwt1dsp1.f90
index acf48a88052..81b8aaff251 100644
--- a/src/Model/GroundWaterTransport/gwt1dsp1.f90
+++ b/src/Model/GroundWaterTransport/gwt1dsp1.f90
@@ -4,7 +4,7 @@ module GwtDspModule
use ConstantsModule, only: DONE, DZERO, DHALF, DPI
use NumericalPackageModule, only: NumericalPackageType
use BaseDisModule, only: DisBaseType
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use Xt3dModule, only: Xt3dType, xt3d_cr
use GwtDspOptionsModule, only: GwtDspOptionsType
use MatrixBaseModule
@@ -17,7 +17,7 @@ module GwtDspModule
type, extends(NumericalPackageType) :: GwtDspType
integer(I4B), dimension(:), pointer, contiguous :: ibound => null() ! pointer to GWT model ibound
- type(GwtFmiType), pointer :: fmi => null() ! pointer to GWT fmi object
+ type(TspFmiType), pointer :: fmi => null() ! pointer to GWT fmi object
real(DP), dimension(:), pointer, contiguous :: thetam => null() ! pointer to GWT storage porosity (voids per aquifer volume)
real(DP), dimension(:), pointer, contiguous :: diffc => null() ! molecular diffusion coefficient for each cell
real(DP), dimension(:), pointer, contiguous :: alh => null() ! longitudinal horizontal dispersivity
@@ -72,13 +72,9 @@ module GwtDspModule
contains
+ !> @brief Create a new DSP object
+ !<
subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
-! ******************************************************************************
-! dsp_cr -- Create a new DSP object
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use KindModule, only: LGP
use MemoryManagerExtModule, only: mem_set_value
@@ -88,7 +84,7 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
character(len=*), intent(in) :: input_mempath
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
- type(GwtFmiType), intent(in), target :: fmi
+ type(TspFmiType), intent(in), target :: fmi
! -- locals
! -- formats
character(len=*), parameter :: fmtdsp = &
@@ -122,13 +118,11 @@ subroutine dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
return
end subroutine dsp_cr
+ !> @brief Define MST object
+ !!
+ !! Define the MST package
+ !<
subroutine dsp_df(this, dis, dspOptions)
-! ******************************************************************************
-! dsp_df -- Define
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtDspType) :: this
@@ -173,13 +167,11 @@ subroutine dsp_df(this, dis, dspOptions)
return
end subroutine dsp_df
+ !> @brief Add connections to DSP
+ !!
+ !! Add connections for extended neighbors to the sparse matrix
+ !<
subroutine dsp_ac(this, moffset, sparse)
-! ******************************************************************************
-! dsp_ac -- Add connections for extended neighbors to the sparse matrix
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use SparseModule, only: sparsematrix
use MemoryManagerModule, only: mem_allocate
@@ -197,13 +189,11 @@ subroutine dsp_ac(this, moffset, sparse)
return
end subroutine dsp_ac
+ !> @brief Map DSP connections
+ !!
+ !! Map connections and construct iax, jax, and idxglox
+ !<
subroutine dsp_mc(this, moffset, matrix_sln)
-! ******************************************************************************
-! dsp_mc -- Map connections and construct iax, jax, and idxglox
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -220,13 +210,11 @@ subroutine dsp_mc(this, moffset, matrix_sln)
return
end subroutine dsp_mc
+ !> @brief Allocate and read method for package
+ !!
+ !! Method to allocate and read static data for the package.
+ !<
subroutine dsp_ar(this, ibound, thetam)
-! ******************************************************************************
-! dsp_ar -- Allocate and Read
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtDspType) :: this
@@ -247,13 +235,9 @@ subroutine dsp_ar(this, ibound, thetam)
return
end subroutine dsp_ar
+ !> @brief Advance method for the package
+ !<
subroutine dsp_ad(this)
-! ******************************************************************************
-! dsp_ad -- Advance
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: kstp, kper
! -- dummy
@@ -289,13 +273,11 @@ subroutine dsp_ad(this)
return
end subroutine dsp_ad
+ !> @brief Fill coefficient method for package
+ !!
+ !! Method to calculate and fill coefficients for the package.
+ !<
subroutine dsp_fc(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, cnew)
-! ******************************************************************************
-! dsp_fc -- Calculate coefficients and fill amat and rhs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtDspType) :: this
@@ -342,13 +324,11 @@ subroutine dsp_fc(this, kiter, nodes, nja, matrix_sln, idxglo, rhs, cnew)
return
end subroutine dsp_fc
+ !> @ brief Calculate flows for package
+ !!
+ !! Method to calculate dispersion contribution to flowja
+ !<
subroutine dsp_cq(this, cnew, flowja)
-! ******************************************************************************
-! dsp_cq -- Calculate dispersion contribution to flowja
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtDspType) :: this
@@ -379,13 +359,11 @@ subroutine dsp_cq(this, cnew, flowja)
return
end subroutine dsp_cq
+ !> @ brief Allocate scalar variables for package
+ !!
+ !! Method to allocate scalar variables for the package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
use ConstantsModule, only: DZERO
@@ -435,13 +413,11 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @ brief Allocate arrays for package
+ !!
+ !! Method to allocate arrays for the package.
+ !<
subroutine allocate_arrays(this, nodes)
-! ******************************************************************************
-! allocate_arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
use ConstantsModule, only: DZERO
@@ -477,13 +453,11 @@ subroutine allocate_arrays(this, nodes)
return
end subroutine allocate_arrays
+ !> @ brief Deallocate memory
+ !!
+ !! Method to deallocate memory for the package.
+ !<
subroutine dsp_da(this)
-! ******************************************************************************
-! dsp_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
use MemoryManagerExtModule, only: memorylist_remove
@@ -555,15 +529,13 @@ subroutine log_options(this, found)
write (this%iout, '(4x,a,i0)') 'XT3D formulation [0=INACTIVE, 1=ACTIVE, &
&3=ACTIVE RHS] set to: ', this%ixt3d
write (this%iout, '(1x,a,/)') 'End Setting DSP Options'
+ ! -- Return
+ return
end subroutine log_options
+ !> @brief Update simulation mempath options
+ !<
subroutine source_options(this)
-! ******************************************************************************
-! source_options -- update simulation mempath options
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
!use KindModule, only: LGP
use MemoryManagerExtModule, only: mem_set_value
@@ -630,13 +602,9 @@ subroutine log_griddata(this, found)
end subroutine log_griddata
+ !> @brief Update DSP simulation data from input mempath
+ !<
subroutine source_griddata(this)
-! ******************************************************************************
-! source_griddata -- update dsp simulation data from input mempath
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use SimModule, only: count_errors, store_error
use MemoryManagerModule, only: mem_reallocate, mem_reassignptr
@@ -719,13 +687,9 @@ subroutine source_griddata(this)
return
end subroutine source_griddata
+ !> @brief Calculate dispersion coefficients
+ !<
subroutine calcdispellipse(this)
-! ******************************************************************************
-! calcdispellipse -- Calculate dispersion coefficients
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtDspType) :: this
@@ -838,13 +802,9 @@ subroutine calcdispellipse(this)
return
end subroutine calcdispellipse
+ !> @brief Calculate dispersion coefficients
+ !<
subroutine calcdispcoef(this)
-! ******************************************************************************
-! calcdispcoef -- Calculate dispersion coefficients
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use GwfNpfModule, only: hyeff_calc
! -- dummy
diff --git a/src/Model/GroundWaterTransport/gwt1ist1.f90 b/src/Model/GroundWaterTransport/gwt1ist1.f90
index 99ed8128e4d..ad0a91ee4a0 100644
--- a/src/Model/GroundWaterTransport/gwt1ist1.f90
+++ b/src/Model/GroundWaterTransport/gwt1ist1.f90
@@ -19,7 +19,7 @@ module GwtIstModule
LENBUDTXT, DHNOFLO
use BndModule, only: BndType
use BudgetModule, only: BudgetType
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use GwtMstModule, only: GwtMstType, get_zero_order_decay
use OutputControlDataModule, only: OutputControlDataType
use MatrixBaseModule
@@ -49,7 +49,7 @@ module GwtIstModule
!<
type, extends(BndType) :: GwtIstType
- type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object
+ type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object
type(GwtMstType), pointer :: mst => null() !< pointer to mst object
integer(I4B), pointer :: icimout => null() !< unit number for binary cim output
@@ -116,7 +116,7 @@ subroutine ist_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
character(len=*), intent(in) :: pakname !< name of the package
! -- local
type(GwtIstType), pointer :: istobj
- type(GwtFmiType), pointer :: fmi
+ type(TspFmiType), pointer :: fmi
type(GwtMstType), pointer :: mst
!
! -- allocate the object and assign values to object variables
diff --git a/src/Model/GroundWaterTransport/gwt1lkt1.f90 b/src/Model/GroundWaterTransport/gwt1lkt1.f90
index 98ef40abcd0..d1392af7b7c 100644
--- a/src/Model/GroundWaterTransport/gwt1lkt1.f90
+++ b/src/Model/GroundWaterTransport/gwt1lkt1.f90
@@ -34,13 +34,13 @@
module GwtLktModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: DZERO, DONE, LINELENGTH
+ use ConstantsModule, only: DZERO, DONE, LINELENGTH, LENVARNAME
use SimModule, only: store_error
use BndModule, only: BndType, GetBndFromList
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use LakModule, only: LakType
use ObserveModule, only: ObserveType
- use GwtAptModule, only: GwtAptType, apt_process_obsID, &
+ use TspAptModule, only: TspAptType, apt_process_obsID, &
apt_process_obsID12
use MatrixBaseModule
@@ -52,7 +52,7 @@ module GwtLktModule
character(len=*), parameter :: flowtype = 'LAK'
character(len=16) :: text = ' LKT'
- type, extends(GwtAptType) :: GwtLktType
+ type, extends(TspAptType) :: GwtLktType
integer(I4B), pointer :: idxbudrain => null() ! index of rainfall terms in flowbudptr
integer(I4B), pointer :: idxbudevap => null() ! index of evaporation terms in flowbudptr
@@ -92,14 +92,11 @@ module GwtLktModule
contains
+ !> @brief Create a new lkt package
+ !<
subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
- fmi)
-! ******************************************************************************
-! mwt_create -- Create a New MWT Package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ fmi, eqnsclfac, depvartype, depvarunit, &
+ depvarunitabbrev)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -108,7 +105,11 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
- type(GwtFmiType), pointer :: fmi
+ type(TspFmiType), pointer :: fmi
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
+ character(len=LENVARNAME), intent(in) :: depvarunit
+ character(len=LENVARNAME), intent(in) :: depvarunitabbrev
! -- local
type(GwtLktType), pointer :: lktobj
! ------------------------------------------------------------------------------
@@ -133,23 +134,27 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
packobj%ibcnum = ibcnum
packobj%ncolbnd = 1
packobj%iscloc = 1
-
+ !
! -- Store pointer to flow model interface. When the GwfGwt exchange is
! created, it sets fmi%bndlist so that the GWT model has access to all
! the flow packages
lktobj%fmi => fmi
!
- ! -- return
+ ! -- Store labels for dynamic setting of concentration vs temperature
+ lktobj%depvartype = depvartype
+ lktobj%depvarunit = depvarunit
+ lktobj%depvarunitabbrev = depvarunitabbrev
+ !
+ ! -- Store pointer to governing equation scale factor
+ lktobj%eqnsclfac => eqnsclfac
+ !
+ ! -- Return
return
end subroutine lkt_create
+ !> @brief Find corresponding lkt package
+ !<
subroutine find_lkt_package(this)
-! ******************************************************************************
-! find corresponding lkt package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -270,14 +275,12 @@ subroutine find_lkt_package(this)
return
end subroutine find_lkt_package
+ !> @brief Add matrix terms related to LKT
+ !!
+ !! This will be called from TspAptType%apt_fc_expanded()
+ !! in order to add matrix terms specifically for LKT
+ !<
subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! lkt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded()
-! in order to add matrix terms specifically for LKT
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtLktType) :: this
@@ -364,13 +367,9 @@ subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine lkt_fc_expanded
+ !> @brief Add terms specific to lakes to the explicit lake solve
+ !<
subroutine lkt_solve(this)
-! ******************************************************************************
-! lkt_solve -- add terms specific to lakes to the explicit lake solve
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
! -- local
@@ -431,14 +430,11 @@ subroutine lkt_solve(this)
return
end subroutine lkt_solve
+ !> @brief Function to return the number of budget terms just for this package.
+ !!
+ !! This overrides a function in the parent class.
+ !<
function lkt_get_nbudterms(this) result(nbudterms)
-! ******************************************************************************
-! lkt_get_nbudterms -- function to return the number of budget terms just for
-! this package. This overrides function in parent.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtLktType) :: this
@@ -454,13 +450,9 @@ function lkt_get_nbudterms(this) result(nbudterms)
return
end function lkt_get_nbudterms
+ !> @brief Set up the budget object that stores all the lake flows
+ !<
subroutine lkt_setup_budobj(this, idx)
-! ******************************************************************************
-! lkt_setup_budobj -- Set up the budget object that stores all the lake flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
@@ -471,7 +463,7 @@ subroutine lkt_setup_budobj(this, idx)
character(len=LENBUDTXT) :: text
! ------------------------------------------------------------------------------
!
- ! --
+ ! -- Addition of mass associated with rainfall directly on lake surface
text = ' RAINFALL'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
@@ -484,7 +476,8 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! --
+ ! -- Loss of dissolved mass associated with evaporation when a non-zero
+ ! evaporative concentration is specified
text = ' EVAPORATION'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
@@ -497,7 +490,7 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! --
+ ! -- Addition of mass associated with runoff that flows to the lake
text = ' RUNOFF'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
@@ -510,7 +503,7 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! --
+ ! -- Addition of mass associated with user-specified inflow to the lake
text = ' EXT-INFLOW'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
@@ -523,7 +516,7 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! --
+ ! -- Removal of mass associated with user-specified withdrawal from lake
text = ' WITHDRAWAL'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudwdrl)%maxlist
@@ -536,7 +529,8 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! --
+ ! -- Removal of heat associated with outflow from lake that leaves
+ ! model domain
text = ' EXT-OUTFLOW'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
@@ -549,22 +543,19 @@ subroutine lkt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_setup_budobj
- subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
-! ******************************************************************************
-! lkt_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj
+ !<
+ subroutine lkt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
! -- modules
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(inout) :: idx
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
real(DP), intent(inout) :: ccratin
real(DP), intent(inout) :: ccratout
! -- local
@@ -573,7 +564,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
real(DP) :: q
! -- formats
! -----------------------------------------------------------------------------
-
+ !
! -- RAIN
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
@@ -583,7 +574,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EVAPORATION
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
@@ -593,7 +584,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- RUNOFF
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
@@ -603,7 +594,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EXT-INFLOW
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
@@ -613,7 +604,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- WITHDRAWAL
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudwdrl)%nlist
@@ -623,7 +614,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EXT-OUTFLOW
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
@@ -633,19 +624,15 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_fill_budobj
+ !> @brief Allocate scalars specific to the lake mass transport (LKT)
+ !! package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -653,8 +640,8 @@ subroutine allocate_scalars(this)
! -- local
! ------------------------------------------------------------------------------
!
- ! -- allocate scalars in GwtAptType
- call this%GwtAptType%allocate_scalars()
+ ! -- allocate scalars in TspAptType
+ call this%TspAptType%allocate_scalars()
!
! -- Allocate
call mem_allocate(this%idxbudrain, 'IDXBUDRAIN', this%memoryPath)
@@ -676,13 +663,10 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Allocate arrays specific to the lake mass transport (LKT)
+ !! package.
+ !<
subroutine lkt_allocate_arrays(this)
-! ******************************************************************************
-! lkt_allocate_arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -697,8 +681,8 @@ subroutine lkt_allocate_arrays(this)
call mem_allocate(this%concroff, this%ncv, 'CONCROFF', this%memoryPath)
call mem_allocate(this%conciflw, this%ncv, 'CONCIFLW', this%memoryPath)
!
- ! -- call standard GwtApttype allocate arrays
- call this%GwtAptType%apt_allocate_arrays()
+ ! -- call standard TspAptType allocate arrays
+ call this%TspAptType%apt_allocate_arrays()
!
! -- Initialize
do n = 1, this%ncv
@@ -713,13 +697,9 @@ subroutine lkt_allocate_arrays(this)
return
end subroutine lkt_allocate_arrays
+ !> @brief Deallocate memory
+ !<
subroutine lkt_da(this)
-! ******************************************************************************
-! lkt_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
@@ -741,21 +721,17 @@ subroutine lkt_da(this)
call mem_deallocate(this%concroff)
call mem_deallocate(this%conciflw)
!
- ! -- deallocate scalars in GwtAptType
- call this%GwtAptType%bnd_da()
+ ! -- deallocate scalars in TspAptType
+ call this%TspAptType%bnd_da()
!
! -- Return
return
end subroutine lkt_da
+ !> @brief Rain term
+ !<
subroutine lkt_rain_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_rain_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -776,18 +752,14 @@ subroutine lkt_rain_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_rain_term
+ !> @brief Evaporative term
+ !<
subroutine lkt_evap_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_evap_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -817,18 +789,14 @@ subroutine lkt_evap_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp
if (present(hcofval)) hcofval = omega * qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_evap_term
+ !> @brief Runoff term
+ !<
subroutine lkt_roff_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_roff_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -849,18 +817,17 @@ subroutine lkt_roff_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_roff_term
+ !> @brief Inflow Term
+ !!
+ !! Accounts for mass flowing into a lake from a connected stream, for
+ !! example.
+ !<
subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_iflw_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -881,18 +848,17 @@ subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_iflw_term
+ !> @brief Specified withdrawal term
+ !!
+ !! Accounts for mass associated with a withdrawal of water from a lake
+ !! or group of lakes.
+ !<
subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_wdrl_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -913,18 +879,17 @@ subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_wdrl_term
+ !> @brief Outflow term
+ !!
+ !! Accounts for the mass leaving a lake, for example, mass exiting a
+ !! lake via a flow into a draining stream channel.
+ !<
subroutine lkt_outf_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! lkt_outf_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType) :: this
integer(I4B), intent(in) :: ientry
@@ -945,19 +910,16 @@ subroutine lkt_outf_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_outf_term
+ !> @brief Defined observation types
+ !!
+ !! Store the observation type supported by the APT package and overide
+ !! BndType%bnd_df_obs
+ !<
subroutine lkt_df_obs(this)
-! ******************************************************************************
-! lkt_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtLktType) :: this
@@ -1030,13 +992,13 @@ subroutine lkt_df_obs(this)
call this%obs%StoreObsType('ext-outflow', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
!
+ ! -- Return
return
end subroutine lkt_df_obs
!> @brief Process package specific obs
- !!
- !! Method to process specific observations for this package.
- !!
+ !!
+ !! Method to process specific observations for this package.
!<
subroutine lkt_rp_obs(this, obsrv, found)
! -- dummy
@@ -1066,16 +1028,13 @@ subroutine lkt_rp_obs(this, obsrv, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine lkt_rp_obs
+ !> @brief Calculate observation value and pass it back to APT
+ !<
subroutine lkt_bd_obs(this, obstypeid, jj, v, found)
-! ******************************************************************************
-! lkt_bd_obs -- calculate observation value and pass it back to APT
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtLktType), intent(inout) :: this
character(len=*), intent(in) :: obstypeid
@@ -1116,16 +1075,13 @@ subroutine lkt_bd_obs(this, obstypeid, jj, v, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine lkt_bd_obs
+ !> @brief Sets the stress period attributes for keyword use.
+ !<
subroutine lkt_set_stressperiod(this, itemno, keyword, found)
-! ******************************************************************************
-! lkt_set_stressperiod -- Set a stress period attribute for using keywords.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
class(GwtLktType), intent(inout) :: this
@@ -1200,7 +1156,7 @@ subroutine lkt_set_stressperiod(this, itemno, keyword, found)
!
999 continue
!
- ! -- return
+ ! -- Return
return
end subroutine lkt_set_stressperiod
diff --git a/src/Model/GroundWaterTransport/gwt1mst1.f90 b/src/Model/GroundWaterTransport/gwt1mst1.f90
index f962a5f2bef..48842e211b5 100644
--- a/src/Model/GroundWaterTransport/gwt1mst1.f90
+++ b/src/Model/GroundWaterTransport/gwt1mst1.f90
@@ -17,7 +17,7 @@ module GwtMstModule
use MatrixBaseModule
use NumericalPackageModule, only: NumericalPackageType
use BaseDisModule, only: DisBaseType
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
implicit none
public :: GwtMstType
@@ -60,7 +60,7 @@ module GwtMstModule
!
! -- misc
integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound
- type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object
+ type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object
contains
@@ -100,7 +100,7 @@ subroutine mst_cr(mstobj, name_model, inunit, iout, fmi)
character(len=*), intent(in) :: name_model !< name of the model
integer(I4B), intent(in) :: inunit !< unit number of WEL package input file
integer(I4B), intent(in) :: iout !< unit number of model listing file
- type(GwtFmiType), intent(in), target :: fmi !< fmi package for this GWT model
+ type(TspFmiType), intent(in), target :: fmi !< fmi package for this GWT model
!
! -- Create the object
allocate (mstobj)
diff --git a/src/Model/GroundWaterTransport/gwt1mwt1.f90 b/src/Model/GroundWaterTransport/gwt1mwt1.f90
index 15137d3a5c6..2c895009d45 100644
--- a/src/Model/GroundWaterTransport/gwt1mwt1.f90
+++ b/src/Model/GroundWaterTransport/gwt1mwt1.f90
@@ -35,13 +35,13 @@
module GwtMwtModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: DZERO, LINELENGTH
+ use ConstantsModule, only: DZERO, LINELENGTH, LENVARNAME
use SimModule, only: store_error
use BndModule, only: BndType, GetBndFromList
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use MawModule, only: MawType
use ObserveModule, only: ObserveType
- use GwtAptModule, only: GwtAptType, apt_process_obsID, &
+ use TspAptModule, only: TspAptType, apt_process_obsID, &
apt_process_obsID12
use MatrixBaseModule
@@ -53,7 +53,7 @@ module GwtMwtModule
character(len=*), parameter :: flowtype = 'MAW'
character(len=16) :: text = ' MWT'
- type, extends(GwtAptType) :: GwtMwtType
+ type, extends(TspAptType) :: GwtMwtType
integer(I4B), pointer :: idxbudrate => null() ! index of well rate terms in flowbudptr
integer(I4B), pointer :: idxbudfwrt => null() ! index of flowing well rate terms in flowbudptr
@@ -85,14 +85,11 @@ module GwtMwtModule
contains
+ !> Create new MWT package
+ !<
subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
- fmi)
-! ******************************************************************************
-! mwt_create -- Create a New MWT Package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ fmi, eqnsclfac, depvartype, depvarunit, &
+ depvarunitabbrev)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -101,7 +98,11 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
- type(GwtFmiType), pointer :: fmi
+ type(TspFmiType), pointer :: fmi
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
+ character(len=LENVARNAME), intent(in) :: depvarunit
+ character(len=LENVARNAME), intent(in) :: depvarunitabbrev
! -- local
type(GwtMwtType), pointer :: mwtobj
! ------------------------------------------------------------------------------
@@ -132,17 +133,21 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
! the flow packages
mwtobj%fmi => fmi
!
- ! -- return
+ ! -- Store labels for dynamic setting of concentration vs temperature
+ mwtobj%depvartype = depvartype
+ mwtobj%depvarunit = depvarunit
+ mwtobj%depvarunitabbrev = depvarunitabbrev
+ !
+ ! -- Store pointer to governing equation scale factor
+ mwtobj%eqnsclfac => eqnsclfac
+ !
+ ! -- Return
return
end subroutine mwt_create
+ !> @brief find corresponding mwt package
+ !<
subroutine find_mwt_package(this)
-! ******************************************************************************
-! find corresponding mwt package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -257,14 +262,12 @@ subroutine find_mwt_package(this)
return
end subroutine find_mwt_package
+ !> @brief Add matrix terms related to MWT
+ !!
+ !! This routine is called from TspAptType%apt_fc_expanded() in
+ !! order to add matrix terms specifically for MWT
+ !<
subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! mwt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded()
-! in order to add matrix terms specifically for this package
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtMwtType) :: this
@@ -329,14 +332,10 @@ subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine mwt_fc_expanded
+ !> @ brief Add terms specific to multi-aquifer wells to the explicit multi-
+ !! aquifer well solute transport solve
+ !<
subroutine mwt_solve(this)
-! ******************************************************************************
-! mwt_solve -- add terms specific to multi-aquifer wells to the explicit multi-
-! aquifer well solve
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType) :: this
! -- local
@@ -381,14 +380,11 @@ subroutine mwt_solve(this)
return
end subroutine mwt_solve
+ !> @brief Function to return the number of budget terms just for this package
+ !!
+ !! This overrides a function in the parent class.
+ !<
function mwt_get_nbudterms(this) result(nbudterms)
-! ******************************************************************************
-! mwt_get_nbudterms -- function to return the number of budget terms just for
-! this package. This overrides function in parent.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtMwtType) :: this
@@ -407,14 +403,9 @@ function mwt_get_nbudterms(this) result(nbudterms)
return
end function mwt_get_nbudterms
+ !> @brief Set up the budget object that stores all the mwt flows
+ !<
subroutine mwt_setup_budobj(this, idx)
-! ******************************************************************************
-! mwt_setup_budobj -- Set up the budget object that stores all the multi-
-! aquifer well flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
@@ -485,24 +476,20 @@ subroutine mwt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
end if
-
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_setup_budobj
- subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
-! ******************************************************************************
-! mwt_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj
+ !<
+ subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
! -- modules
! -- dummy
class(GwtMwtType) :: this
integer(I4B), intent(inout) :: idx
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
real(DP), intent(inout) :: ccratin
real(DP), intent(inout) :: ccratout
! -- local
@@ -511,7 +498,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
real(DP) :: q
! -- formats
! -----------------------------------------------------------------------------
-
+ !
! -- RATE
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
@@ -521,7 +508,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- FW-RATE
if (this%idxbudfwrt /= 0) then
idx = idx + 1
@@ -533,7 +520,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- RATE-TO-MVR
if (this%idxbudrtmv /= 0) then
idx = idx + 1
@@ -545,7 +532,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- FW-RATE-TO-MVR
if (this%idxbudfrtm /= 0) then
idx = idx + 1
@@ -557,19 +544,15 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_fill_budobj
+ !> @brief Allocate scalars specific to the streamflow mass transport (SFT)
+ !! package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -577,8 +560,8 @@ subroutine allocate_scalars(this)
! -- local
! ------------------------------------------------------------------------------
!
- ! -- allocate scalars in GwtAptType
- call this%GwtAptType%allocate_scalars()
+ ! -- allocate scalars in TspAptType
+ call this%TspAptType%allocate_scalars()
!
! -- Allocate
call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath)
@@ -596,13 +579,10 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Allocate arrays specific to the streamflow mass transport (SFT)
+ !! package.
+ !<
subroutine mwt_allocate_arrays(this)
-! ******************************************************************************
-! mwt_allocate_arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -614,8 +594,8 @@ subroutine mwt_allocate_arrays(this)
! -- time series
call mem_allocate(this%concrate, this%ncv, 'CONCRATE', this%memoryPath)
!
- ! -- call standard GwtApttype allocate arrays
- call this%GwtAptType%apt_allocate_arrays()
+ ! -- call standard TspAptType allocate arrays
+ call this%TspAptType%apt_allocate_arrays()
!
! -- Initialize
do n = 1, this%ncv
@@ -627,13 +607,9 @@ subroutine mwt_allocate_arrays(this)
return
end subroutine mwt_allocate_arrays
+ !> @brief Deallocate memory
+ !<
subroutine mwt_da(this)
-! ******************************************************************************
-! mwt_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
@@ -650,21 +626,17 @@ subroutine mwt_da(this)
! -- deallocate time series
call mem_deallocate(this%concrate)
!
- ! -- deallocate scalars in GwtAptType
- call this%GwtAptType%bnd_da()
+ ! -- deallocate scalars in TspAptType
+ call this%TspAptType%bnd_da()
!
! -- Return
return
end subroutine mwt_da
+ !> @brief Rate term associated with pumping (or injection)
+ !<
subroutine mwt_rate_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! mwt_rate_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType) :: this
integer(I4B), intent(in) :: ientry
@@ -695,18 +667,15 @@ subroutine mwt_rate_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = r
if (present(hcofval)) hcofval = h
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_rate_term
+ !> @brief Transport matrix term(s) associcated with a flowing-
+ !! well rate term associated with pumping (or injection)
+ !<
subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! mwt_fwrt_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType) :: this
integer(I4B), intent(in) :: ientry
@@ -727,18 +696,17 @@ subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_fwrt_term
+ !> @brief Rate-to-mvr term associated with pumping (or injection)
+ !!
+ !! Pumped water that is made available to the MVR package for transfer to
+ !! another advanced package
+ !<
subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! mwt_rtmv_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType) :: this
integer(I4B), intent(in) :: ientry
@@ -759,18 +727,17 @@ subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_rtmv_term
+ !> @brief Flowing well rate-to-mvr term (or injection)
+ !!
+ !! Pumped water that is made available to the MVR package for transfer to
+ !! another advanced package
+ !<
subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! mwt_frtm_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType) :: this
integer(I4B), intent(in) :: ientry
@@ -791,19 +758,16 @@ subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_frtm_term
+ !> @brief Observations
+ !!
+ !! Store the observation type supported by the APT package and overide
+ !! BndType%bnd_df_obs
+ !<
subroutine mwt_df_obs(this)
-! ******************************************************************************
-! mwt_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtMwtType) :: this
@@ -864,13 +828,13 @@ subroutine mwt_df_obs(this)
call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
!
+ ! -- Return
return
end subroutine mwt_df_obs
!> @brief Process package specific obs
- !!
- !! Method to process specific observations for this package.
- !!
+ !!
+ !! Method to process specific observations for this package.
!<
subroutine mwt_rp_obs(this, obsrv, found)
! -- dummy
@@ -893,16 +857,13 @@ subroutine mwt_rp_obs(this, obsrv, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine mwt_rp_obs
+ !> @brief Calculate observation value and pass it back to APT
+ !<
subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
-! ******************************************************************************
-! mwt_bd_obs -- calculate observation value and pass it back to APT
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtMwtType), intent(inout) :: this
character(len=*), intent(in) :: obstypeid
@@ -935,16 +896,14 @@ subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine mwt_bd_obs
+ !> @brief Sets the stress period attributes for keyword use.
+ !<
subroutine mwt_set_stressperiod(this, itemno, keyword, found)
-! ******************************************************************************
-! mwt_set_stressperiod -- Set a stress period attribute for using keywords.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ ! -- modules
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
class(GwtMwtType), intent(inout) :: this
@@ -982,7 +941,7 @@ subroutine mwt_set_stressperiod(this, itemno, keyword, found)
!
999 continue
!
- ! -- return
+ ! -- Return
return
end subroutine mwt_set_stressperiod
diff --git a/src/Model/GroundWaterTransport/gwt1sft1.f90 b/src/Model/GroundWaterTransport/gwt1sft1.f90
index fe310f5eb42..03d89c4692a 100644
--- a/src/Model/GroundWaterTransport/gwt1sft1.f90
+++ b/src/Model/GroundWaterTransport/gwt1sft1.f90
@@ -1,4 +1,4 @@
-! -- Stream Transport Module
+! -- Stream Mass Transport Module
! -- todo: what to do about reactions in stream? Decay?
! -- todo: save the sft concentration into the sfr aux variable?
! -- todo: calculate the sfr DENSE aux variable using concentration?
@@ -33,13 +33,13 @@
module GwtSftModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: DZERO, DONE, LINELENGTH
+ use ConstantsModule, only: DZERO, DONE, LINELENGTH, LENVARNAME
use SimModule, only: store_error
use BndModule, only: BndType, GetBndFromList
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use SfrModule, only: SfrType
use ObserveModule, only: ObserveType
- use GwtAptModule, only: GwtAptType, apt_process_obsID, &
+ use TspAptModule, only: TspAptType, apt_process_obsID, &
apt_process_obsID12
use MatrixBaseModule
@@ -51,7 +51,7 @@ module GwtSftModule
character(len=*), parameter :: flowtype = 'SFR'
character(len=16) :: text = ' SFT'
- type, extends(GwtAptType) :: GwtSftType
+ type, extends(TspAptType) :: GwtSftType
integer(I4B), pointer :: idxbudrain => null() ! index of rainfall terms in flowbudptr
integer(I4B), pointer :: idxbudevap => null() ! index of evaporation terms in flowbudptr
@@ -89,14 +89,11 @@ module GwtSftModule
contains
+ !> @brief Create a new sft package
+ !<
subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
- fmi)
-! ******************************************************************************
-! sft_create -- Create a New SFT Package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ fmi, eqnsclfac, depvartype, depvarunit, &
+ depvarunitabbrev)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -105,7 +102,11 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
- type(GwtFmiType), pointer :: fmi
+ type(TspFmiType), pointer :: fmi
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
+ character(len=LENVARNAME), intent(in) :: depvarunit
+ character(len=LENVARNAME), intent(in) :: depvarunitabbrev
! -- local
type(GwtSftType), pointer :: sftobj
! ------------------------------------------------------------------------------
@@ -123,7 +124,7 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
!
! -- initialize package
call packobj%pack_initialize()
-
+ !
packobj%inunit = inunit
packobj%iout = iout
packobj%id = id
@@ -136,17 +137,21 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
! the flow packages
sftobj%fmi => fmi
!
- ! -- return
+ ! -- Store pointer to governing equation scale factor
+ sftobj%eqnsclfac => eqnsclfac
+ !
+ ! -- Store labels for dynamic setting of concentration vs temperature
+ sftobj%depvartype = depvartype
+ sftobj%depvarunit = depvarunit
+ sftobj%depvarunitabbrev = depvarunitabbrev
+ !
+ ! -- Return
return
end subroutine sft_create
+ !> @brief Find corresponding sft package
+ !<
subroutine find_sft_package(this)
-! ******************************************************************************
-! find corresponding sft package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -264,14 +269,12 @@ subroutine find_sft_package(this)
return
end subroutine find_sft_package
+ !> @brief Add matrix terms related to SFT
+ !!
+ !! This will be called from TspAptType%apt_fc_expanded()
+ !! in order to add matrix terms specifically for SFT
+ !<
subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! sft_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded()
-! in order to add matrix terms specifically for SFT
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtSftType) :: this
@@ -347,13 +350,9 @@ subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine sft_fc_expanded
+ !> @brief Add terms specific to sft to the explicit sft solve
+ !<
subroutine sft_solve(this)
-! ******************************************************************************
-! sft_solve -- add terms specific to sfr to the explicit sfr solve
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
! -- local
@@ -406,14 +405,11 @@ subroutine sft_solve(this)
return
end subroutine sft_solve
+ !> @brief Function to return the number of budget terms just for this package.
+ !!
+ !! This overrides a function in the parent class.
+ !<
function sft_get_nbudterms(this) result(nbudterms)
-! ******************************************************************************
-! sft_get_nbudterms -- function to return the number of budget terms just for
-! this package. This overrides function in parent.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtSftType) :: this
@@ -422,20 +418,16 @@ function sft_get_nbudterms(this) result(nbudterms)
! -- local
! ------------------------------------------------------------------------------
!
- ! -- Number of budget terms is 6
+ ! -- Number of budget terms is 5
nbudterms = 5
!
! -- Return
return
end function sft_get_nbudterms
+ !> @brief Set up the budget object that stores all the sft flows
+ !<
subroutine sft_setup_budobj(this, idx)
-! ******************************************************************************
-! sft_setup_budobj -- Set up the budget object that stores all the sfr flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
@@ -511,22 +503,19 @@ subroutine sft_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
!
- ! -- return
+ ! -- Return
return
end subroutine sft_setup_budobj
- subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
-! ******************************************************************************
-! sft_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj
+ !<
+ subroutine sft_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
! -- modules
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(inout) :: idx
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
real(DP), intent(inout) :: ccratin
real(DP), intent(inout) :: ccratout
! -- local
@@ -535,7 +524,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
real(DP) :: q
! -- formats
! -----------------------------------------------------------------------------
-
+ !
! -- RAIN
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
@@ -545,7 +534,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EVAPORATION
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
@@ -555,7 +544,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- RUNOFF
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
@@ -565,7 +554,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EXT-INFLOW
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
@@ -575,7 +564,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- EXT-OUTFLOW
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
@@ -585,19 +574,15 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
!
- ! -- return
+ ! -- Return
return
end subroutine sft_fill_budobj
+ !> @brief Allocate scalars specific to the streamflow energy transport (SFE)
+ !! package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -605,8 +590,8 @@ subroutine allocate_scalars(this)
! -- local
! ------------------------------------------------------------------------------
!
- ! -- allocate scalars in GwtAptType
- call this%GwtAptType%allocate_scalars()
+ ! -- allocate scalars in TspAptType
+ call this%TspAptType%allocate_scalars()
!
! -- Allocate
call mem_allocate(this%idxbudrain, 'IDXBUDRAIN', this%memoryPath)
@@ -626,13 +611,10 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Allocate arrays specific to the streamflow energy transport (SFE)
+ !! package.
+ !<
subroutine sft_allocate_arrays(this)
-! ******************************************************************************
-! sft_allocate_arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -647,8 +629,8 @@ subroutine sft_allocate_arrays(this)
call mem_allocate(this%concroff, this%ncv, 'CONCROFF', this%memoryPath)
call mem_allocate(this%conciflw, this%ncv, 'CONCIFLW', this%memoryPath)
!
- ! -- call standard GwtApttype allocate arrays
- call this%GwtAptType%apt_allocate_arrays()
+ ! -- call standard TspAptType allocate arrays
+ call this%TspAptType%apt_allocate_arrays()
!
! -- Initialize
do n = 1, this%ncv
@@ -658,18 +640,13 @@ subroutine sft_allocate_arrays(this)
this%conciflw(n) = DZERO
end do
!
- !
! -- Return
return
end subroutine sft_allocate_arrays
+ !> @brief Deallocate memory
+ !<
subroutine sft_da(this)
-! ******************************************************************************
-! sft_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
@@ -690,21 +667,17 @@ subroutine sft_da(this)
call mem_deallocate(this%concroff)
call mem_deallocate(this%conciflw)
!
- ! -- deallocate scalars in GwtAptType
- call this%GwtAptType%bnd_da()
+ ! -- deallocate scalars in TspAptType
+ call this%TspAptType%bnd_da()
!
! -- Return
return
end subroutine sft_da
+ !> @brief Rain term
+ !<
subroutine sft_rain_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! sft_rain_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(in) :: ientry
@@ -725,18 +698,14 @@ subroutine sft_rain_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine sft_rain_term
+ !> @brief Evaporative term
+ !<
subroutine sft_evap_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! sft_evap_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(in) :: ientry
@@ -766,18 +735,14 @@ subroutine sft_evap_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp
if (present(hcofval)) hcofval = omega * qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine sft_evap_term
+ !> @brief Runoff term
+ !<
subroutine sft_roff_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! sft_roff_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(in) :: ientry
@@ -798,18 +763,18 @@ subroutine sft_roff_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine sft_roff_term
+ !> @brief Inflow Term
+ !!
+ !! Accounts for mass added via streamflow entering into a stream channel;
+ !! for example, energy entering the model domain via a specified flow in a
+ !! stream channel.
+ !<
subroutine sft_iflw_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! sft_iflw_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(in) :: ientry
@@ -830,18 +795,17 @@ subroutine sft_iflw_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -rrate
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine sft_iflw_term
+ !> @brief Outflow term
+ !!
+ !! Accounts for the mass leaving a stream channel; for example, mass exiting the
+ !! model domain via a flow in a stream channel flowing out of the active domain.
+ !<
subroutine sft_outf_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! sft_outf_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType) :: this
integer(I4B), intent(in) :: ientry
@@ -862,19 +826,16 @@ subroutine sft_outf_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine sft_outf_term
+ !> @brief Observations
+ !!
+ !! Store the observation type supported by the APT package and overide
+ !! BndType%bnd_df_obs
+ !<
subroutine sft_df_obs(this)
-! ******************************************************************************
-! sft_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtSftType) :: this
@@ -942,13 +903,13 @@ subroutine sft_df_obs(this)
call this%obs%StoreObsType('ext-outflow', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
!
+ ! -- Return
return
end subroutine sft_df_obs
!> @brief Process package specific obs
- !!
- !! Method to process specific observations for this package.
- !!
+ !!
+ !! Method to process specific observations for this package.
!<
subroutine sft_rp_obs(this, obsrv, found)
! -- dummy
@@ -975,16 +936,13 @@ subroutine sft_rp_obs(this, obsrv, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine sft_rp_obs
+ !> @brief Calculate observation value and pass it back to APT
+ !<
subroutine sft_bd_obs(this, obstypeid, jj, v, found)
-! ******************************************************************************
-! sft_bd_obs -- calculate observation value and pass it back to APT
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSftType), intent(inout) :: this
character(len=*), intent(in) :: obstypeid
@@ -1021,16 +979,13 @@ subroutine sft_bd_obs(this, obstypeid, jj, v, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine sft_bd_obs
+ !> @brief Sets the stress period attributes for keyword use.
+ !<
subroutine sft_set_stressperiod(this, itemno, keyword, found)
-! ******************************************************************************
-! sft_set_stressperiod -- Set a stress period attribute for using keywords.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
class(GwtSftType), intent(inout) :: this
@@ -1105,7 +1060,7 @@ subroutine sft_set_stressperiod(this, itemno, keyword, found)
!
999 continue
!
- ! -- return
+ ! -- Return
return
end subroutine sft_set_stressperiod
diff --git a/src/Model/GroundWaterTransport/gwt1src1.f90 b/src/Model/GroundWaterTransport/gwt1src1.f90
index 1565c40ef09..505eebf49d5 100644
--- a/src/Model/GroundWaterTransport/gwt1src1.f90
+++ b/src/Model/GroundWaterTransport/gwt1src1.f90
@@ -1,7 +1,7 @@
module GwtSrcModule
!
use KindModule, only: DP, I4B
- use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE
+ use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, LENVARNAME
use BndModule, only: BndType
use ObsModule, only: DefaultObsIdProcessor
use TimeSeriesLinkModule, only: TimeSeriesLinkType, &
@@ -18,7 +18,11 @@ module GwtSrcModule
character(len=16) :: text = ' SRC'
!
type, extends(BndType) :: GwtSrcType
+
+ character(len=LENVARNAME) :: depvartype = '' !< stores string of dependent variable type, depending on model type
+
contains
+
procedure :: allocate_scalars => src_allocate_scalars
procedure :: bnd_cf => src_cf
procedure :: bnd_fc => src_fc
@@ -29,19 +33,17 @@ module GwtSrcModule
procedure, public :: bnd_df_obs => src_df_obs
! -- methods for time series
procedure, public :: bnd_rp_ts => src_rp_ts
+
end type GwtSrcType
contains
- subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
-! ******************************************************************************
-! src_create -- Create a New Src Package
-! Subroutine: (1) create new-style package
-! (2) point bndobj to the new package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Create an energy source loading package
+ !!
+ !! This subroutine points bndobj to the newly created package
+ !<
+ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
+ depvartype)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -50,6 +52,7 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
+ character(len=LENVARNAME), intent(in) :: depvartype
! -- local
type(GwtSrcType), pointer :: srcobj
! ------------------------------------------------------------------------------
@@ -75,17 +78,16 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
packobj%ncolbnd = 1
packobj%iscloc = 1
!
- ! -- return
+ ! -- Store the appropriate label based on the dependent variable
+ srcobj%depvartype = depvartype
+ !
+ ! -- Return
return
end subroutine src_create
+ !> @brief Deallocate memory
+ !<
subroutine src_da(this)
-! ******************************************************************************
-! src_da -- deallocate
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
@@ -97,17 +99,15 @@ subroutine src_da(this)
!
! -- scalars
!
- ! -- return
+ ! -- Return
return
end subroutine src_da
+ !> @brief Allocate scalars
+ !!
+ !! Allocate scalars specific to this energy source loading package
+ !<
subroutine src_allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars -- allocate scalar members
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use MemoryManagerModule, only: mem_allocate
! -- dummy
class(GwtSrcType) :: this
@@ -120,19 +120,17 @@ subroutine src_allocate_scalars(this)
!
! -- Set values
!
- ! -- return
+ ! -- Return
return
end subroutine src_allocate_scalars
+ !> @brief Formulate the HCOF and RHS terms
+ !!
+ !! This subroutine:
+ !! - calculates hcof and rhs terms
+ !! - skip if no sources
+ !<
subroutine src_cf(this, reset_mover)
-! ******************************************************************************
-! src_cf -- Formulate the HCOF and RHS terms
-! Subroutine: (1) skip if no sources
-! (2) calculate hcof and rhs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtSrcType) :: this
logical, intent(in), optional :: reset_mover
@@ -164,16 +162,15 @@ subroutine src_cf(this, reset_mover)
this%rhs(i) = -q
end do
!
+ ! -- Return
return
end subroutine src_cf
+ !> @brief Add matrix terms related to specified mass source loading
+ !!
+ !! Copy rhs and hcof into solution rhs and amat
+ !<
subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
-! **************************************************************************
-! src_fc -- Copy rhs and hcof into solution rhs and amat
-! **************************************************************************
-!
-! SPECIFICATIONS:
-! --------------------------------------------------------------------------
! -- dummy
class(GwtSrcType) :: this
real(DP), dimension(:), intent(inout) :: rhs
@@ -203,19 +200,19 @@ subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
end if
end do
!
- ! -- return
+ ! -- Return
return
end subroutine src_fc
+ !> @brief Define list labels
+ !!
+ !! Define the list heading that is written to iout when PRINT_INPUT
+ !! option is used.
+ !<
subroutine define_listlabel(this)
-! ******************************************************************************
-! define_listlabel -- Define the list heading that is written to iout when
-! PRINT_INPUT option is used.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ ! -- dummy
class(GwtSrcType), intent(inout) :: this
+ ! -- local
! ------------------------------------------------------------------------------
!
! -- create the header list label
@@ -235,42 +232,41 @@ subroutine define_listlabel(this)
write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine define_listlabel
! -- Procedures related to observations
+ !> @brief Support function for specified mass source loading observations
+ !!
+ !! This function:
+ !! - returns true because SRC package supports observations.
+ !! - overrides BndType%bnd_obs_supported()
+ !<
logical function src_obs_supported(this)
- ! ******************************************************************************
- ! src_obs_supported
- ! -- Return true because SRC package supports observations.
- ! -- Overrides BndType%bnd_obs_supported()
- ! ******************************************************************************
- !
- ! SPECIFICATIONS:
- ! ------------------------------------------------------------------------------
implicit none
+ ! -- dummy
class(GwtSrcType) :: this
- ! ------------------------------------------------------------------------------
+! ------------------------------------------------------------------------------
src_obs_supported = .true.
+ !
+ ! -- Return
return
end function src_obs_supported
+ !> @brief Define observations
+ !!
+ !! This subroutine:
+ !! - stores observation types supported by SRC package.
+ !! - overrides BndType%bnd_df_obs
+ !<
subroutine src_df_obs(this)
- ! ******************************************************************************
- ! src_df_obs (implements bnd_df_obs)
- ! -- Store observation type supported by SRC package.
- ! -- Overrides BndType%bnd_df_obs
- ! ******************************************************************************
- !
- ! SPECIFICATIONS:
- ! ------------------------------------------------------------------------------
implicit none
! -- dummy
class(GwtSrcType) :: this
! -- local
integer(I4B) :: indx
- ! ------------------------------------------------------------------------------
+! ------------------------------------------------------------------------------
call this%obs%StoreObsType('src', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
@@ -279,22 +275,23 @@ subroutine src_df_obs(this)
call this%obs%StoreObsType('to-mvr', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
- ! -- return
+ ! -- Return
return
end subroutine src_df_obs
- ! -- Procedure related to time series
-
+ !> @brief Procedure related to time series
+ !!
+ !! Assign tsLink%Text appropriately for all time series in use by package.
+ !! In the SRC package only the SENERRATE variable can be controlled by time
+ !! series.
+ !<
subroutine src_rp_ts(this)
- ! -- Assign tsLink%Text appropriately for
- ! all time series in use by package.
- ! In the SRC package only the SMASSRATE variable
- ! can be controlled by time series.
! -- dummy
class(GwtSrcType), intent(inout) :: this
! -- local
integer(I4B) :: i, nlinks
type(TimeSeriesLinkType), pointer :: tslink => null()
+! ------------------------------------------------------------------------------
!
nlinks = this%TsManager%boundtslinks%Count()
do i = 1, nlinks
@@ -306,6 +303,7 @@ subroutine src_rp_ts(this)
end if
end do
!
+ ! -- Return
return
end subroutine src_rp_ts
diff --git a/src/Model/GroundWaterTransport/gwt1uzt1.f90 b/src/Model/GroundWaterTransport/gwt1uzt1.f90
index c6be55aec38..fa359d2aa46 100644
--- a/src/Model/GroundWaterTransport/gwt1uzt1.f90
+++ b/src/Model/GroundWaterTransport/gwt1uzt1.f90
@@ -27,13 +27,13 @@
module GwtUztModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: DZERO, DONE, LINELENGTH
+ use ConstantsModule, only: DZERO, DONE, LINELENGTH, LENVARNAME
use SimModule, only: store_error
use BndModule, only: BndType, GetBndFromList
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use UzfModule, only: UzfType
use ObserveModule, only: ObserveType
- use GwtAptModule, only: GwtAptType, apt_process_obsID, &
+ use TspAptModule, only: TspAptType, apt_process_obsID, &
apt_process_obsID12
use MatrixBaseModule
implicit none
@@ -44,7 +44,7 @@ module GwtUztModule
character(len=*), parameter :: flowtype = 'UZF'
character(len=16) :: text = ' UZT'
- type, extends(GwtAptType) :: GwtUztType
+ type, extends(TspAptType) :: GwtUztType
integer(I4B), pointer :: idxbudinfl => null() ! index of uzf infiltration terms in flowbudptr
integer(I4B), pointer :: idxbudrinf => null() ! index of rejected infiltration terms in flowbudptr
@@ -77,14 +77,11 @@ module GwtUztModule
contains
+ !> @brief Create a new UZT package
+ !<
subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
- fmi)
-! ******************************************************************************
-! uzt_create -- Create a New UZT Package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ fmi, eqnsclfac, depvartype, depvarunit, &
+ depvarunitabbrev)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -93,7 +90,11 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
- type(GwtFmiType), pointer :: fmi
+ type(TspFmiType), pointer :: fmi
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
+ character(len=LENVARNAME), intent(in) :: depvarunit
+ character(len=LENVARNAME), intent(in) :: depvarunitabbrev
! -- local
type(GwtUztType), pointer :: uztobj
! ------------------------------------------------------------------------------
@@ -124,17 +125,21 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
! the flow packages
uztobj%fmi => fmi
!
- ! -- return
+ ! -- Store labels for dynamic setting of concentration vs temperature
+ uztobj%depvartype = depvartype
+ uztobj%depvarunit = depvarunit
+ uztobj%depvarunitabbrev = depvarunitabbrev
+ !
+ ! -- Store pointer to governing equation scale factor
+ uztobj%eqnsclfac => eqnsclfac
+ !
+ ! -- Return
return
end subroutine uzt_create
+ !> @brief Find corresponding uzt package
+ !<
subroutine find_uzt_package(this)
-! ******************************************************************************
-! find corresponding uzt package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -249,14 +254,12 @@ subroutine find_uzt_package(this)
return
end subroutine find_uzt_package
+ !> @brief Add matrix terms related to UZT
+ !!
+ !! This will be called from TspAptType%apt_fc_expanded()
+ !! in order to add matrix terms specifically for this package
+ !<
subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! uzt_fc_expanded -- this will be called from GwtAptType%apt_fc_expanded()
-! in order to add matrix terms specifically for this package
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtUztType) :: this
@@ -321,14 +324,11 @@ subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine uzt_fc_expanded
+ !> @brief Explicit solve
+ !!
+ !! Add terms specific to the unsaturated zone to the explicit unsaturated-
+ !! zone solve
subroutine uzt_solve(this)
-! ******************************************************************************
-! uzt_solve -- add terms specific to the unsaturated zone to the explicit
-! unsaturated-zone solve
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType) :: this
! -- local
@@ -373,14 +373,11 @@ subroutine uzt_solve(this)
return
end subroutine uzt_solve
+ !> @brief Function that returns the number of budget terms for this package
+ !!
+ !! This overrides function in parent.
+ !<
function uzt_get_nbudterms(this) result(nbudterms)
-! ******************************************************************************
-! uzt_get_nbudterms -- function to return the number of budget terms just for
-! this package. This overrides function in parent.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtUztType) :: this
@@ -400,14 +397,9 @@ function uzt_get_nbudterms(this) result(nbudterms)
return
end function uzt_get_nbudterms
+ !> @brief Set up the budget object that stores all the unsaturated-zone flows
+ !<
subroutine uzt_setup_budobj(this, idx)
-! ******************************************************************************
-! uzt_setup_budobj -- Set up the budget object that stores all the unsaturated-
-! zone flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
@@ -418,7 +410,7 @@ subroutine uzt_setup_budobj(this, idx)
character(len=LENBUDTXT) :: text
! ------------------------------------------------------------------------------
!
- ! --
+ ! -- Infiltration flux
text = ' INFILTRATION'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
@@ -430,9 +422,8 @@ subroutine uzt_setup_budobj(this, idx)
this%packName, &
maxlist, .false., .false., &
naux)
-
!
- ! --
+ ! -- Rejected infiltration flux (and subsequently removed from the model)
if (this%idxbudrinf /= 0) then
text = ' REJ-INF'
idx = idx + 1
@@ -446,9 +437,8 @@ subroutine uzt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
end if
-
!
- ! --
+ ! -- Evapotranspiration flux originating from the unsaturated zone
if (this%idxbuduzet /= 0) then
text = ' UZET'
idx = idx + 1
@@ -462,9 +452,8 @@ subroutine uzt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
end if
-
!
- ! --
+ ! -- Rejected infiltration flux that is transferred to the MVR/MVT packages
if (this%idxbudritm /= 0) then
text = ' INF-REJ-TO-MVR'
idx = idx + 1
@@ -478,24 +467,19 @@ subroutine uzt_setup_budobj(this, idx)
maxlist, .false., .false., &
naux)
end if
-
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_setup_budobj
- subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
-! ******************************************************************************
-! uzt_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj
+ subroutine uzt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
! -- modules
! -- dummy
class(GwtUztType) :: this
integer(I4B), intent(inout) :: idx
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
real(DP), intent(inout) :: ccratin
real(DP), intent(inout) :: ccratout
! -- local
@@ -504,7 +488,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
real(DP) :: q
! -- formats
! -----------------------------------------------------------------------------
-
+ !
! -- INFILTRATION
idx = idx + 1
nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
@@ -514,7 +498,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%budobj%budterm(idx)%update_term(n1, n2, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
+ !
! -- REJ-INF
if (this%idxbudrinf /= 0) then
idx = idx + 1
@@ -526,7 +510,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- UZET
if (this%idxbuduzet /= 0) then
idx = idx + 1
@@ -538,7 +522,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- REJ-INF-TO-MVR
if (this%idxbudritm /= 0) then
idx = idx + 1
@@ -550,19 +534,17 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
!
- ! -- return
+ !
+ ! -- Return
return
end subroutine uzt_fill_budobj
+ !> @brief Allocate scalar variables for package
+ !!
+ !! Method to allocate scalar variables for the package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -570,8 +552,8 @@ subroutine allocate_scalars(this)
! -- local
! ------------------------------------------------------------------------------
!
- ! -- allocate scalars in GwtAptType
- call this%GwtAptType%allocate_scalars()
+ ! -- allocate scalars in TspAptType
+ call this%TspAptType%allocate_scalars()
!
! -- Allocate
call mem_allocate(this%idxbudinfl, 'IDXBUDINFL', this%memoryPath)
@@ -589,13 +571,11 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Allocate arrays for package
+ !!
+ !! Method to allocate arrays for the package.
+ !<
subroutine uzt_allocate_arrays(this)
-! ******************************************************************************
-! uzt_allocate_arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
@@ -608,8 +588,8 @@ subroutine uzt_allocate_arrays(this)
call mem_allocate(this%concinfl, this%ncv, 'CONCINFL', this%memoryPath)
call mem_allocate(this%concuzet, this%ncv, 'CONCUZET', this%memoryPath)
!
- ! -- call standard GwtApttype allocate arrays
- call this%GwtAptType%apt_allocate_arrays()
+ ! -- call standard TspAptType allocate arrays
+ call this%TspAptType%apt_allocate_arrays()
!
! -- Initialize
do n = 1, this%ncv
@@ -622,13 +602,11 @@ subroutine uzt_allocate_arrays(this)
return
end subroutine uzt_allocate_arrays
+ !> @brief Deallocate memory
+ !!
+ !! Method to deallocate memory for the package.
+ !<
subroutine uzt_da(this)
-! ******************************************************************************
-! uzt_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
@@ -646,21 +624,20 @@ subroutine uzt_da(this)
call mem_deallocate(this%concinfl)
call mem_deallocate(this%concuzet)
!
- ! -- deallocate scalars in GwtAptType
- call this%GwtAptType%bnd_da()
+ ! -- deallocate scalars in TspAptType
+ call this%TspAptType%bnd_da()
!
! -- Return
return
end subroutine uzt_da
+ !> @brief Infiltration term
+ !!
+ !! Accounts for mass added to the subsurface via infiltration. For example,
+ !! mass entering the model domain via rainfall or irrigation.
+ !<
subroutine uzt_infl_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! uzt_infl_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType) :: this
integer(I4B), intent(in) :: ientry
@@ -691,18 +668,19 @@ subroutine uzt_infl_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = r
if (present(hcofval)) hcofval = h
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_infl_term
+ !> @brief Rejected infiltration term
+ !!
+ !! Accounts for mass that is added to the model from specifying an
+ !! infiltration rate and concentration, but is subsequently removed from
+ !! the model as that portion of the infiltration that is rejected (and
+ !! NOT transferred to another advanced package via the MVR/MVT packages).
+ !<
subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! uzt_rinf_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType) :: this
integer(I4B), intent(in) :: ientry
@@ -723,18 +701,17 @@ subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_rinf_term
+ !> @brief Evapotranspiration from the unsaturated-zone term
+ !!
+ !! Accounts for mass removed as a result of evapotranspiration from the
+ !! unsaturated zone.
+ !<
subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! uzt_uzet_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType) :: this
integer(I4B), intent(in) :: ientry
@@ -764,18 +741,19 @@ subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = -(DONE - omega) * qbnd * ctmp
if (present(hcofval)) hcofval = omega * qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_uzet_term
+ !> @brief Rejected infiltration to MVR/MVT term
+ !!
+ !! Accounts for energy that is added to the model from specifying an
+ !! infiltration rate and temperature, but does not infiltrate into the
+ !! subsurface. This subroutine is called when the rejected infiltration
+ !! is transferred to another advanced package via the MVR/MVT packages.
+ !<
subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
-! ******************************************************************************
-! uzt_ritm_term
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType) :: this
integer(I4B), intent(in) :: ientry
@@ -796,19 +774,17 @@ subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, &
if (present(rhsval)) rhsval = DZERO
if (present(hcofval)) hcofval = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_ritm_term
+ !> @brief Define UZT Observation
+ !!
+ !! This subroutine:
+ !! - Stores observation types supported by the parent APT package.
+ !! - Overrides BndType%bnd_df_obs
+ !<
subroutine uzt_df_obs(this)
-! ******************************************************************************
-! uzt_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtUztType) :: this
@@ -870,13 +846,14 @@ subroutine uzt_df_obs(this)
call this%obs%StoreObsType('rej-inf-to-mvr', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
!
+ ! -- Return
return
end subroutine uzt_df_obs
!> @brief Process package specific obs
- !!
- !! Method to process specific observations for this package.
- !!
+ !!
+ !! Method to process specific observations for this package.
+ !!
!<
subroutine uzt_rp_obs(this, obsrv, found)
! -- dummy
@@ -902,13 +879,9 @@ subroutine uzt_rp_obs(this, obsrv, found)
return
end subroutine uzt_rp_obs
+ !> @brief Calculate observation value and pass it back to APT
+ !<
subroutine uzt_bd_obs(this, obstypeid, jj, v, found)
-! ******************************************************************************
-! uzt_bd_obs -- calculate observation value and pass it back to APT
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
class(GwtUztType), intent(inout) :: this
character(len=*), intent(in) :: obstypeid
@@ -941,16 +914,13 @@ subroutine uzt_bd_obs(this, obstypeid, jj, v, found)
found = .false.
end select
!
+ ! -- Return
return
end subroutine uzt_bd_obs
+ !> @brief Sets the stress period attributes for keyword use.
+ !<
subroutine uzt_set_stressperiod(this, itemno, keyword, found)
-! ******************************************************************************
-! uzt_set_stressperiod -- Set a stress period attribute for using keywords.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
class(GwtUztType), intent(inout) :: this
@@ -1000,7 +970,7 @@ subroutine uzt_set_stressperiod(this, itemno, keyword, found)
!
999 continue
!
- ! -- return
+ ! -- Return
return
end subroutine uzt_set_stressperiod
diff --git a/src/Model/ModelUtilities/FlowModelInterface.f90 b/src/Model/ModelUtilities/FlowModelInterface.f90
index 68d1ce7f1c2..80d0abda1b4 100644
--- a/src/Model/ModelUtilities/FlowModelInterface.f90
+++ b/src/Model/ModelUtilities/FlowModelInterface.f90
@@ -2,7 +2,7 @@ module FlowModelInterfaceModule
use KindModule, only: DP, I4B, LGP
use ConstantsModule, only: DONE, DZERO, DHALF, LINELENGTH, LENBUDTXT, &
- LENPACKAGENAME
+ LENPACKAGENAME, LENVARNAME
use SimModule, only: store_error, store_error_unit
use SimVariablesModule, only: errmsg
use NumericalPackageModule, only: NumericalPackageType
@@ -29,6 +29,7 @@ module FlowModelInterfaceModule
real(DP), dimension(:), pointer, contiguous :: gwfhead => null() !< pointer to the GWF head array
real(DP), dimension(:), pointer, contiguous :: gwfsat => null() !< pointer to the GWF saturation array
integer(I4B), dimension(:), pointer, contiguous :: ibdgwfsat0 => null() !< mark cells with saturation = 0 to exclude from dispersion
+ integer(I4B), pointer :: idryinactive => null() !< mark cells with an additional flag to exclude from deactivation (gwe will simulate conduction through dry cells)
real(DP), dimension(:), pointer, contiguous :: gwfstrgss => null() !< pointer to flow model QSTOSS
real(DP), dimension(:), pointer, contiguous :: gwfstrgsy => null() !< pointer to flow model QSTOSY
integer(I4B), pointer :: igwfstrgss => null() !< indicates if gwfstrgss is available
@@ -43,6 +44,8 @@ module FlowModelInterfaceModule
type(PackageBudgetType), dimension(:), allocatable :: gwfpackages !< used to get flows between a package and gwf
type(BudgetObjectType), pointer :: mvrbudobj => null() !< pointer to the mover budget budget object
character(len=16), dimension(:), allocatable :: flowpacknamearray !< array of boundary package names (e.g. LAK-1, SFR-3, etc.)
+ character(len=LENVARNAME) :: depvartype = ''
+
contains
procedure :: advance_bfr
@@ -69,12 +72,13 @@ module FlowModelInterfaceModule
contains
!> @brief Define the flow model interface
- subroutine fmi_df(this, dis)
+ subroutine fmi_df(this, dis, idryinactive)
! -- modules
use SimModule, only: store_error
! -- dummy
class(FlowModelInterfaceType) :: this
class(DisBaseType), pointer, intent(in) :: dis
+ integer(I4B), intent(in) :: idryinactive
! -- formats
character(len=*), parameter :: fmtfmi = &
"(1x,/1x,'FMI -- FLOW MODEL INTERFACE, VERSION 2, 8/17/2023', &
@@ -115,6 +119,11 @@ subroutine fmi_df(this, dis)
call this%initialize_gwfterms_from_gwfbndlist()
end if
!
+ ! -- Set flag that stops dry flows from being deactivated in a GWE
+ ! transport model since conduction will still be simulated.
+ ! 0: GWE (skip deactivation step); 1: GWT (default: use existing code)
+ this%idryinactive = idryinactive
+ !
! -- Return
return
end subroutine fmi_df
@@ -138,6 +147,7 @@ subroutine fmi_ar(this, ibound)
end subroutine fmi_ar
!> @brief Deallocate variables
+ !<
subroutine fmi_da(this)
! -- modules
use MemoryManagerModule, only: mem_deallocate
@@ -153,6 +163,7 @@ subroutine fmi_da(this)
deallocate (this%flowpacknamearray)
call mem_deallocate(this%igwfmvrterm)
call mem_deallocate(this%ibdgwfsat0)
+ call mem_deallocate(this%idryinactive)
!
if (this%flows_from_file) then
call mem_deallocate(this%gwfstrgss)
@@ -202,6 +213,7 @@ subroutine allocate_scalars(this)
call mem_allocate(this%iuhds, 'IUHDS', this%memoryPath)
call mem_allocate(this%iumvr, 'IUMVR', this%memoryPath)
call mem_allocate(this%nflowpack, 'NFLOWPACK', this%memoryPath)
+ call mem_allocate(this%idryinactive, "IDRYINACTIVE", this%memoryPath)
!
! !
! -- Initialize
@@ -213,6 +225,7 @@ subroutine allocate_scalars(this)
this%iuhds = 0
this%iumvr = 0
this%nflowpack = 0
+ this%idryinactive = 1
!
! -- Return
return
diff --git a/src/Model/ModelUtilities/GwtAdvOptions.f90 b/src/Model/ModelUtilities/TspAdvOptions.f90
similarity index 53%
rename from src/Model/ModelUtilities/GwtAdvOptions.f90
rename to src/Model/ModelUtilities/TspAdvOptions.f90
index 4e724a745d0..08beb0e0d80 100644
--- a/src/Model/ModelUtilities/GwtAdvOptions.f90
+++ b/src/Model/ModelUtilities/TspAdvOptions.f90
@@ -1,10 +1,10 @@
-module GwtAdvOptionsModule
+module TspAdvOptionsModule
use KindModule, only: I4B
implicit none
private
- type, public :: GwtAdvOptionsType
+ type, public :: TspAdvOptionsType
integer(I4B) :: iAdvScheme !< the advection scheme: 0 = up, 1 = central, 2 = TVD
- end type GwtAdvOptionsType
+ end type TspAdvOptionsType
-end module GwtAdvOptionsModule
+end module TspAdvOptionsModule
diff --git a/src/Model/TransportModel/tsp1.f90 b/src/Model/TransportModel/tsp1.f90
index f37082cc3cb..7740714d1c8 100644
--- a/src/Model/TransportModel/tsp1.f90
+++ b/src/Model/TransportModel/tsp1.f90
@@ -1,25 +1,941 @@
-!> @brief This module contains the base transport model type
-!!
-!! This module contains the base class for transport models.
-!!
-!<
+! Generalized Transport Base Class
+! Base class for solute (mass) and energy (thermal) transport
+! (The following copied from gwt1.f90)
+! * Add check that discretization is the same between both models
+! * Program GWT-GWT exchange transport (awaiting implementation of interface model)
+! * Consider implementation of steady-state transport (affects MST, IST)
+! * Check and handle pore space discrepancy between flow and transport (porosity vs specific yield)
+! * UZT may not have the required porosity term
+!
+! This classes uses strings for storing labels used by different parts of the
+! code. Labels are based on which type of transport model inherits
+! from this module (GWT or GWE)
+!
+! Labels that are transport model specific and used in different packages:
+!
+! GWT | GWE | src files w/label
+! -----------------|-------------------|--------------
+! "Concentration" |"Temperature" | gwt1.f90/gwe1.f90
+! | | gwt1apt1.f90
+! | | gwt1cnc1.f90
+! | | gwt1ist1.f90
+! | | gwt1lkt1.f90
+! | | gwt1mst1.f90
+! | | gwt1obs1.f90
+! | | gwt1oc1.f90
+! | | gwt1sft1.f90 (?)
+! | | gwt1ssm1.f90
+! | | gwt1fmi1.f90
+! | | tsp1ic1.f90
+! | | GwtSpc.f90
+! "Cumulative Mass"|"Cumulative Energy"| Budget.f90 (_ot routine)
+! "MASS", "M" |"ENERGY", "E" | gwt1.f90 (gwt_df routine & _ot routine)
+! "M/T" |"Watts" (?) |
+! "M" |"Joules" or "E" |
module TransportModelModule
use KindModule, only: DP, I4B
- use ConstantsModule, only: LENFTYPE
+ use InputOutputModule, only: ParseLine
+ use VersionModule, only: write_listfile_header
+ use ConstantsModule, only: LENFTYPE, DZERO, LENPAKLOC, LENMEMPATH, LENVARNAME
use SimVariablesModule, only: errmsg
use NumericalModelModule, only: NumericalModelType
+ use NumericalPackageModule, only: NumericalPackageType
+ use BndModule, only: BndType, GetBndFromList
+ use TspIcModule, only: TspIcType
+ use TspFmiModule, only: TspFmiType
+ use TspAdvModule, only: TspAdvType
+ use TspSsmModule, only: TspSsmType
+ use TspMvtModule, only: TspMvtType
+ use TspOcModule, only: TspOcType
+ use TspObsModule, only: TspObsType
+ use BudgetModule, only: BudgetType
+ use MatrixBaseModule
implicit none
private
public :: TransportModelType
+ public :: niunit, cunit
type, extends(NumericalModelType) :: TransportModelType
+ ! Generalized transport package types common to either GWT or GWE
+ type(TspAdvType), pointer :: adv => null() !< advection package
+ type(TspFmiType), pointer :: fmi => null() !< flow model interface
+ type(TspIcType), pointer :: ic => null() !< initial conditions package
+ type(TspMvtType), pointer :: mvt => null() !< mover transport package
+ type(TspObsType), pointer :: obs => null() !< observation package
+ type(TspOcType), pointer :: oc => null() !< output control package
+ type(TspSsmType), pointer :: ssm => null() !< source sink mixing package
+ type(BudgetType), pointer :: budget => null() !< budget object
+ integer(I4B), pointer :: inic => null() !< unit number IC
+ integer(I4B), pointer :: infmi => null() !< unit number FMI
+ integer(I4B), pointer :: inmvt => null() !< unit number MVT
+ integer(I4B), pointer :: inadv => null() !< unit number ADV
+ integer(I4B), pointer :: inssm => null() !< unit number SSM
+ integer(I4B), pointer :: inoc => null() !< unit number OC
+ integer(I4B), pointer :: inobs => null() !< unit number OBS
+ real(DP), pointer :: eqnsclfac => null() !< constant factor by which all terms in the model's governing equation are scaled (divided) for formulation and solution
+ ! Labels that will be defined
+ character(len=LENVARNAME) :: tsptype = '' !< "solute" or "heat"
+ character(len=LENVARNAME) :: depvartype = '' !< "concentration" or "temperature"
+ character(len=LENVARNAME) :: depvarunit = '' !< "mass" or "energy"
+ character(len=LENVARNAME) :: depvarunitabbrev = '' !< "M" or "J"
+
contains
+ ! -- public
+ procedure, public :: allocate_tsp_scalars
+ procedure, public :: set_tsp_labels
+ procedure, public :: ftype_check
+ procedure, public :: tsp_cr
+ procedure, public :: tsp_df
+ procedure, public :: tsp_da
+ procedure, public :: tsp_ac
+ procedure, public :: tsp_mc
+ procedure, public :: tsp_ar
+ procedure, public :: tsp_rp
+ procedure, public :: tsp_ad
+ procedure, public :: tsp_fc
+ procedure, public :: tsp_cc
+ procedure, public :: tsp_cq
+ procedure, public :: tsp_bd
+ procedure, public :: tsp_ot
+ ! -- private
+ procedure, private :: tsp_ot_obs
+ procedure, private :: tsp_ot_flow
+ procedure, private :: tsp_ot_flowja
+ procedure, private :: tsp_ot_dv
+ procedure, private :: tsp_ot_bdsummary
+ procedure, private :: create_lstfile
+ procedure, private :: create_tsp_packages
+ procedure, private :: log_namfile_options
+
end type TransportModelType
+ ! -- Module variables constant for simulation
+ integer(I4B), parameter :: NIUNIT = 100
+ character(len=LENFTYPE), dimension(NIUNIT) :: cunit
+ data cunit/'DIS6 ', 'DISV6', 'DISU6', 'IC6 ', 'MST6 ', & ! 5
+ 'ADV6 ', 'DSP6 ', 'SSM6 ', ' ', 'CNC6 ', & ! 10
+ 'OC6 ', 'OBS6 ', 'FMI6 ', 'SRC6 ', 'IST6 ', & ! 15
+ 'LKT6 ', 'SFT6 ', 'MWT6 ', 'UZT6 ', 'MVT6 ', & ! 20
+ 'API6 ', ' ', 'LKE6 ', 'SFE6 ', 'MWE6 ', & ! 25
+ 'UZE6 ', ' ', ' ', ' ', ' ', & ! 30
+ 70*' '/
+
+contains
+
+ !> @brief Create a new generalized transport model object
+ !!
+ !! Create a new transport model that will be further refined into GWT or GWE
+ !<
+ subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
+ ! -- modules
+ use SimModule, only: store_error
+ use MemoryManagerModule, only: mem_allocate
+ use MemoryHelperModule, only: create_mem_path
+ use MemoryManagerExtModule, only: mem_set_value
+ use SimVariablesModule, only: idm_context
+ use GwfNamInputModule, only: GwfNamParamFoundType
+ use BudgetModule, only: budget_cr
+ use ConstantsModule, only: LINELENGTH
+ use InputOutputModule, only: upcase
+ ! -- dummy
+ class(TransportModelType) :: this
+ character(len=*), intent(in) :: filename
+ integer(I4B), intent(in) :: id
+ integer(I4B), intent(inout) :: indis
+ character(len=*), intent(in) :: modelname
+ character(len=*), intent(in) :: macronym
+ ! -- local
+ character(len=LENMEMPATH) :: input_mempath
+ character(len=LINELENGTH) :: lst_fname
+ type(GwfNamParamFoundType) :: found
+! ------------------------------------------------------------------------------
+ !
+ ! -- Assign values
+ this%filename = filename
+ this%name = modelname
+ this%id = id
+ this%macronym = macronym
+ !
+ ! -- set input model namfile memory path
+ input_mempath = create_mem_path(modelname, 'NAM', idm_context)
+ !
+ ! -- copy option params from input context
+ call mem_set_value(lst_fname, 'LIST', input_mempath, found%list)
+ call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, &
+ found%print_input)
+ call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, &
+ found%print_flows)
+ call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, found%save_flows)
+ !
+ ! -- create the list file
+ call this%create_lstfile(lst_fname, filename, found%list)
+ !
+ ! -- activate save_flows if found
+ if (found%save_flows) then
+ this%ipakcb = -1
+ end if
+ !
+ ! -- log set options
+ if (this%iout > 0) then
+ call this%log_namfile_options(found)
+ end if
+ !
+ ! -- Create utility objects
+ call budget_cr(this%budget, this%name)
+ !
+ ! -- create model packages
+ call this%create_tsp_packages(indis)
+ !
+ ! -- Return
+ return
+ end subroutine tsp_cr
+
+ !> @brief Generalized transport model define model
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls the
+ !! define (df) routines for each attached package and sets variables and
+ !! pointers.
+ !<
+ subroutine tsp_df(this)
+ ! -- dummy variables
+ class(TransportModelType) :: this
+ !
+ ! -- Return
+ return
+ end subroutine tsp_df
+
+ !> @brief Generalized transport model add connections
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine adds the
+ !! internal connections of this model to the sparse matrix
+ !<
+ subroutine tsp_ac(this, sparse)
+ ! -- modules
+ use SparseModule, only: sparsematrix
+ ! -- dummy variables
+ class(TransportModelType) :: this
+ type(sparsematrix), intent(inout) :: sparse
+ ! -- local
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ac
+
+ !> @brief Generalized transport model map coefficients
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine maps the
+ !! positions of this models connections in the numerical solution coefficient
+ !! matrix.
+ !<
+ subroutine tsp_mc(this, matrix_sln)
+ ! -- dummy
+ class(TransportModelType) :: this
+ class(MatrixBaseType), pointer :: matrix_sln !< global system matrix
+ ! -- local
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_mc
+
+ !> @brief Generalized transport model allocate and read
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls
+ !! the allocate and reads (ar) routines of attached packages and allocates
+ !! memory for arrays required by the model object.
+ !<
+ subroutine tsp_ar(this)
+ ! -- dummy variables
+ class(TransportModelType) :: this
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ar
+
+ !> @brief Generalized transport model read and prepare
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls
+ !! the read and prepare (rp) routines of attached packages.
+ !<
+ subroutine tsp_rp(this)
+ ! -- dummy variables
+ class(TransportModelType) :: this
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_rp
+
+ !> @brief Generalized transport model time step advance
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls
+ !! the advance time step (ad) routines of attached packages.
+ !<
+ subroutine tsp_ad(this)
+ ! -- dummy variables
+ class(TransportModelType) :: this
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ad
+
+ !> @brief Generalized transport model fill coefficients
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls
+ !! the fill coefficients (fc) routines of attached packages.
+ !<
+ subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
+! ******************************************************************************
+! gwt_fc -- GroundWater Transport Model fill coefficients
+! ******************************************************************************
+!
+! SPECIFICATIONS:
+! ------------------------------------------------------------------------------
+ ! -- dummy variables
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: kiter
+ class(MatrixBaseType), pointer :: matrix_sln
+ integer(I4B), intent(in) :: inwtflag
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_fc
+
+ !> @brief Generalized transport model final convergence check
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calls
+ !! the convergence check (cc) routines of attached packages.
+ !<
+ subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: innertot
+ integer(I4B), intent(in) :: kiter
+ integer(I4B), intent(in) :: iend
+ integer(I4B), intent(in) :: icnvgmod
+ character(len=LENPAKLOC), intent(inout) :: cpak
+ integer(I4B), intent(inout) :: ipak
+ real(DP), intent(inout) :: dpak
+ ! -- local
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_cc
+
+ !> @brief Generalized transport model calculate flows
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calculates
+ !! intercell flows (flowja)
+ !<
+ subroutine tsp_cq(this, icnvg, isuppress_output)
+ ! -- dummy variables
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: icnvg
+ integer(I4B), intent(in) :: isuppress_output
+ ! -- local
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_cq
+
+ !> @brief Generalized transport model budget
+ !!
+ !! This subroutine extended by either GWT or GWE. This routine calculates
+ !! package contributions to model budget
+ !<
+ subroutine tsp_bd(this, icnvg, isuppress_output)
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: icnvg
+ integer(I4B), intent(in) :: isuppress_output
+! ------------------------------------------------------------------------------
+ !
+ ! -- Return
+ return
+ end subroutine tsp_bd
+
+ !> @brief Generalized transport model output routine
+ !!
+ !! Generalized transport model output
+ !<
+ subroutine tsp_ot(this, inmst)
+ ! -- modules
+ use TdisModule, only: kstp, kper, tdis_ot, endofperiod
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: inmst
+ ! -- local
+ integer(I4B) :: idvsave
+ integer(I4B) :: idvprint
+ integer(I4B) :: icbcfl
+ integer(I4B) :: icbcun
+ integer(I4B) :: ibudfl
+ integer(I4B) :: ipflag
+ ! -- formats
+ character(len=*), parameter :: fmtnocnvg = &
+ "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
+ &I0,' OF STRESS PERIOD ',I0,'****')"
+! ------------------------------------------------------------------------------
+ !
+ ! -- Set write and print flags
+ idvsave = 0
+ idvprint = 0
+ icbcfl = 0
+ ibudfl = 0
+ if (this%oc%oc_save(trim(this%depvartype))) idvsave = 1
+ if (this%oc%oc_print(trim(this%depvartype))) idvprint = 1
+ if (this%oc%oc_save('BUDGET')) icbcfl = 1
+ if (this%oc%oc_print('BUDGET')) ibudfl = 1
+ icbcun = this%oc%oc_save_unit('BUDGET')
+ !
+ ! -- Override ibudfl and idvprint flags for nonconvergence
+ ! and end of period
+ ibudfl = this%oc%set_print_flag('BUDGET', this%icnvg, endofperiod)
+ idvprint = this%oc%set_print_flag(trim(this%depvartype), &
+ this%icnvg, endofperiod)
+ !
+ ! Calculate and save observations
+ call this%tsp_ot_obs()
+ !
+ ! Save and print flows
+ call this%tsp_ot_flow(icbcfl, ibudfl, icbcun, inmst)
+ !
+ ! Save and print dependent variables
+ call this%tsp_ot_dv(idvsave, idvprint, ipflag)
+ !
+ ! Print budget summaries
+ call this%tsp_ot_bdsummary(ibudfl, ipflag)
+ !
+ ! -- Timing Output; if any dependendent variables or budgets
+ ! are printed, then ipflag is set to 1.
+ if (ipflag == 1) call tdis_ot(this%iout)
+ !
+ ! -- Write non-convergence message
+ if (this%icnvg == 0) then
+ write (this%iout, fmtnocnvg) kstp, kper
+ end if
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ot
+
+ !> @brief Generalized transport model output routine
+ !!
+ !! Calculate and save observations
+ !<
+ subroutine tsp_ot_obs(this)
+ class(TransportModelType) :: this
+ class(BndType), pointer :: packobj
+ integer(I4B) :: ip
+! ------------------------------------------------------------------------------
+ ! -- Calculate and save observations
+ call this%obs%obs_bd()
+ call this%obs%obs_ot()
+
+ ! -- Calculate and save package obserations
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_bd_obs()
+ call packobj%bnd_ot_obs()
+ end do
+
+ end subroutine tsp_ot_obs
+
+ !> @brief Generalized transport model output routine
+ !!
+ !! Save and print flows
+ !<
+ subroutine tsp_ot_flow(this, icbcfl, ibudfl, icbcun, inmst)
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: icbcfl
+ integer(I4B), intent(in) :: ibudfl
+ integer(I4B), intent(in) :: icbcun
+ integer(I4B), intent(in) :: inmst
+ ! -- local
+ class(BndType), pointer :: packobj
+ integer(I4B) :: ip
+! ------------------------------------------------------------------------------
+ ! -- Save TSP flows
+ call this%tsp_ot_flowja(this%nja, this%flowja, icbcfl, icbcun)
+ if (this%infmi > 0) call this%fmi%fmi_ot_flow(icbcfl, icbcun)
+ if (this%inssm > 0) then
+ call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
+ end if
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
+ end do
+
+ ! -- Save advanced package flows
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
+ end do
+ if (this%inmvt > 0) then
+ call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl)
+ end if
+
+ ! -- Print Model (GWT or GWE) flows
+ ! no need to print flowja
+ ! no need to print mst
+ ! no need to print fmi
+ if (this%inssm > 0) then
+ call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
+ end if
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
+ end do
+
+ ! -- Print advanced package flows
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
+ end do
+ if (this%inmvt > 0) then
+ call this%mvt%mvt_ot_printflow(icbcfl, ibudfl)
+ end if
+
+ end subroutine tsp_ot_flow
+
+ !> @brief Generalized transport model output routine
+ !!
+ !! Write intercell flows for the transport model
+ !<
+ subroutine tsp_ot_flowja(this, nja, flowja, icbcfl, icbcun)
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: nja
+ real(DP), dimension(nja), intent(in) :: flowja
+ integer(I4B), intent(in) :: icbcfl
+ integer(I4B), intent(in) :: icbcun
+ ! -- local
+ integer(I4B) :: ibinun
+ ! -- formats
+! ------------------------------------------------------------------------------
+ !
+ ! -- Set unit number for binary output
+ if (this%ipakcb < 0) then
+ ibinun = icbcun
+ elseif (this%ipakcb == 0) then
+ ibinun = 0
+ else
+ ibinun = this%ipakcb
+ end if
+ if (icbcfl == 0) ibinun = 0
+ !
+ ! -- Write the face flows if requested
+ if (ibinun /= 0) then
+ call this%dis%record_connection_array(flowja, ibinun, this%iout)
+ end if
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ot_flowja
+
+ !> @brief Generalized tranpsort model output routine
+ !!
+ !! Loop through attached packages saving and printing dependent variables
+ !<
+ subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag)
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: idvsave
+ integer(I4B), intent(in) :: idvprint
+ integer(I4B), intent(inout) :: ipflag
+ class(BndType), pointer :: packobj
+ integer(I4B) :: ip
+! ------------------------------------------------------------------------------
+ ! -- Print advanced package dependent variables
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_dv(idvsave, idvprint)
+ end do
+
+ ! -- save head and print head
+ call this%oc%oc_ot(ipflag)
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ot_dv
+
+ !> @brief Generalized tranpsort model output budget summary
+ !!
+ !! Loop through attached packages and write budget summaries
+ !<
+ subroutine tsp_ot_bdsummary(this, ibudfl, ipflag)
+ use TdisModule, only: kstp, kper, totim
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: ibudfl
+ integer(I4B), intent(inout) :: ipflag
+ class(BndType), pointer :: packobj
+ integer(I4B) :: ip
+
+ !
+ ! -- Package budget summary
+ do ip = 1, this%bndlist%Count()
+ packobj => GetBndFromList(this%bndlist, ip)
+ call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl)
+ end do
+
+ ! -- mover budget summary
+ if (this%inmvt > 0) then
+ call this%mvt%mvt_ot_bdsummary(ibudfl)
+ end if
+
+ ! -- model budget summary
+ if (ibudfl /= 0) then
+ ipflag = 1
+ call this%budget%budget_ot(kstp, kper, this%iout)
+ end if
+
+ ! -- Write to budget csv
+ call this%budget%writecsv(totim)
+ !
+ ! -- Return
+ return
+ end subroutine tsp_ot_bdsummary
+
+ !> @brief Allocate scalar variables for transport model
+ !!
+ !! Method to allocate memory for non-allocatable members.
+ !<
+ subroutine allocate_tsp_scalars(this, modelname)
+ ! -- modules
+ use MemoryManagerModule, only: mem_allocate
+ ! -- dummy
+ class(TransportModelType) :: this
+ character(len=*), intent(in) :: modelname
+! ------------------------------------------------------------------------------
+ !
+ ! -- allocate members from (grand)parent class
+ call this%NumericalModelType%allocate_scalars(modelname)
+ !
+ ! -- allocate members that are part of model class
+ call mem_allocate(this%inic, 'INIC', this%memoryPath)
+ call mem_allocate(this%infmi, 'INFMI', this%memoryPath)
+ call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
+ call mem_allocate(this%inadv, 'INADV', this%memoryPath)
+ call mem_allocate(this%inssm, 'INSSM', this%memoryPath)
+ call mem_allocate(this%inoc, 'INOC ', this%memoryPath)
+ call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
+ call mem_allocate(this%eqnsclfac, 'EQNSCLFAC', this%memoryPath)
+ !
+ this%inic = 0
+ this%infmi = 0
+ this%inmvt = 0
+ this%inadv = 0
+ this%inssm = 0
+ this%inoc = 0
+ this%inobs = 0
+ this%eqnsclfac = DZERO
+ !
+ ! -- Return
+ return
+ end subroutine allocate_tsp_scalars
+
+ !> @brief Define the labels corresponding to the flavor of
+ !! transport model
+ !!
+ !! Set variable names according to type of transport model
+ !<
+ subroutine set_tsp_labels(this, tsptype, depvartype, depvarunit, &
+ depvarunitabbrev)
+ class(TransportModelType) :: this
+ character(len=*), intent(in), pointer :: tsptype !< type of model, default is GWT (alternative is GWE)
+ character(len=*), intent(in) :: depvartype !< dependent variable type, default is "CONCENTRATION"
+ character(len=*), intent(in) :: depvarunit !< units of dependent variable for writing to list file
+ character(len=*), intent(in) :: depvarunitabbrev !< abbreviation of associated units
+ !
+ ! -- Set the model type
+ this%tsptype = tsptype
+ !
+ ! -- Set the type of dependent variable being solved for
+ this%depvartype = depvartype
+ !
+ ! -- Set the units associated with the dependent variable
+ this%depvarunit = depvarunit
+ !
+ ! -- Set the units abbreviation
+ this%depvarunitabbrev = depvarunitabbrev
+ !
+ ! -- Return
+ return
+ end subroutine set_tsp_labels
+
+ !> @brief Deallocate memory
+ !!
+ !! Deallocate memmory at conclusion of model run
+ !<
+ subroutine tsp_da(this)
+ ! -- modules
+ use MemoryManagerModule, only: mem_deallocate
+ ! -- dummy
+ class(TransportModelType) :: this
+ ! -- local
+! ------------------------------------------------------------------------------
+ !
+ ! -- Scalars
+ call mem_deallocate(this%inic)
+ call mem_deallocate(this%infmi)
+ call mem_deallocate(this%inadv)
+ call mem_deallocate(this%inssm)
+ call mem_deallocate(this%inmvt)
+ call mem_deallocate(this%inoc)
+ call mem_deallocate(this%inobs)
+ call mem_deallocate(this%eqnsclfac)
+ !
+ ! -- Return
+ return
+ end subroutine tsp_da
+
+ !> @brief Generalized tranpsort model routine
+ !!
+ !! Check to make sure required input files have been specified
+ !<
+ subroutine ftype_check(this, indis, inmst)
+ ! -- modules
+ use ConstantsModule, only: LINELENGTH
+ use SimModule, only: store_error, count_errors, store_error_filename
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(in) :: indis
+ integer(I4B), intent(in) :: inmst
+ ! -- local
+ character(len=LINELENGTH) :: errmsg
+! ------------------------------------------------------------------------------
+ !
+ ! -- Check for IC6, DIS(u), and MST. Stop if not present.
+ if (this%inic == 0) then
+ write (errmsg, '(a)') &
+ 'Initial conditions (IC6) package not specified.'
+ call store_error(errmsg)
+ end if
+ if (indis == 0) then
+ write (errmsg, '(a)') &
+ 'Discretization (DIS6 or DISU6) package not specified.'
+ call store_error(errmsg)
+ end if
+ if (inmst == 0) then
+ write (errmsg, '(a)') 'Mass storage and transfer (MST6) &
+ &package not specified.'
+ call store_error(errmsg)
+ end if
+ !
+ if (count_errors() > 0) then
+ write (errmsg, '(a)') 'Required package(s) not specified.'
+ call store_error(errmsg)
+ call store_error_filename(this%filename)
+ end if
+ !
+ ! -- Return
+ return
+ end subroutine ftype_check
+
+ !> @brief Create listing output file
+ !<
+ subroutine create_lstfile(this, lst_fname, model_fname, defined)
+ ! -- modules
+ use KindModule, only: LGP
+ use InputOutputModule, only: openfile, getunit
+ ! -- dummy
+ class(TransportModelType) :: this
+ character(len=*), intent(inout) :: lst_fname
+ character(len=*), intent(in) :: model_fname
+ logical(LGP), intent(in) :: defined
+ ! -- local
+ integer(I4B) :: i, istart, istop
+ !
+ ! -- set list file name if not provided
+ if (.not. defined) then
+ !
+ ! -- initialize
+ lst_fname = ' '
+ istart = 0
+ istop = len_trim(model_fname)
+ !
+ ! -- identify '.' character position from back of string
+ do i = istop, 1, -1
+ if (model_fname(i:i) == '.') then
+ istart = i
+ exit
+ end if
+ end do
+ !
+ ! -- if not found start from string end
+ if (istart == 0) istart = istop + 1
+ !
+ ! -- set list file name
+ lst_fname = model_fname(1:istart)
+ istop = istart + 3
+ lst_fname(istart:istop) = '.lst'
+ end if
+ !
+ ! -- create the list file
+ this%iout = getunit()
+ call openfile(this%iout, 0, lst_fname, 'LIST', filstat_opt='REPLACE')
+ !
+ ! -- write list file header
+ call write_listfile_header(this%iout, 'GROUNDWATER TRANSPORT MODEL (GWT)')
+ !
+ ! -- Return
+ return
+ end subroutine create_lstfile
+
+ !> @brief Write model name file options to list file
+ !<
+ subroutine log_namfile_options(this, found)
+ use GwfNamInputModule, only: GwfNamParamFoundType
+ class(TransportModelType) :: this
+ type(GwfNamParamFoundType), intent(in) :: found
+
+ write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:'
+
+ if (found%newton) then
+ write (this%iout, '(4x,a)') &
+ 'NEWTON-RAPHSON method enabled for the model.'
+ if (found%under_relaxation) then
+ write (this%iout, '(4x,a,a)') &
+ 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', &
+ 'elevation of the model will be applied to the model.'
+ end if
+ end if
+
+ if (found%print_input) then
+ write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// &
+ 'FOR ALL MODEL STRESS PACKAGES'
+ end if
+
+ if (found%print_flows) then
+ write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// &
+ 'FOR ALL MODEL PACKAGES'
+ end if
+
+ if (found%save_flows) then
+ write (this%iout, '(4x,a)') &
+ 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
+ end if
+
+ write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:'
+ end subroutine log_namfile_options
+
+ !> @brief Source package info and begin to process
+ !<
+ subroutine create_tsp_packages(this, indis)
+ ! -- modules
+ use ConstantsModule, only: LINELENGTH, LENPACKAGENAME
+ use CharacterStringModule, only: CharacterStringType
+ use ArrayHandlersModule, only: expandarray
+ use MemoryManagerModule, only: mem_setptr
+ use MemoryHelperModule, only: create_mem_path
+ use SimVariablesModule, only: idm_context
+ use GwfDisModule, only: dis_cr
+ use GwfDisvModule, only: disv_cr
+ use GwfDisuModule, only: disu_cr
+ use TspIcModule, only: ic_cr
+ use TspFmiModule, only: fmi_cr
+ use TspAdvModule, only: adv_cr
+ use TspSsmModule, only: ssm_cr
+ use TspMvtModule, only: mvt_cr
+ use TspOcModule, only: oc_cr
+ use TspObsModule, only: tsp_obs_cr
+ ! -- dummy
+ class(TransportModelType) :: this
+ integer(I4B), intent(inout) :: indis ! DIS enabled flag
+ ! -- local
+ type(CharacterStringType), dimension(:), contiguous, &
+ pointer :: pkgtypes => null()
+ type(CharacterStringType), dimension(:), contiguous, &
+ pointer :: pkgnames => null()
+ type(CharacterStringType), dimension(:), contiguous, &
+ pointer :: mempaths => null()
+ integer(I4B), dimension(:), contiguous, &
+ pointer :: inunits => null()
+ character(len=LENMEMPATH) :: model_mempath
+ character(len=LENFTYPE) :: pkgtype
+ character(len=LENPACKAGENAME) :: pkgname
+ character(len=LENMEMPATH) :: mempath
+ integer(I4B), pointer :: inunit
+ integer(I4B) :: n
+ !
+ ! -- Initialize
+ indis = 0
+ !
+ ! -- set input memory paths, input/model and input/model/namfile
+ model_mempath = create_mem_path(component=this%name, context=idm_context)
+ !
+ ! -- set pointers to model path package info
+ call mem_setptr(pkgtypes, 'PKGTYPES', model_mempath)
+ call mem_setptr(pkgnames, 'PKGNAMES', model_mempath)
+ call mem_setptr(mempaths, 'MEMPATHS', model_mempath)
+ call mem_setptr(inunits, 'INUNITS', model_mempath)
+ !
+ do n = 1, size(pkgtypes)
+ !
+ ! attributes for this input package
+ pkgtype = pkgtypes(n)
+ pkgname = pkgnames(n)
+ mempath = mempaths(n)
+ inunit => inunits(n)
+ !
+ ! -- create dis package as it is a prerequisite for other packages
+ select case (pkgtype)
+ case ('DIS6')
+ indis = 1
+ call dis_cr(this%dis, this%name, mempath, indis, this%iout)
+ case ('DISV6')
+ indis = 1
+ call disv_cr(this%dis, this%name, mempath, indis, this%iout)
+ case ('DISU6')
+ indis = 1
+ call disu_cr(this%dis, this%name, mempath, indis, this%iout)
+ case ('IC6')
+ this%inic = inunit
+ case ('FMI6')
+ this%infmi = inunit
+ case ('MVT6')
+ this%inmvt = inunit
+ case ('ADV6')
+ this%inadv = inunit
+ case ('SSM6')
+ this%inssm = inunit
+ case ('OC6')
+ this%inoc = inunit
+ case ('OBS6')
+ this%inobs = inunit
+ !case default
+ ! TODO
+ end select
+ end do
+ !
+ ! -- Create packages that are tied directly to model
+ call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis, &
+ this%depvartype)
+ call fmi_cr(this%fmi, this%name, this%infmi, this%iout, this%eqnsclfac, &
+ this%depvartype)
+ call adv_cr(this%adv, this%name, this%inadv, this%iout, this%fmi, &
+ this%eqnsclfac)
+ call ssm_cr(this%ssm, this%name, this%inssm, this%iout, this%fmi, &
+ this%eqnsclfac, this%depvartype)
+ call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi, &
+ this%eqnsclfac)
+ call oc_cr(this%oc, this%name, this%inoc, this%iout)
+ call tsp_obs_cr(this%obs, this%inobs)
+ !
+ ! -- Return
+ return
+ end subroutine create_tsp_packages
+
end module TransportModelModule
diff --git a/src/Model/GroundWaterTransport/gwt1adv1.f90 b/src/Model/TransportModel/tsp1adv1.f90
similarity index 74%
rename from src/Model/GroundWaterTransport/gwt1adv1.f90
rename to src/Model/TransportModel/tsp1adv1.f90
index 0e9f4bdb487..7e3b25bf1ed 100644
--- a/src/Model/GroundWaterTransport/gwt1adv1.f90
+++ b/src/Model/TransportModel/tsp1adv1.f90
@@ -1,23 +1,26 @@
-module GwtAdvModule
+module TspAdvModule
use KindModule, only: DP, I4B
use ConstantsModule, only: DONE, DZERO, DHALF, DTWO
use NumericalPackageModule, only: NumericalPackageType
use BaseDisModule, only: DisBaseType
- use GwtFmiModule, only: GwtFmiType
- use GwtAdvOptionsModule, only: GwtAdvOptionsType
+ use TspFmiModule, only: TspFmiType
+ use TspAdvOptionsModule, only: TspAdvOptionsType
use MatrixBaseModule
implicit none
private
- public :: GwtAdvType
+ public :: TspAdvType
public :: adv_cr
- type, extends(NumericalPackageType) :: GwtAdvType
+ type, extends(NumericalPackageType) :: TspAdvType
integer(I4B), pointer :: iadvwt => null() !< advection scheme (0 up, 1 central, 2 tvd)
integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound
- type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object
+ type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object
+ real(DP), dimension(:), pointer, contiguous :: cpw => null() ! pointer to GWE heat capacity of water
+ real(DP), dimension(:), pointer, contiguous :: rhow => null() ! fixed density of water
+ real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy
contains
@@ -34,23 +37,22 @@ module GwtAdvModule
procedure :: adv_weight
procedure :: advtvd
- end type GwtAdvType
+ end type TspAdvType
contains
- subroutine adv_cr(advobj, name_model, inunit, iout, fmi)
-! ******************************************************************************
-! adv_cr -- Create a new ADV object
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @ brief Create a new ADV object
+ !!
+ !! Create a new ADV package
+ !<
+ subroutine adv_cr(advobj, name_model, inunit, iout, fmi, eqnsclfac)
! -- dummy
- type(GwtAdvType), pointer :: advobj
+ type(TspAdvType), pointer :: advobj
character(len=*), intent(in) :: name_model
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
- type(GwtFmiType), intent(in), target :: fmi
+ type(TspFmiType), intent(in), target :: fmi
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
! ------------------------------------------------------------------------------
!
! -- Create the object
@@ -66,18 +68,25 @@ subroutine adv_cr(advobj, name_model, inunit, iout, fmi)
advobj%inunit = inunit
advobj%iout = iout
advobj%fmi => fmi
+ advobj%eqnsclfac => eqnsclfac
!
! -- Return
return
end subroutine adv_cr
+ !> @brief Define ADV object
+ !!
+ !! Define the ADV package
+ !<
subroutine adv_df(this, adv_options)
- class(GwtAdvType) :: this
- type(GwtAdvOptionsType), optional, intent(in) :: adv_options !< the optional options, for when not constructing from file
- ! local
+ ! -- dummy
+ class(TspAdvType) :: this
+ type(TspAdvOptionsType), optional, intent(in) :: adv_options !< the optional options, for when not constructing from file
+ ! -- local
character(len=*), parameter :: fmtadv = &
"(1x,/1x,'ADV-- ADVECTION PACKAGE, VERSION 1, 8/25/2017', &
&' INPUT READ FROM UNIT ', i0, //)"
+! ------------------------------------------------------------------------------
!
! -- Read or set advection options
if (.not. present(adv_options)) then
@@ -96,21 +105,23 @@ subroutine adv_df(this, adv_options)
! --set options from input arg
this%iadvwt = adv_options%iAdvScheme
end if
-
+ !
+ ! -- Return
+ return
end subroutine adv_df
- subroutine adv_ar(this, dis, ibound)
-! ******************************************************************************
-! adv_ar -- Allocate and Read
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Allocate and read method for package
+ !!
+ !! Method to allocate and read static data for the ADV package.
+ !<
+ subroutine adv_ar(this, dis, ibound, cpw, rhow)
! -- modules
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
class(DisBaseType), pointer, intent(in) :: dis
- integer(I4B), dimension(:), pointer, contiguous :: ibound
+ integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ibound
+ real(DP), dimension(:), pointer, contiguous, optional, intent(in) :: cpw
+ real(DP), dimension(:), pointer, contiguous, optional, intent(in) :: rhow
! -- local
! -- formats
! ------------------------------------------------------------------------------
@@ -119,20 +130,22 @@ subroutine adv_ar(this, dis, ibound)
this%dis => dis
this%ibound => ibound
!
+ ! -- if part of a GWE simulation, need heat capacity(cpw) and density (rhow)
+ if (present(cpw)) this%cpw => cpw
+ if (present(rhow)) this%rhow => rhow
+ !
! -- Return
return
end subroutine adv_ar
+ !> @brief Fill coefficient method for ADV package
+ !!
+ !! Method to calculate coefficients and fill amat and rhs.
+ !<
subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs)
-! ******************************************************************************
-! adv_fc -- Calculate coefficients and fill amat and rhs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
integer, intent(in) :: nodes
class(MatrixBaseType), pointer :: matrix_sln
integer(I4B), intent(in), dimension(:) :: idxglo
@@ -152,7 +165,8 @@ subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs)
if (this%dis%con%mask(ipos) == 0) cycle
m = this%dis%con%ja(ipos)
if (this%ibound(m) == 0) cycle
- qnm = this%fmi%gwfflowja(ipos)
+!! qnm = this%fmi%gwfflowja(ipos)
+ qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac
omega = this%adv_weight(this%iadvwt, ipos, n, m, qnm)
call matrix_sln%add_value_pos(idxglo(ipos), qnm * (DONE - omega))
call matrix_sln%add_value_pos(idxglo(idiag), qnm * omega)
@@ -171,16 +185,15 @@ subroutine adv_fc(this, nodes, matrix_sln, idxglo, cnew, rhs)
return
end subroutine adv_fc
+ !> @brief Calculate TVD
+ !!
+ !! Use explicit scheme to calculate the advective component of transport.
+ !! TVD is an acronym for Total-Variation Diminishing
+ !<
subroutine advtvd(this, n, cnew, rhs)
-! ******************************************************************************
-! advtvd -- Calculate TVD
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
integer(I4B), intent(in) :: n
real(DP), dimension(:), intent(in) :: cnew
real(DP), dimension(:), intent(inout) :: rhs
@@ -204,19 +217,18 @@ subroutine advtvd(this, n, cnew, rhs)
return
end subroutine advtvd
+ !> @brief Calculate TVD
+ !!
+ !! Use explicit scheme to calculate the advective component of transport.
+ !! TVD is an acronym for Total-Variation Diminishing
+ !<
function advqtvd(this, n, m, iposnm, cnew) result(qtvd)
-! ******************************************************************************
-! advqtvd -- Calculate TVD
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: DPREC
- ! -- return
+ ! -- Return
real(DP) :: qtvd
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
integer(I4B), intent(in) :: n
integer(I4B), intent(in) :: m
integer(I4B), intent(in) :: iposnm
@@ -269,6 +281,7 @@ function advqtvd(this, n, m, iposnm, cnew) result(qtvd)
if (smooth > DZERO) then
alimiter = DTWO * smooth / (DONE + smooth)
qtvd = DHALF * alimiter * qnm * (cnew(idn) - cnew(iup))
+ qtvd = qtvd * this%eqnsclfac
end if
end if
!
@@ -276,16 +289,12 @@ function advqtvd(this, n, m, iposnm, cnew) result(qtvd)
return
end function advqtvd
+ !> @brief Calculate advection contribution to flowja
+ !<
subroutine adv_cq(this, cnew, flowja)
-! ******************************************************************************
-! adv_cq -- Calculate advection contribution to flowja
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
real(DP), intent(in), dimension(:) :: cnew
real(DP), intent(inout), dimension(:) :: flowja
! -- local
@@ -303,7 +312,7 @@ subroutine adv_cq(this, cnew, flowja)
do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
m = this%dis%con%ja(ipos)
if (this%ibound(m) == 0) cycle
- qnm = this%fmi%gwfflowja(ipos)
+ qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac
omega = this%adv_weight(this%iadvwt, ipos, n, m, qnm)
flowja(ipos) = flowja(ipos) + qnm * omega * cnew(n) + &
qnm * (DONE - omega) * cnew(m)
@@ -317,16 +326,11 @@ subroutine adv_cq(this, cnew, flowja)
return
end subroutine adv_cq
+ !> @brief Add TVD contribution to flowja
subroutine advtvd_bd(this, cnew, flowja)
-! ******************************************************************************
-! advtvd_bd -- Add TVD contribution to flowja
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
real(DP), dimension(:), intent(in) :: cnew
real(DP), dimension(:), intent(inout) :: flowja
! -- local
@@ -351,17 +355,13 @@ subroutine advtvd_bd(this, cnew, flowja)
return
end subroutine advtvd_bd
+ !> @brief Deallocate memory
+ !<
subroutine adv_da(this)
-! ******************************************************************************
-! adv_da -- Deallocate variables
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
! ------------------------------------------------------------------------------
!
! -- Deallocate arrays if package was active
@@ -370,6 +370,8 @@ subroutine adv_da(this)
!
! -- nullify pointers
this%ibound => null()
+ nullify (this%cpw)
+ nullify (this%rhow)
!
! -- Scalars
call mem_deallocate(this%iadvwt)
@@ -381,17 +383,14 @@ subroutine adv_da(this)
return
end subroutine adv_da
+ !> @brief Allocate scalars specific to the streamflow energy transport (SFE)
+ !! package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -411,18 +410,16 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Read options
+ !!
+ !! Read the options block
+ !<
subroutine read_options(this)
-! ******************************************************************************
-! read_options -- Allocate and Read
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LINELENGTH
use SimModule, only: store_error
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
! -- local
character(len=LINELENGTH) :: errmsg, keyword
integer(I4B) :: ierr
@@ -478,17 +475,15 @@ subroutine read_options(this)
return
end subroutine read_options
+ !> @ brief Advection weight
+ !!
+ !! Calculate the advection weight
+ !<
function adv_weight(this, iadvwt, ipos, n, m, qnm) result(omega)
-! ******************************************************************************
-! adv_weight -- calculate advection weight
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- ! -- return
+ ! -- Return
real(DP) :: omega
! -- dummy
- class(GwtAdvType) :: this
+ class(TspAdvType) :: this
integer, intent(in) :: iadvwt
integer, intent(in) :: ipos
integer, intent(in) :: n
@@ -520,8 +515,8 @@ function adv_weight(this, iadvwt, ipos, n, m, qnm) result(omega)
end if
end select
!
- ! -- return
+ ! -- Return
return
end function adv_weight
-end module GwtAdvModule
+end module TspAdvModule
diff --git a/src/Model/GroundWaterTransport/gwt1apt1.f90 b/src/Model/TransportModel/tsp1apt1.f90
similarity index 80%
rename from src/Model/GroundWaterTransport/gwt1apt1.f90
rename to src/Model/TransportModel/tsp1apt1.f90
index 6f50995ac4c..47a927a95ee 100644
--- a/src/Model/GroundWaterTransport/gwt1apt1.f90
+++ b/src/Model/TransportModel/tsp1apt1.f90
@@ -12,12 +12,12 @@
! FLOW-JA-FACE idxbudfjf FLOW-JA-FACE cv2cv
! GWF (aux FLOW-AREA) idxbudgwf GWF cv2gwf
! STORAGE (aux VOLUME) idxbudsto none used for cv volumes
-! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:)
+! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:) ! kluge note: rhow*cpw also applies to various terms for heat transport
! TO-MVR idxbudtmvr TO-MVR q * cfeat
! -- generalized source/sink terms (except ET?)
! RAINFALL idxbudrain RAINFALL q * crain
-! EVAPORATION idxbudevap EVAPORATION cfeat null() !< active, inactive, constant
- character(len=LENAUXNAME) :: cauxfpconc = '' !< name of aux column in flow package auxvar array for concentration
+ character(len=LENAUXNAME) :: cauxfpconc = '' !< name of aux column in flow package auxvar array for concentration (or temperature)
integer(I4B), pointer :: iauxfpconc => null() !< column in flow package bound array to insert concs
integer(I4B), pointer :: imatrows => null() !< if active, add new rows to matrix
integer(I4B), pointer :: iprconc => null() !< print conc to listing file
@@ -76,7 +77,11 @@ module GwtAptModule
integer(I4B), pointer :: ibudcsv => null() !< unit number for csv budget output file
integer(I4B), pointer :: ncv => null() !< number of control volumes
integer(I4B), pointer :: igwfaptpak => null() !< package number of corresponding this package
- real(DP), dimension(:), pointer, contiguous :: strt => null() !< starting feature concentration
+ integer(I4B), pointer :: idxprepak => null() !< budget-object index that precedes package-specific budget objects
+ integer(I4B), pointer :: idxlastpak => null() !< budget-object index of last package-specific budget object
+ real(DP), dimension(:), pointer, contiguous :: strt => null() !< starting feature concentration (or temperature)
+ real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the apt and groundwater cell
+ real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed/lakebed/filter-pack material through which thermal conduction occurs
integer(I4B), dimension(:), pointer, contiguous :: idxlocnode => null() !< map position in global rhs and x array of pack entry
integer(I4B), dimension(:), pointer, contiguous :: idxpakdiag => null() !< map diag position of feature in global amat
integer(I4B), dimension(:), pointer, contiguous :: idxdglo => null() !< map position in global array of package diagonal row entries
@@ -86,16 +91,16 @@ module GwtAptModule
integer(I4B), dimension(:), pointer, contiguous :: idxfjfdglo => null() !< map diagonal feature to feature in global amat
integer(I4B), dimension(:), pointer, contiguous :: idxfjfoffdglo => null() !< map off diagonal feature to feature in global amat
integer(I4B), dimension(:), pointer, contiguous :: iboundpak => null() !< package ibound
- real(DP), dimension(:), pointer, contiguous :: xnewpak => null() !< feature concentration for current time step
- real(DP), dimension(:), pointer, contiguous :: xoldpak => null() !< feature concentration from previous time step
+ real(DP), dimension(:), pointer, contiguous :: xnewpak => null() !< feature concentration (or temperature) for current time step
+ real(DP), dimension(:), pointer, contiguous :: xoldpak => null() !< feature concentration (or temperature) from previous time step
real(DP), dimension(:), pointer, contiguous :: dbuff => null() !< temporary storage array
character(len=LENBOUNDNAME), &
dimension(:), pointer, contiguous :: featname => null()
- real(DP), dimension(:), pointer, contiguous :: concfeat => null() !< concentration of the feature
+ real(DP), dimension(:), pointer, contiguous :: concfeat => null() !< concentration (or temperature) of the feature
real(DP), dimension(:, :), pointer, contiguous :: lauxvar => null() !< auxiliary variable
- type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object
- real(DP), dimension(:), pointer, contiguous :: qsto => null() !< mass flux due to storage change
- real(DP), dimension(:), pointer, contiguous :: ccterm => null() !< mass flux required to maintain constant concentration
+ type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object
+ real(DP), dimension(:), pointer, contiguous :: qsto => null() !< mass (or energy) flux due to storage change
+ real(DP), dimension(:), pointer, contiguous :: ccterm => null() !< mass (or energy) flux required to maintain constant concentration (or temperature)
integer(I4B), pointer :: idxbudfjf => null() !< index of flow ja face in flowbudptr
integer(I4B), pointer :: idxbudgwf => null() !< index of gwf terms in flowbudptr
integer(I4B), pointer :: idxbudsto => null() !< index of storage terms in flowbudptr
@@ -104,8 +109,12 @@ module GwtAptModule
integer(I4B), pointer :: idxbudaux => null() !< index of auxiliary terms in flowbudptr
integer(I4B), dimension(:), pointer, contiguous :: idxbudssm => null() !< flag that flowbudptr%buditem is a general solute source/sink
integer(I4B), pointer :: nconcbudssm => null() !< number of concbudssm terms (columns)
- real(DP), dimension(:, :), pointer, contiguous :: concbudssm => null() !< user specified concentrations for flow terms
- real(DP), dimension(:), pointer, contiguous :: qmfrommvr => null() !< a mass flow coming from the mover that needs to be added
+ real(DP), dimension(:, :), pointer, contiguous :: concbudssm => null() !< user specified concentrations (or temperatures) for flow terms
+ real(DP), dimension(:), pointer, contiguous :: qmfrommvr => null() !< a mass or energy flow coming from the mover that needs to be added
+ real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy
+ character(len=LENVARNAME) :: depvartype = '' !< stores string identifying dependent variable type, depending on model type
+ character(len=LENVARNAME) :: depvarunit = '' !< "mass" or "energy"
+ character(len=LENVARNAME) :: depvarunitabbrev = '' !< "M" or "E"
!
! -- pointer to flow package boundary
type(BndType), pointer :: flowpackagebnd => null()
@@ -127,10 +136,10 @@ module GwtAptModule
procedure :: bnd_ad => apt_ad
procedure :: bnd_cf => apt_cf
procedure :: bnd_fc => apt_fc
- procedure, private :: apt_fc_expanded
+ procedure, public :: apt_fc_expanded ! Made public for uze
procedure :: pak_fc_expanded
procedure, private :: apt_fc_nonexpanded
- procedure, private :: apt_cfupdate
+ procedure, public :: apt_cfupdate ! Made public for uze
procedure :: apt_check_valid
procedure :: apt_set_stressperiod
procedure :: pak_set_stressperiod
@@ -168,27 +177,24 @@ module GwtAptModule
procedure :: pak_setup_budobj
procedure :: apt_fill_budobj
procedure :: pak_fill_budobj
- procedure, private :: apt_stor_term
- procedure, private :: apt_tmvr_term
- procedure, private :: apt_fjf_term
+ procedure, public :: apt_stor_term
+ procedure, public :: apt_tmvr_term
+ procedure, public :: apt_fmvr_term ! Made public for uze
+ procedure, public :: apt_fjf_term ! Made public for uze
procedure, private :: apt_copy2flowp
procedure, private :: apt_setup_tableobj
- end type GwtAptType
+ end type TspAptType
contains
+ !> @brief Add package connection to matrix
+ !<
subroutine apt_ac(this, moffset, sparse)
-! ******************************************************************************
-! bnd_ac -- Add package connection to matrix
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use MemoryManagerModule, only: mem_setptr
use SparseModule, only: sparsematrix
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
integer(I4B), intent(in) :: moffset
type(sparsematrix), intent(inout) :: sparse
! -- local
@@ -229,20 +235,16 @@ subroutine apt_ac(this, moffset, sparse)
end if
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_ac
+ !> @brief Advanced package transport map package connections to matrix
+ !<
subroutine apt_mc(this, moffset, matrix_sln)
-! ******************************************************************************
-! apt_mc -- map package connection to matrix
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use SparseModule, only: sparsematrix
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
integer(I4B), intent(in) :: moffset
class(MatrixBaseType), pointer :: matrix_sln
! -- local
@@ -250,7 +252,6 @@ subroutine apt_mc(this, moffset, matrix_sln)
integer(I4B) :: ipos
! -- format
! ------------------------------------------------------------------------------
- !
!
! -- allocate memory for index arrays
call this%apt_allocate_index_arrays()
@@ -299,20 +300,16 @@ subroutine apt_mc(this, moffset, matrix_sln)
end if
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_mc
+ !> @brief Advanced package transport allocate and read (ar) routine
+ !<
subroutine apt_ar(this)
-! ******************************************************************************
-! apt_ar -- Allocate and Read
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: j
logical :: found
@@ -346,8 +343,8 @@ subroutine apt_ar(this)
this%fmi%datp(this%igwfaptpak)%qmfrommvr => this%qmfrommvr
!
! -- If there is an associated flow package and the user wishes to put
- ! simulated concentrations into a aux variable column, then find
- ! the column number.
+ ! simulated concentrations (or temperatures) into a aux variable
+ ! column, then find the column number.
if (associated(this%flowpackagebnd)) then
if (this%cauxfpconc /= '') then
found = .false.
@@ -376,18 +373,14 @@ subroutine apt_ar(this)
return
end subroutine apt_ar
+ !> @brief Advanced package transport read and prepare (rp) routine
+ !!
+ !! This subroutine calls the attached packages' read and prepare routines.
+ !<
subroutine apt_rp(this)
-! ******************************************************************************
-! apt_rp -- Read and Prepare
-! Subroutine: (1) read itmp
-! (2) read new boundaries if itmp>0
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use TdisModule, only: kper, nper
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: ierr
integer(I4B) :: n
@@ -498,22 +491,20 @@ subroutine apt_rp(this)
this%nodelist(n) = igwfnode
end do
!
- ! -- return
+ ! -- Return
return
end subroutine apt_rp
+ !> @brief Advanced package transport set stress period routine.
+ !!
+ !! Set a stress period attribute for an advanced transport package feature
+ !! (itemno) using keywords.
+ !<
subroutine apt_set_stressperiod(this, itemno)
-! ******************************************************************************
-! apt_set_stressperiod -- Set a stress period attribute for feature (itemno)
-! using keywords.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- module
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
integer(I4B), intent(in) :: itemno
! -- local
character(len=LINELENGTH) :: text
@@ -527,9 +518,9 @@ subroutine apt_set_stressperiod(this, itemno)
! -- formats
! ------------------------------------------------------------------------------
!
- ! -- Support these general options with apply to LKT, SFT, MWT, UZT
+ ! -- Support these general options in LKT, SFT, MWT, UZT
! STATUS
- ! CONCENTRATION
+ ! CONCENTRATION or TEMPERATURE
! WITHDRAWAL
! AUXILIARY
!
@@ -554,7 +545,7 @@ subroutine apt_set_stressperiod(this, itemno)
'Unknown '//trim(this%text)//' status keyword: ', text//'.'
call store_error(errmsg)
end if
- case ('CONCENTRATION')
+ case ('CONCENTRATION', 'TEMPERATURE')
ierr = this%apt_check_valid(itemno)
if (ierr /= 0) then
goto 999
@@ -564,7 +555,7 @@ subroutine apt_set_stressperiod(this, itemno)
bndElem => this%concfeat(itemno)
call read_value_or_time_series_adv(text, itemno, jj, bndElem, &
this%packName, 'BND', this%tsManager, &
- this%iprpak, 'CONCENTRATION')
+ this%iprpak, this%depvartype)
case ('AUXILIARY')
ierr = this%apt_check_valid(itemno)
if (ierr /= 0) then
@@ -601,20 +592,18 @@ subroutine apt_set_stressperiod(this, itemno)
call this%parser%StoreErrorUnit()
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_set_stressperiod
+ !> @brief Advanced package transport set stress period routine.
+ !!
+ !! Set a stress period attribute for an individual package. This routine
+ !! must be overridden.
+ !<
subroutine pak_set_stressperiod(this, itemno, keyword, found)
-! ******************************************************************************
-! pak_set_stressperiod -- Set a stress period attribute for individual package.
-! This must be overridden.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
integer(I4B), intent(in) :: itemno
character(len=*), intent(in) :: keyword
logical, intent(inout) :: found
@@ -628,19 +617,19 @@ subroutine pak_set_stressperiod(this, itemno, keyword, found)
call store_error('Program error: pak_set_stressperiod not implemented.', &
terminate=.TRUE.)
!
- ! -- return
+ ! -- Return
return
end subroutine pak_set_stressperiod
+ !> @brief Advanced package transport routine
+ !!
+ !! Determine if a valid feature number has been specified.
+ !<
function apt_check_valid(this, itemno) result(ierr)
-! ******************************************************************************
-! apt_check_valid -- Determine if a valid feature number has been
-! specified.
-! ******************************************************************************
- ! -- return
+ ! -- Return
integer(I4B) :: ierr
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
integer(I4B), intent(in) :: itemno
! -- local
! -- formats
@@ -654,17 +643,15 @@ function apt_check_valid(this, itemno) result(ierr)
end if
end function apt_check_valid
+ !> @brief Advanced package transport routine
+ !!
+ !! Add package connections to matrix
+ !<
subroutine apt_ad(this)
-! ******************************************************************************
-! apt_ad -- Add package connection to matrix
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use SimVariablesModule, only: iFailedStepRetry
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: n
integer(I4B) :: j, iaux
@@ -685,8 +672,8 @@ subroutine apt_ad(this)
end do
end if
!
- ! -- copy xnew into xold and set xnewpak to specified concentration for
- ! constant concentration features
+ ! -- copy xnew into xold and set xnewpak to specified concentration (or
+ ! temperature) for constant concentration/temperature features
if (iFailedStepRetry == 0) then
do n = 1, this%ncv
this%xoldpak(n) = this%xnewpak(n)
@@ -713,19 +700,18 @@ subroutine apt_ad(this)
! "current" value.
call this%obs%obs_ad()
!
- ! -- return
+ ! -- Return
return
end subroutine apt_ad
!> @ brief Formulate the package hcof and rhs terms.
!!
- !! For the APT Package, the sole purpose here is to
- !! reset the qmfrommvr term.
- !!
+ !! For the APT Package, the sole purpose here is to reset the qmfrommvr
+ !! term.
!<
subroutine apt_cf(this, reset_mover)
! -- modules
- class(GwtAptType) :: this !< GwtAptType object
+ class(TspAptType) :: this !< TspAptType object
logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover
! -- local
integer(I4B) :: i
@@ -740,20 +726,18 @@ subroutine apt_cf(this, reset_mover)
end do
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_cf
+ !> @brief Advanced package transport fill coefficient (fc) method
+ !!
+ !! Method to calculate and fill coefficients for an advanced transport package.
+ !<
subroutine apt_fc(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! apt_fc
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
real(DP), dimension(:), intent(inout) :: rhs
integer(I4B), dimension(:), intent(in) :: ia
integer(I4B), dimension(:), intent(in) :: idxglo
@@ -772,17 +756,15 @@ subroutine apt_fc(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine apt_fc
+ !> @brief Advanced package transport fill coefficient (fc) method
+ !!
+ !! Routine to formulate the nonexpanded matrix case in which feature
+ !! concentrations (or temperatures) are solved explicitly
+ !<
subroutine apt_fc_nonexpanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! apt_fc_nonexpanded -- formulate for the nonexpanded a matrix case in which
-! feature concentrations are solved explicitly
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
real(DP), dimension(:), intent(inout) :: rhs
integer(I4B), dimension(:), intent(in) :: ia
integer(I4B), dimension(:), intent(in) :: idxglo
@@ -791,7 +773,7 @@ subroutine apt_fc_nonexpanded(this, rhs, ia, idxglo, matrix_sln)
integer(I4B) :: j, igwfnode, idiag
! ------------------------------------------------------------------------------
!
- ! -- solve for concentration in the features
+ ! -- solve for concentration (or temperatures) in the features
call this%apt_solve()
!
! -- add hcof and rhs terms (from apt_solve) to the gwf matrix
@@ -807,17 +789,15 @@ subroutine apt_fc_nonexpanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine apt_fc_nonexpanded
+ !> @brief Advanced package transport fill coefficient (fc) method
+ !!
+ !! Routine to formulate the expanded matrix case in which new rows are added
+ !! to the system of equations for each advanced package transport feature
+ !<
subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! apt_fc_expanded -- formulate for the expanded matrix case in which new
-! rows are added to the system of equations for each feature
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
real(DP), dimension(:), intent(inout) :: rhs
integer(I4B), dimension(:), intent(in) :: ia
integer(I4B), dimension(:), intent(in) :: idxglo
@@ -828,7 +808,7 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
integer(I4B) :: iposd, iposoffd
integer(I4B) :: ipossymd, ipossymoffd
real(DP) :: cold
- real(DP) :: qbnd
+ real(DP) :: qbnd, qbnd_scaled
real(DP) :: omega
real(DP) :: rrate
real(DP) :: rhsval
@@ -842,7 +822,7 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
! specific to the package
call this%pak_fc_expanded(rhs, ia, idxglo, matrix_sln)
!
- ! -- mass storage in features
+ ! -- mass (or energy) storage in features
do n = 1, this%ncv
cold = this%xoldpak(n)
iloc = this%idxlocnode(n)
@@ -866,7 +846,7 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
! -- add from mover contribution
if (this%idxbudfmvr /= 0) then
do n = 1, this%ncv
- rhsval = this%qmfrommvr(n)
+ rhsval = this%qmfrommvr(n) ! kluge note: presumably already in terms of energy for heat transport???
iloc = this%idxlocnode(n)
rhs(iloc) = rhs(iloc) - rhsval
end do
@@ -883,18 +863,19 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
omega = DZERO
if (qbnd < DZERO) omega = DONE
+ qbnd_scaled = qbnd * this%eqnsclfac
!
! -- add to apt row
iposd = this%idxdglo(j)
iposoffd = this%idxoffdglo(j)
- call matrix_sln%add_value_pos(iposd, omega * qbnd)
- call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd)
+ call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled)
+ call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd_scaled)
!
! -- add to gwf row for apt connection
ipossymd = this%idxsymdglo(j)
ipossymoffd = this%idxsymoffdglo(j)
- call matrix_sln%add_value_pos(ipossymd, -(DONE - omega) * qbnd)
- call matrix_sln%add_value_pos(ipossymoffd, -omega * qbnd)
+ call matrix_sln%add_value_pos(ipossymd, -(DONE - omega) * qbnd_scaled)
+ call matrix_sln%add_value_pos(ipossymoffd, -omega * qbnd_scaled)
end if
end do
!
@@ -909,10 +890,11 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
else
omega = DZERO
end if
+ qbnd_scaled = qbnd * this%eqnsclfac
iposd = this%idxfjfdglo(j)
iposoffd = this%idxfjfoffdglo(j)
- call matrix_sln%add_value_pos(iposd, omega * qbnd)
- call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd)
+ call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled)
+ call matrix_sln%add_value_pos(iposoffd, (DONE - omega) * qbnd_scaled)
end do
end if
!
@@ -920,17 +902,15 @@ subroutine apt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine apt_fc_expanded
+ !> @brief Advanced package transport fill coefficient (fc) method
+ !!
+ !! Routine to allow a subclass advanced transport package to inject
+ !! terms into the matrix assembly. This method must be overridden.
+ !<
subroutine pak_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
-! ******************************************************************************
-! pak_fc_expanded -- allow a subclass advanced transport package to inject
-! terms into the matrix assembly. This method must be overridden.
-! ****************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
real(DP), dimension(:), intent(inout) :: rhs
integer(I4B), dimension(:), intent(in) :: ia
integer(I4B), dimension(:), intent(in) :: idxglo
@@ -946,16 +926,15 @@ subroutine pak_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
return
end subroutine pak_fc_expanded
+ !> @brief Advanced package transport routine
+ !!
+ !! Calculate advanced package transport hcof and rhs so transport budget is
+ !! calculated.
+ !<
subroutine apt_cfupdate(this)
-! ******************************************************************************
-! apt_cfupdate -- calculate package hcof and rhs so gwt budget is calculated
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: j, n
real(DP) :: qbnd
@@ -964,7 +943,7 @@ subroutine apt_cfupdate(this)
!
! -- Calculate hcof and rhs terms so GWF exchanges are calculated correctly
! -- go through each apt-gwf connection and calculate
- ! rhs and hcof terms for gwt matrix rows
+ ! rhs and hcof terms for gwt/gwe matrix rows
do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
this%hcof(j) = DZERO
@@ -973,8 +952,8 @@ subroutine apt_cfupdate(this)
qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
omega = DZERO
if (qbnd < DZERO) omega = DONE
- this%hcof(j) = -(DONE - omega) * qbnd
- this%rhs(j) = omega * qbnd * this%xnewpak(n)
+ this%hcof(j) = -(DONE - omega) * qbnd * this%eqnsclfac
+ this%rhs(j) = omega * qbnd * this%xnewpak(n) * this%eqnsclfac
end if
end do
!
@@ -982,16 +961,14 @@ subroutine apt_cfupdate(this)
return
end subroutine apt_cfupdate
+ !> @brief Advanced package transport calculate flows (cq) routine
+ !!
+ !! Calculate flows for the advanced package transport feature
+ !<
subroutine apt_cq(this, x, flowja, iadv)
-! ******************************************************************************
-! apt_cq -- Calculate flows for the feature
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
real(DP), dimension(:), intent(in) :: x
real(DP), dimension(:), contiguous, intent(inout) :: flowja
integer(I4B), optional, intent(in) :: iadv
@@ -1000,8 +977,8 @@ subroutine apt_cq(this, x, flowja, iadv)
real(DP) :: rrate
! ------------------------------------------------------------------------------
!
- ! -- Solve the feature concentrations again or update the feature hcof
- ! and rhs terms
+ ! -- Solve the feature concentrations (or temperatures) again or update
+ ! the feature hcof and rhs terms
if (this%imatrows == 0) then
call this%apt_solve()
else
@@ -1020,19 +997,21 @@ subroutine apt_cq(this, x, flowja, iadv)
this%qsto(n) = rrate
end do
!
- ! -- Copy concentrations into the flow package auxiliary variable
+ ! -- Copy concentrations (or temperatures) into the flow package auxiliary variable
call this%apt_copy2flowp()
!
! -- fill the budget object
- call this%apt_fill_budobj(x)
+ call this%apt_fill_budobj(x, flowja)
!
- ! -- return
+ ! -- Return
return
end subroutine apt_cq
+ !> @brief Save advanced package flows routine
+ !<
subroutine apt_ot_package_flows(this, icbcfl, ibudfl)
use TdisModule, only: kstp, kper, delt, pertim, totim
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(in) :: icbcfl
integer(I4B), intent(in) :: ibudfl
integer(I4B) :: ibinun
@@ -1052,19 +1031,26 @@ subroutine apt_ot_package_flows(this, icbcfl, ibudfl)
if (ibudfl /= 0 .and. this%iprflow /= 0) then
call this%budobj%write_flowtable(this%dis, kstp, kper)
end if
-
+ !
+ ! -- Return
+ return
end subroutine apt_ot_package_flows
subroutine apt_ot_dv(this, idvsave, idvprint)
+ ! -- modules
+ use ConstantsModule, only: LENBUDTXT
use TdisModule, only: kstp, kper, pertim, totim
- use ConstantsModule, only: DHNOFLO, DHDRY
+ use ConstantsModule, only: DHNOFLO, DHDRY, LENBUDTXT
use InputOutputModule, only: ulasav
- class(GwtAptType) :: this
+ ! -- dummy
+ class(TspAptType) :: this
integer(I4B), intent(in) :: idvsave
integer(I4B), intent(in) :: idvprint
+ ! -- local
integer(I4B) :: ibinun
integer(I4B) :: n
real(DP) :: c
+ character(len=LENBUDTXT) :: text
!
! -- set unit number for binary dependent variable output
ibinun = 0
@@ -1082,7 +1068,8 @@ subroutine apt_ot_dv(this, idvsave, idvprint)
end if
this%dbuff(n) = c
end do
- call ulasav(this%dbuff, ' CONCENTRATION', kstp, kper, pertim, totim, &
+ write (text, '(a)') padl(this%depvartype, 16)
+ call ulasav(this%dbuff, text, kstp, kper, pertim, totim, &
this%ncv, 1, 1, ibinun)
end if
!
@@ -1101,14 +1088,18 @@ subroutine apt_ot_dv(this, idvsave, idvprint)
call this%dvtab%add_term(this%xnewpak(n))
end do
end if
-
+ !
+ ! -- Return
+ return
end subroutine apt_ot_dv
+ !> @brief Print advanced package transport dependent variables
+ !<
subroutine apt_ot_bdsummary(this, kstp, kper, iout, ibudfl)
! -- module
use TdisModule, only: totim
! -- dummy
- class(GwtAptType) :: this !< GwtAptType object
+ class(TspAptType) :: this !< TspAptType object
integer(I4B), intent(in) :: kstp !< time step number
integer(I4B), intent(in) :: kper !< period number
integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file
@@ -1116,20 +1107,19 @@ subroutine apt_ot_bdsummary(this, kstp, kper, iout, ibudfl)
!
call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim)
!
- ! -- return
+ ! -- Return
return
end subroutine apt_ot_bdsummary
!> @ brief Allocate scalars
!!
- !! Allocate scalar variables for this package
- !!
+ !! Allocate scalar variables for an advanced package
!<
subroutine allocate_scalars(this)
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
!
! -- allocate scalars in NumericalPackageType
@@ -1151,6 +1141,8 @@ subroutine allocate_scalars(this)
call mem_allocate(this%idxbudfmvr, 'IDXBUDFMVR', this%memoryPath)
call mem_allocate(this%idxbudaux, 'IDXBUDAUX', this%memoryPath)
call mem_allocate(this%nconcbudssm, 'NCONCBUDSSM', this%memoryPath)
+ call mem_allocate(this%idxprepak, 'IDXPREPAK', this%memoryPath)
+ call mem_allocate(this%idxlastpak, 'IDXLASTPAK', this%memoryPath)
!
! -- Initialize
this%iauxfpconc = 0
@@ -1168,6 +1160,8 @@ subroutine allocate_scalars(this)
this%idxbudfmvr = 0
this%idxbudaux = 0
this%nconcbudssm = 0
+ this%idxprepak = 0
+ this%idxlastpak = 0
!
! -- set this package as causing asymmetric matrix terms
this%iasym = 1
@@ -1178,18 +1172,16 @@ end subroutine allocate_scalars
!> @ brief Allocate index arrays
!!
- !! Allocate arrays that map to locations in the
- !! numerical solution
- !!
+ !! Allocate arrays that map to locations in the numerical solution
!<
subroutine apt_allocate_index_arrays(this)
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: n
-
+ !
if (this%imatrows /= 0) then
!
! -- count number of flow-ja-face connections
@@ -1233,19 +1225,20 @@ subroutine apt_allocate_index_arrays(this)
call mem_allocate(this%idxfjfoffdglo, 0, 'IDXFJFOFFDGLO', &
this%memoryPath)
end if
+ !
+ ! -- Return
return
end subroutine apt_allocate_index_arrays
!> @ brief Allocate arrays
!!
- !! Allocate package arrays
- !!
+ !! Allocate advanced package transport arrays
!<
subroutine apt_allocate_arrays(this)
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: n
!
@@ -1278,7 +1271,7 @@ subroutine apt_allocate_arrays(this)
call mem_allocate(this%concbudssm, this%nconcbudssm, this%ncv, &
'CONCBUDSSM', this%memoryPath)
!
- ! -- mass added from the mover transport package
+ ! -- mass (or energy) added from the mover transport package
call mem_allocate(this%qmfrommvr, this%ncv, 'QMFROMMVR', this%memoryPath)
!
! -- initialize arrays
@@ -1298,13 +1291,12 @@ end subroutine apt_allocate_arrays
!> @ brief Deallocate memory
!!
!! Deallocate memory associated with this package
- !!
!<
subroutine apt_da(this)
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
!
! -- deallocate arrays
@@ -1312,6 +1304,8 @@ subroutine apt_da(this)
call mem_deallocate(this%qsto)
call mem_deallocate(this%ccterm)
call mem_deallocate(this%strt)
+ call mem_deallocate(this%ktf)
+ call mem_deallocate(this%rfeatthk)
call mem_deallocate(this%lauxvar)
call mem_deallocate(this%xoldpak)
if (this%imatrows == 0) then
@@ -1363,6 +1357,8 @@ subroutine apt_da(this)
call mem_deallocate(this%idxbudaux)
call mem_deallocate(this%idxbudssm)
call mem_deallocate(this%nconcbudssm)
+ call mem_deallocate(this%idxprepak)
+ call mem_deallocate(this%idxlastpak)
!
! -- deallocate scalars in NumericalPackageType
call this%BndType%bnd_da()
@@ -1371,17 +1367,13 @@ subroutine apt_da(this)
return
end subroutine apt_da
+ !> @brief Find corresponding advanced package transport package
+ !<
subroutine find_apt_package(this)
-! ******************************************************************************
-! find corresponding flow package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -1393,20 +1385,16 @@ subroutine find_apt_package(this)
return
end subroutine find_apt_package
+ !> @brief Set options specific to the TspAptType
+ !!
+ !! This routine overrides BndType%bnd_options
+ !<
subroutine apt_options(this, option, found)
-! ******************************************************************************
-! apt_options -- set options specific to GwtAptType
-!
-! apt_options overrides BndType%bnd_options
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use ConstantsModule, only: MAXCHARLEN, DZERO
use OpenSpecModule, only: access, form
use InputOutputModule, only: urword, getunit, openfile
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
character(len=*), intent(inout) :: option
logical, intent(inout) :: found
! -- local
@@ -1439,11 +1427,12 @@ subroutine apt_options(this, option, found)
write (this%iout, '(4x,a)') &
trim(adjustl(this%text))// &
' WILL NOT ADD ADDITIONAL ROWS TO THE A MATRIX.'
- case ('PRINT_CONCENTRATION')
+ case ('PRINT_CONCENTRATION', 'PRINT_TEMPERATURE')
this%iprconc = 1
- write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
- ' CONCENTRATIONS WILL BE PRINTED TO LISTING FILE.'
- case ('CONCENTRATION')
+ write (this%iout, '(4x,a,1x,a,1x,a)') trim(adjustl(this%text))// &
+ trim(adjustl(this%depvartype))//'S WILL BE PRINTED TO LISTING &
+ &FILE.'
+ case ('CONCENTRATION', 'TEMPERATURE')
call this%parser%GetStringCaps(keyword)
if (keyword == 'FILEOUT') then
call this%parser%GetString(fname)
@@ -1451,10 +1440,12 @@ subroutine apt_options(this, option, found)
call openfile(this%iconcout, this%iout, fname, 'DATA(BINARY)', &
form, access, 'REPLACE')
write (this%iout, fmtaptbin) &
- trim(adjustl(this%text)), 'CONCENTRATION', trim(fname), this%iconcout
+ trim(adjustl(this%text)), trim(adjustl(this%depvartype)), &
+ trim(fname), this%iconcout
else
- call store_error('Optional CONCENTRATION keyword must &
- &be followed by FILEOUT')
+ write (errmsg, "('Optional', 1x, a, 1X, 'keyword must &
+ &be followed by FILEOUT')") this%depvartype
+ call store_error(errmsg)
end if
case ('BUDGET')
call this%parser%GetStringCaps(keyword)
@@ -1487,19 +1478,15 @@ subroutine apt_options(this, option, found)
found = .false.
end select
!
- ! -- return
+ ! -- Return
return
end subroutine apt_options
+ !> @brief Determine dimensions for this advanced package
+ !<
subroutine apt_read_dimensions(this)
-! ******************************************************************************
-! apt_read_dimensions -- Determine dimensions for this package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: ierr
! -- format
@@ -1561,22 +1548,18 @@ subroutine apt_read_dimensions(this)
! -- setup the conc table object
call this%apt_setup_tableobj()
!
- ! -- return
+ ! -- Return
return
end subroutine apt_read_dimensions
+ !> @brief Read feature information for this advanced package
+ !<
subroutine apt_read_cvs(this)
-! ******************************************************************************
-! apt_read_cvs -- Read feature information for this package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
use TimeSeriesManagerModule, only: read_value_or_time_series_adv
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
character(len=LINELENGTH) :: text
character(len=LENBOUNDNAME) :: bndName, bndNameTemp
@@ -1599,6 +1582,8 @@ subroutine apt_read_cvs(this)
!
! -- allocate apt data
call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath)
+ call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath)
+ call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath)
call mem_allocate(this%lauxvar, this%naux, this%ncv, 'LAUXVAR', &
this%memoryPath)
!
@@ -1613,8 +1598,11 @@ subroutine apt_read_cvs(this)
allocate (this%featname(this%ncv)) ! ditch after boundnames allocated??
!allocate(this%status(this%ncv))
!
+ ! - initialize variables
do n = 1, this%ncv
this%strt(n) = DEP20
+ this%ktf(n) = DZERO
+ this%rfeatthk(n) = DZERO
this%lauxvar(:, n) = DZERO
this%xoldpak(n) = DEP20
if (this%imatrows == 0) then
@@ -1655,13 +1643,13 @@ subroutine apt_read_cvs(this)
call store_error(errmsg)
cycle
end if
-
+ !
! -- increment nboundchk
nboundchk(n) = nboundchk(n) + 1
-
+ !
! -- strt
this%strt(n) = this%parser%GetDouble()
-
+ !
! -- get aux data
do iaux = 1, this%naux
call this%parser%GetString(caux(iaux))
@@ -1691,7 +1679,7 @@ subroutine apt_read_cvs(this)
this%tsManager, this%iprpak, &
this%auxname(jj))
end do
-
+ !
nlak = nlak + 1
end do
!
@@ -1706,7 +1694,7 @@ subroutine apt_read_cvs(this)
call store_error(errmsg)
end if
end do
-
+ !
write (this%iout, '(1x,a)') &
'END OF '//trim(adjustl(this%text))//' PACKAGEDATA'
else
@@ -1726,74 +1714,30 @@ subroutine apt_read_cvs(this)
! -- deallocate local storage for nboundchk
deallocate (nboundchk)
!
- ! -- return
+ ! -- Return
return
end subroutine apt_read_cvs
+ !> @brief Read the initial parameters for an advanced package
+ !<
subroutine apt_read_initial_attr(this)
-! ******************************************************************************
-! apt_read_initial_attr -- Read the initial parameters for this package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use ConstantsModule, only: LINELENGTH
use BudgetModule, only: budget_cr
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
!character(len=LINELENGTH) :: text
integer(I4B) :: j, n
- !integer(I4B) :: nn
- !integer(I4B) :: idx
- !real(DP) :: endtim
- !real(DP) :: top
- !real(DP) :: bot
- !real(DP) :: k
- !real(DP) :: area
- !real(DP) :: length
- !real(DP) :: s
- !real(DP) :: dx
- !real(DP) :: c
- !real(DP) :: sa
- !real(DP) :: wa
- !real(DP) :: v
- !real(DP) :: fact
- !real(DP) :: c1
- !real(DP) :: c2
- !real(DP), allocatable, dimension(:) :: clb, caq
- !character (len=14) :: cbedleak
- !character (len=14) :: cbedcond
- !character (len=10), dimension(0:3) :: ctype
- !character (len=15) :: nodestr
- !!data
- !data ctype(0) /'VERTICAL '/
- !data ctype(1) /'HORIZONTAL'/
- !data ctype(2) /'EMBEDDEDH '/
- !data ctype(3) /'EMBEDDEDV '/
- ! -- format
! ------------------------------------------------------------------------------
-
!
- ! -- initialize xnewpak and set lake concentration
+ ! -- initialize xnewpak and set lake concentration (or temperature)
! -- todo: this should be a time series?
do n = 1, this%ncv
this%xnewpak(n) = this%strt(n)
- !write(text,'(g15.7)') this%strt(n)
- !endtim = DZERO
- !jj = 1 ! For STAGE
- !call read_single_value_or_time_series(text, &
- ! this%stage(n)%value, &
- ! this%stage(n)%name, &
- ! endtim, &
- ! this%name, 'BND', this%TsManager, &
- ! this%iprpak, n, jj, 'STAGE', &
- ! this%featname(n), this%inunit)
-
+ !
! -- todo: read aux
-
+ !
! -- todo: read boundname
-
end do
!
! -- initialize status (iboundpak) of lakes to active
@@ -1818,21 +1762,20 @@ subroutine apt_read_initial_attr(this)
! -- copy boundname into boundname_cst
call this%copy_boundname()
!
- ! -- return
+ ! -- Return
return
end subroutine apt_read_initial_attr
+ !> @brief Add terms specific to advanced package transport to the explicit
+ !! solve
+ !!
+ !! Explicit solve for concentration (or temperature) in advaced package
+ !! features, which is an alternative to the iterative implicit solve.
+ !<
subroutine apt_solve(this)
-! ******************************************************************************
-! apt_solve -- explicit solve for concentration in features, which is an
-! alternative to the iterative implicit solve
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use ConstantsModule, only: LINELENGTH
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: n, j, igwfnode
integer(I4B) :: n1, n2
@@ -1841,7 +1784,6 @@ subroutine apt_solve(this)
real(DP) :: c1, qbnd
real(DP) :: hcofval, rhsval
! ------------------------------------------------------------------------------
- !
!
! -- first initialize dbuff
do n = 1, this%ncv
@@ -1863,13 +1805,13 @@ subroutine apt_solve(this)
! -- add from mover contribution
if (this%idxbudfmvr /= 0) then
do n1 = 1, size(this%qmfrommvr)
- rrate = this%qmfrommvr(n1)
+ rrate = this%qmfrommvr(n1) ! kluge note: presumably in terms of energy already for heat transport???
this%dbuff(n1) = this%dbuff(n1) + rrate
end do
end if
!
! -- go through each gwf connection and accumulate
- ! total mass in dbuff mass
+ ! total mass (or energy) in dbuff mass
do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
this%hcof(j) = DZERO
@@ -1878,17 +1820,17 @@ subroutine apt_solve(this)
qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
if (qbnd <= DZERO) then
ctmp = this%xnewpak(n)
- this%rhs(j) = qbnd * ctmp
+ this%rhs(j) = qbnd * ctmp * this%eqnsclfac
else
ctmp = this%xnew(igwfnode)
- this%hcof(j) = -qbnd
+ this%hcof(j) = -qbnd * this%eqnsclfac
end if
- c1 = qbnd * ctmp
+ c1 = qbnd * ctmp * this%eqnsclfac
this%dbuff(n) = this%dbuff(n) + c1
end do
!
- ! -- go through each lak-lak connection and accumulate
- ! total mass in dbuff mass
+ ! -- go through each "within apt-apt" connection (e.g., lak-lak) and
+ ! accumulate total mass (or energy) in dbuff mass
if (this%idxbudfjf /= 0) then
do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
call this%apt_fjf_term(j, n1, n2, rrate)
@@ -1897,7 +1839,7 @@ subroutine apt_solve(this)
end do
end if
!
- ! -- calulate the feature concentration
+ ! -- calculate the feature concentration/temperature
do n = 1, this%ncv
call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
!
@@ -1916,15 +1858,14 @@ subroutine apt_solve(this)
return
end subroutine apt_solve
+ !> @brief Add terms specific to advanced package transport features to the
+ !! explicit solve routine
+ !!
+ !! This routine must be overridden by the specific apt package
+ !<
subroutine pak_solve(this)
-! ******************************************************************************
-! pak_solve -- must be overridden
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -1936,15 +1877,11 @@ subroutine pak_solve(this)
return
end subroutine pak_solve
+ !> @brief Accumulate constant concentration (or temperature) terms for budget
+ !<
subroutine apt_accumulate_ccterm(this, ilak, rrate, ccratin, ccratout)
-! ******************************************************************************
-! apt_accumulate_ccterm -- Accumulate constant concentration terms for budget.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(in) :: ilak
real(DP), intent(in) :: rrate
real(DP), intent(inout) :: ccratin
@@ -1970,19 +1907,15 @@ subroutine apt_accumulate_ccterm(this, ilak, rrate, ccratin, ccratout)
ccratin = ccratin + q
end if
end if
- ! -- return
+ ! -- Return
return
end subroutine apt_accumulate_ccterm
+ !> @brief Define the list heading that is written to iout when PRINT_INPUT
+ !! option is used.
+ !<
subroutine define_listlabel(this)
-! ******************************************************************************
-! define_listlabel -- Define the list heading that is written to iout when
-! PRINT_INPUT option is used.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
! -- create the header list label
@@ -2002,24 +1935,21 @@ subroutine define_listlabel(this)
write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine define_listlabel
+ !> @brief Set pointers to model arrays and variables so that a package has
+ !! access to these items.
+ !<
subroutine apt_set_pointers(this, neq, ibound, xnew, xold, flowja)
-! ******************************************************************************
-! set_pointers -- Set pointers to model arrays and variables so that a package
-! has access to these things.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), pointer :: neq
integer(I4B), dimension(:), pointer, contiguous :: ibound
real(DP), dimension(:), pointer, contiguous :: xnew
real(DP), dimension(:), pointer, contiguous :: xold
real(DP), dimension(:), pointer, contiguous :: flowja
+ !
! -- local
integer(I4B) :: istart, iend
! ------------------------------------------------------------------------------
@@ -2037,19 +1967,16 @@ subroutine apt_set_pointers(this, neq, ibound, xnew, xold, flowja)
this%xnewpak => this%xnew(istart:iend)
end if
!
- ! -- return
+ ! -- Return
+ return
end subroutine apt_set_pointers
+ !> @brief Return the feature new volume and old volume
+ !<
subroutine get_volumes(this, icv, vnew, vold, delt)
-! ******************************************************************************
-! get_volumes -- return the feature new volume and old volume
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(in) :: icv
real(DP), intent(inout) :: vnew, vold
real(DP), intent(in) :: delt
@@ -2070,18 +1997,15 @@ subroutine get_volumes(this, icv, vnew, vold, delt)
return
end subroutine get_volumes
+ !> @brief Function to return the number of budget terms just for this package
+ !!
+ !! This function must be overridden.
+ !<
function pak_get_nbudterms(this) result(nbudterms)
-! ******************************************************************************
-! pak_get_nbudterms -- function to return the number of budget terms just for
-! this package. Must be overridden.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
- ! -- return
+ class(TspAptType) :: this
+ ! -- Return
integer(I4B) :: nbudterms
! -- local
! ------------------------------------------------------------------------------
@@ -2092,17 +2016,13 @@ function pak_get_nbudterms(this) result(nbudterms)
nbudterms = 0
end function pak_get_nbudterms
+ !> @brief Set up the budget object that stores advanced package flow terms
+ !<
subroutine apt_setup_budobj(this)
-! ******************************************************************************
-! apt_setup_budobj -- Set up the budget object that stores all the lake flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: nbudterm
integer(I4B) :: nlen
@@ -2111,9 +2031,13 @@ subroutine apt_setup_budobj(this)
integer(I4B) :: idx
logical :: ordered_id1
real(DP) :: q
- character(len=LENBUDTXT) :: text
+ character(len=LENBUDTXT) :: bddim_opt
+ character(len=LENBUDTXT) :: text, textt
character(len=LENBUDTXT), dimension(1) :: auxtxt
! ------------------------------------------------------------------------------
+ !
+ ! -- Initialize nbudterm
+ nbudterm = 0
!
! -- Determine if there are flow-ja-face terms
nlen = 0
@@ -2121,17 +2045,18 @@ subroutine apt_setup_budobj(this)
nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
end if
!
- ! -- Determine the number of lake budget terms. These are fixed for
- ! the simulation and cannot change
- ! -- the first 3 is for GWF, STORAGE, and CONSTANT
- nbudterm = 3
+ ! -- Determine the number of budget terms associated with apt.
+ ! These are fixed for the simulation and cannot change
+ !
+ ! -- add one if flow-ja-face present
+ if (this%idxbudfjf /= 0) nbudterm = nbudterm + 1
+ !
+ ! -- All the APT packages have GWF, STORAGE, and CONSTANT
+ nbudterm = nbudterm + 3
!
! -- add terms for the specific package
nbudterm = nbudterm + this%pak_get_nbudterms()
!
- ! -- add one for flow-ja-face
- if (nlen > 0) nbudterm = nbudterm + 1
- !
! -- add for mover terms and auxiliary
if (this%idxbudtmvr /= 0) nbudterm = nbudterm + 1
if (this%idxbudfmvr /= 0) nbudterm = nbudterm + 1
@@ -2139,8 +2064,10 @@ subroutine apt_setup_budobj(this)
!
! -- set up budobj
call budgetobject_cr(this%budobj, this%packName)
+ !
+ bddim_opt = this%depvarunitabbrev
call this%budobj%budgetobject_df(this%ncv, nbudterm, 0, 0, &
- bddim_opt='M', ibudcsv=this%ibudcsv)
+ bddim_opt=bddim_opt, ibudcsv=this%ibudcsv)
idx = 0
!
! -- Go through and set up each budget term
@@ -2189,14 +2116,17 @@ subroutine apt_setup_budobj(this)
end do
!
! -- Reserve space for the package specific terms
+ this%idxprepak = idx
call this%pak_setup_budobj(idx)
+ this%idxlastpak = idx
!
! --
text = ' STORAGE'
idx = idx + 1
maxlist = this%flowbudptr%budterm(this%idxbudsto)%maxlist
naux = 1
- auxtxt(1) = ' MASS'
+ write (textt, '(a)') padl(this%depvarunit, 16)
+ auxtxt(1) = textt ! ' MASS' or ' ENERGY'
call this%budobj%budterm(idx)%initialize(text, &
this%name_model, &
this%packName, &
@@ -2272,21 +2202,18 @@ subroutine apt_setup_budobj(this)
call this%budobj%flowtable_df(this%iout)
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_setup_budobj
+ !> @brief Set up a budget object that stores an advanced package flows
+ !!
+ !! Individual packages set up their budget terms. Must be overridden.
+ !<
subroutine pak_setup_budobj(this, idx)
-! ******************************************************************************
-! pak_setup_budobj -- Individual packages set up their budget terms. Must
-! be overridden
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(inout) :: idx
! -- local
! ------------------------------------------------------------------------------
@@ -2295,22 +2222,19 @@ subroutine pak_setup_budobj(this, idx)
call store_error('Program error: pak_setup_budobj not implemented.', &
terminate=.TRUE.)
!
- ! -- return
+ ! -- Return
return
end subroutine pak_setup_budobj
- subroutine apt_fill_budobj(this, x)
-! ******************************************************************************
-! apt_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj
+ !<
+ subroutine apt_fill_budobj(this, x, flowja)
! -- modules
use TdisModule, only: delt
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
! -- local
integer(I4B) :: naux
real(DP), dimension(:), allocatable :: auxvartmp
@@ -2328,14 +2252,14 @@ subroutine apt_fill_budobj(this, x)
! -- initialize counter
idx = 0
!
- ! -- initialize ccterm, which is used to sum up all mass flows
- ! into a constant concentration cell
+ ! -- initialize ccterm, which is used to sum up all mass (or energy) flows
+ ! into a constant concentration (or temperature) cell
ccratin = DZERO
ccratout = DZERO
do n1 = 1, this%ncv
this%ccterm(n1) = DZERO
end do
-
+ !
! -- FLOW JA FACE
nlen = 0
if (this%idxbudfjf /= 0) then
@@ -2352,7 +2276,7 @@ subroutine apt_fill_budobj(this, x)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- GWF (LEAKAGE)
idx = idx + 1
call this%budobj%budterm(idx)%reset(this%maxbound)
@@ -2367,23 +2291,24 @@ subroutine apt_fill_budobj(this, x)
call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
-
- ! -- individual package terms
- call this%pak_fill_budobj(idx, x, ccratin, ccratout)
-
+ !
+ ! -- skip individual package terms for now and process them last
+ ! -- in case they depend on the other terms (as for uze)
+ idx = this%idxlastpak
+ !
! -- STORAGE
idx = idx + 1
call this%budobj%budterm(idx)%reset(this%ncv)
allocate (auxvartmp(1))
do n1 = 1, this%ncv
call this%get_volumes(n1, v1, v0, delt)
- auxvartmp(1) = v1 * this%xnewpak(n1)
+ auxvartmp(1) = v1 * this%xnewpak(n1) ! kluge note: does this need a factor of eqnsclfac???
q = this%qsto(n1)
call this%budobj%budterm(idx)%update_term(n1, n1, q, auxvartmp)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
deallocate (auxvartmp)
-
+ !
! -- TO MOVER
if (this%idxbudtmvr /= 0) then
idx = idx + 1
@@ -2395,19 +2320,19 @@ subroutine apt_fill_budobj(this, x)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- FROM MOVER
if (this%idxbudfmvr /= 0) then
idx = idx + 1
nlist = this%ncv
call this%budobj%budterm(idx)%reset(nlist)
- do n1 = 1, nlist
- q = this%qmfrommvr(n1)
+ do j = 1, nlist
+ call this%apt_fmvr_term(j, n1, n2, q) ! kluge note: don't really need to do this in apt_fmvr_term now, since no override by uze
call this%budobj%budterm(idx)%update_term(n1, n1, q)
call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
end do
end if
-
+ !
! -- CONSTANT FLOW
idx = idx + 1
call this%budobj%budterm(idx)%reset(this%ncv)
@@ -2415,7 +2340,7 @@ subroutine apt_fill_budobj(this, x)
q = this%ccterm(n1)
call this%budobj%budterm(idx)%update_term(n1, n1, q)
end do
-
+ !
! -- AUXILIARY VARIABLES
naux = this%naux
if (naux > 0) then
@@ -2432,25 +2357,26 @@ subroutine apt_fill_budobj(this, x)
deallocate (auxvartmp)
end if
!
+ ! -- individual package terms processed last
+ idx = this%idxprepak
+ call this%pak_fill_budobj(idx, x, flowja, ccratin, ccratout)
+ !
! --Terms are filled, now accumulate them for this time step
call this%budobj%accumulate_terms()
!
- ! -- return
+ ! -- Return
return
end subroutine apt_fill_budobj
- subroutine pak_fill_budobj(this, idx, x, ccratin, ccratout)
-! ******************************************************************************
-! pak_fill_budobj -- copy flow terms into this%budobj, must be overridden
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Copy flow terms into this%budobj, must be overridden
+ !<
+ subroutine pak_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(inout) :: idx
real(DP), dimension(:), intent(in) :: x
+ real(DP), dimension(:), contiguous, intent(inout) :: flowja
real(DP), intent(inout) :: ccratin
real(DP), intent(inout) :: ccratout
! -- local
@@ -2461,14 +2387,16 @@ subroutine pak_fill_budobj(this, idx, x, ccratin, ccratout)
call store_error('Program error: pak_fill_budobj not implemented.', &
terminate=.TRUE.)
!
- ! -- return
+ ! -- Return
return
end subroutine pak_fill_budobj
+ !> @brief Account for mass or energy storage in advanced package features
+ !<
subroutine apt_stor_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
use TdisModule, only: delt
- class(GwtAptType) :: this
+ class(TspAptType) :: this
integer(I4B), intent(in) :: ientry
integer(I4B), intent(inout) :: n1
integer(I4B), intent(inout) :: n2
@@ -2477,53 +2405,100 @@ subroutine apt_stor_term(this, ientry, n1, n2, rrate, &
real(DP), intent(inout), optional :: hcofval
real(DP) :: v0, v1
real(DP) :: c0, c1
+! -----------------------------------------------------------------
+ !
n1 = ientry
n2 = ientry
call this%get_volumes(n1, v1, v0, delt)
c0 = this%xoldpak(n1)
c1 = this%xnewpak(n1)
- if (present(rrate)) rrate = -c1 * v1 / delt + c0 * v0 / delt
- if (present(rhsval)) rhsval = -c0 * v0 / delt
- if (present(hcofval)) hcofval = -v1 / delt
+ if (present(rrate)) then
+ rrate = (-c1 * v1 / delt + c0 * v0 / delt) * this%eqnsclfac
+ end if
+ if (present(rhsval)) rhsval = -c0 * v0 * this%eqnsclfac / delt
+ if (present(hcofval)) hcofval = -v1 * this%eqnsclfac / delt
!
- ! -- return
+ ! -- Return
return
end subroutine apt_stor_term
+ !> @brief Account for mass or energy transferred to the MVR package
+ !<
subroutine apt_tmvr_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
- class(GwtAptType) :: this
+ ! -- modules
+ ! -- dummy
+ class(TspAptType) :: this
integer(I4B), intent(in) :: ientry
integer(I4B), intent(inout) :: n1
integer(I4B), intent(inout) :: n2
real(DP), intent(inout), optional :: rrate
real(DP), intent(inout), optional :: rhsval
real(DP), intent(inout), optional :: hcofval
+ ! -- local
real(DP) :: qbnd
real(DP) :: ctmp
+! ------------------------------------------------------------------------------
+ !
+ ! -- Calculate MVR-related terms
n1 = this%flowbudptr%budterm(this%idxbudtmvr)%id1(ientry)
n2 = this%flowbudptr%budterm(this%idxbudtmvr)%id2(ientry)
qbnd = this%flowbudptr%budterm(this%idxbudtmvr)%flow(ientry)
ctmp = this%xnewpak(n1)
- if (present(rrate)) rrate = ctmp * qbnd
+ if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
if (present(rhsval)) rhsval = DZERO
- if (present(hcofval)) hcofval = qbnd
+ if (present(hcofval)) hcofval = qbnd * this%eqnsclfac
!
- ! -- return
+ ! -- Return
return
end subroutine apt_tmvr_term
+ !> @brief Account for mass or energy transferred to this package from the
+ !! MVR package
+ !<
+ subroutine apt_fmvr_term(this, ientry, n1, n2, rrate, &
+ rhsval, hcofval)
+ ! -- modules
+ ! -- dummy
+ class(TspAptType) :: this
+ integer(I4B), intent(in) :: ientry
+ integer(I4B), intent(inout) :: n1
+ integer(I4B), intent(inout) :: n2
+ real(DP), intent(inout), optional :: rrate
+ real(DP), intent(inout), optional :: rhsval
+ real(DP), intent(inout), optional :: hcofval
+! ------------------------------------------------------------------------------
+ !
+ ! -- Calculate MVR-related terms
+ n1 = ientry
+ n2 = n1
+ if (present(rrate)) rrate = this%qmfrommvr(n1) ! presumably in terms of energy already for heat transport???
+ if (present(rhsval)) rhsval = this%qmfrommvr(n1)
+ if (present(hcofval)) hcofval = DZERO
+ !
+ ! -- Return
+ return
+ end subroutine apt_fmvr_term
+
+ !> @brief Go through each "within apt-apt" connection (e.g., lkt-lkt, or
+ !! sft-sft) and accumulate total mass (or energy) in dbuff mass
+ !<
subroutine apt_fjf_term(this, ientry, n1, n2, rrate, &
rhsval, hcofval)
- class(GwtAptType) :: this
+ ! -- modules
+ ! -- dummy
+ class(TspAptType) :: this
integer(I4B), intent(in) :: ientry
integer(I4B), intent(inout) :: n1
integer(I4B), intent(inout) :: n2
real(DP), intent(inout), optional :: rrate
real(DP), intent(inout), optional :: rhsval
real(DP), intent(inout), optional :: hcofval
+ ! -- local
real(DP) :: qbnd
real(DP) :: ctmp
+! ------------------------------------------------------------------------------
+ !
n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(ientry)
n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(ientry)
qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(ientry)
@@ -2532,24 +2507,21 @@ subroutine apt_fjf_term(this, ientry, n1, n2, rrate, &
else
ctmp = this%xnewpak(n2)
end if
- if (present(rrate)) rrate = ctmp * qbnd
- if (present(rhsval)) rhsval = -rrate
+ if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
+ if (present(rhsval)) rhsval = -rrate * this%eqnsclfac
if (present(hcofval)) hcofval = DZERO
!
- ! -- return
+ ! -- Return
return
end subroutine apt_fjf_term
+ !> @brief Copy concentrations (or temperatures) into flow package aux
+ !! variable
+ !<
subroutine apt_copy2flowp(this)
-! ******************************************************************************
-! apt_copy2flowp -- copy concentrations into flow package aux variable
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: n, j
! ------------------------------------------------------------------------------
@@ -2566,64 +2538,58 @@ subroutine apt_copy2flowp(this)
end do
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_copy2flowp
+ !> @brief Determine whether an obs type is supported
+ !!
+ !! This function:
+ !! - returns true if APT package supports named observation.
+ !! - overrides BndType%bnd_obs_supported()
+ !<
logical function apt_obs_supported(this)
-! ******************************************************************************
-! apt_obs_supported -- obs are supported?
-! -- Return true because APT package supports observations.
-! -- Overrides BndType%bnd_obs_supported()
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! ------------------------------------------------------------------------------
!
! -- Set to true
apt_obs_supported = .true.
!
- ! -- return
+ ! -- Return
return
end function apt_obs_supported
+ !> @brief Define observation type
+ !!
+ !! This routine:
+ !! - stores observation types supported by APT package.
+ !! - overrides BndType%bnd_df_obs
+ !<
subroutine apt_df_obs(this)
-! ******************************************************************************
-! apt_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
! ------------------------------------------------------------------------------
!
! -- call additional specific observations for lkt, sft, mwt, and uzt
call this%pak_df_obs()
!
+ ! -- Return
return
end subroutine apt_df_obs
+ !> @brief Define apt observation type
+ !!
+ !! This routine:
+ !! - stores observations supported by the APT package
+ !! - must be overridden by child class
subroutine pak_df_obs(this)
-! ******************************************************************************
-! pak_df_obs -- obs are supported?
-! -- Store observation type supported by APT package.
-! -- must be overridden by child class
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -2635,13 +2601,12 @@ subroutine pak_df_obs(this)
end subroutine pak_df_obs
!> @brief Process package specific obs
- !!
- !! Method to process specific observations for this package.
- !!
+ !!
+ !! Method to process specific observations for this package.
!<
subroutine pak_rp_obs(this, obsrv, found)
! -- dummy
- class(GwtAptType), intent(inout) :: this !< package class
+ class(TspAptType), intent(inout) :: this !< package class
type(ObserveType), intent(inout) :: obsrv !< observation object
logical, intent(inout) :: found !< indicate whether observation was found
! -- local
@@ -2650,17 +2615,17 @@ subroutine pak_rp_obs(this, obsrv, found)
call store_error('Program error: pak_rp_obs not implemented.', &
terminate=.TRUE.)
!
+ ! -- Return
return
end subroutine pak_rp_obs
!> @brief Prepare observation
- !!
- !! Find the indices for this observation assuming
- !! they are indexed by feature number
- !!
+ !!
+ !! Find the indices for this observation assuming they are indexed by
+ !! feature number
!<
subroutine rp_obs_byfeature(this, obsrv)
- class(GwtAptType), intent(inout) :: this !< object
+ class(TspAptType), intent(inout) :: this !< object
type(ObserveType), intent(inout) :: obsrv !< observation
integer(I4B) :: nn1
integer(I4B) :: j
@@ -2695,18 +2660,18 @@ subroutine rp_obs_byfeature(this, obsrv)
end if
call obsrv%AddObsIndex(nn1)
end if
+ !
+ ! -- Return
return
end subroutine rp_obs_byfeature
!> @brief Prepare observation
- !!
- !! Find the indices for this observation assuming
- !! they are first indexed by feature number and
- !! secondly by a connection number
- !!
+ !!
+ !! Find the indices for this observation assuming they are first indexed
+ !! by feature number and secondly by a connection number
!<
subroutine rp_obs_budterm(this, obsrv, budterm)
- class(GwtAptType), intent(inout) :: this !< object
+ class(TspAptType), intent(inout) :: this !< object
type(ObserveType), intent(inout) :: obsrv !< observation
type(BudgetTermType), intent(in) :: budterm !< budget term
integer(I4B) :: nn1
@@ -2770,18 +2735,18 @@ subroutine rp_obs_budterm(this, obsrv, budterm)
call store_error(errmsg)
end if
end if
+ !
+ ! -- Return
return
end subroutine rp_obs_budterm
!> @brief Prepare observation
- !!
- !! Find the indices for this observation assuming
- !! they are first indexed by a feature number and
- !! secondly by a second feature number
- !!
+ !!
+ !! Find the indices for this observation assuming they are first indexed
+ !! by a feature number and secondly by a second feature number
!<
subroutine rp_obs_flowjaface(this, obsrv, budterm)
- class(GwtAptType), intent(inout) :: this !< object
+ class(TspAptType), intent(inout) :: this !< object
type(ObserveType), intent(inout) :: obsrv !< observation
type(BudgetTermType), intent(in) :: budterm !< budget term
integer(I4B) :: nn1
@@ -2847,20 +2812,20 @@ subroutine rp_obs_flowjaface(this, obsrv, budterm)
call store_error(errmsg)
end if
end if
+ !
+ ! -- Return
return
end subroutine rp_obs_flowjaface
+ !> @brief Read and prepare apt-related observations
+ !!
+ !! Method to process specific observations for an apt package
+ !<
subroutine apt_rp_obs(this)
-! ******************************************************************************
-! apt_rp_obs --
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: kper
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
! -- local
integer(I4B) :: i
logical :: found
@@ -2871,18 +2836,19 @@ subroutine apt_rp_obs(this)
do i = 1, this%obs%npakobs
obsrv => this%obs%pakobs(i)%obsrv
select case (obsrv%ObsTypeId)
- case ('CONCENTRATION')
+ case ('CONCENTRATION', 'TEMPERATURE')
call this%rp_obs_byfeature(obsrv)
!
! -- catch non-cumulative observation assigned to observation defined
! by a boundname that is assigned to more than one element
if (obsrv%indxbnds_count > 1) then
- write (errmsg, '(a, a, a)') &
- 'CONCENTRATION for observation', trim(adjustl(obsrv%Name)), &
+ write (errmsg, '(a, a, a, a)') &
+ trim(adjustl(this%depvartype))// &
+ ' for observation', trim(adjustl(obsrv%Name)), &
' must be assigned to a feature with a unique boundname.'
call store_error(errmsg)
end if
- case ('LKT', 'SFT', 'MWT', 'UZT')
+ case ('LKT', 'SFT', 'MWT', 'UZT', 'LKE', 'SFE', 'MWE', 'UZE')
call this%rp_obs_budterm(obsrv, &
this%flowbudptr%budterm(this%idxbudgwf))
case ('FLOW-JA-FACE')
@@ -2927,20 +2893,20 @@ subroutine apt_rp_obs(this)
end if
end if
!
+ ! -- Return
return
end subroutine apt_rp_obs
+ !> @brief Calculate observation values
+ !!
+ !! Routine calculates observations common to SFT/LKT/MWT/UZT
+ !! (or SFE/LKE/MWE/UZE) for as many TspAptType observations that are common
+ !! among the advanced transport packages
+ !<
subroutine apt_bd_obs(this)
-! ******************************************************************************
-! apt_bd_obs -- Calculate observations common to SFT/LKT/MWT/UZT
-! ObsType%SaveOneSimval for each GwtAptType observation.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: i
integer(I4B) :: igwfnode
@@ -2954,7 +2920,7 @@ subroutine apt_bd_obs(this)
logical :: found
! ------------------------------------------------------------------------------
!
- ! -- Write simulated values for all LAK observations
+ ! -- Write simulated values for all Advanced Package observations
if (this%obs%npakobs > 0) then
call this%obs%obs_bd_clear()
do i = 1, this%obs%npakobs
@@ -2963,11 +2929,11 @@ subroutine apt_bd_obs(this)
v = DNODATA
jj = obsrv%indxbnds(j)
select case (obsrv%ObsTypeId)
- case ('CONCENTRATION')
+ case ('CONCENTRATION', 'TEMPERATURE')
if (this%iboundpak(jj) /= 0) then
v = this%xnewpak(jj)
end if
- case ('LKT', 'SFT', 'MWT', 'UZT')
+ case ('LKT', 'SFT', 'MWT', 'UZT', 'LKE', 'SFE', 'MWE', 'UZE')
n = this%flowbudptr%budterm(this%idxbudgwf)%id1(jj)
if (this%iboundpak(n) /= 0) then
igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(jj)
@@ -2989,7 +2955,8 @@ subroutine apt_bd_obs(this)
end if
case ('FROM-MVR')
if (this%iboundpak(jj) /= 0 .and. this%idxbudfmvr > 0) then
- v = this%qmfrommvr(jj)
+!! v = this%qmfrommvr(jj)
+ call this%apt_fmvr_term(jj, n1, n2, v)
end if
case ('TO-MVR')
if (this%idxbudtmvr > 0) then
@@ -3023,19 +2990,15 @@ subroutine apt_bd_obs(this)
end if
end if
!
+ ! -- Return
return
end subroutine apt_bd_obs
+ !> @brief Check if observation exists in an advanced package
+ !<
subroutine pak_bd_obs(this, obstypeid, jj, v, found)
-! ******************************************************************************
-! pak_bd_obs --
-! -- check for observations in concrete packages.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtAptType), intent(inout) :: this
+ class(TspAptType), intent(inout) :: this
character(len=*), intent(in) :: obstypeid
integer(I4B), intent(in) :: jj
real(DP), intent(inout) :: v
@@ -3046,15 +3009,15 @@ subroutine pak_bd_obs(this, obstypeid, jj, v, found)
! -- set found = .false. because obstypeid is not known
found = .false.
!
+ ! -- Return
return
end subroutine pak_bd_obs
- !> @brief Process observation IDs for a package
- !!
- !! Method to process observation ID strings for an APT package.
- !! This processor is only for observation types that support ID1
- !! and not ID2.
- !!
+ !> @brief Process observation IDs for an advanced package
+ !!
+ !! Method to process observation ID strings for an APT package.
+ !! This processor is only for observation types that support ID1
+ !! and not ID2.
!<
subroutine apt_process_obsID(obsrv, dis, inunitobs, iout)
! -- dummy variables
@@ -3092,16 +3055,15 @@ subroutine apt_process_obsID(obsrv, dis, inunitobs, iout)
! because there is only one reach per GWT connection.
obsrv%NodeNumber2 = 1
!
- ! -- return
+ ! -- Return
return
end subroutine apt_process_obsID
!> @brief Process observation IDs for a package
- !!
- !! Method to process observation ID strings for an APT package.
- !! This processor is for the case where if ID1 is an integer
- !! then ID2 must be provided.
- !!
+ !!
+ !! Method to process observation ID strings for an APT package. This
+ !! processor is for the case where if ID1 is an integer then ID2 must be
+ !! provided.
!<
subroutine apt_process_obsID12(obsrv, dis, inunitobs, iout)
! -- dummy variables
@@ -3146,23 +3108,21 @@ subroutine apt_process_obsID12(obsrv, dis, inunitobs, iout)
! -- store reach number (NodeNumber)
obsrv%NodeNumber = nn1
!
- ! -- return
+ ! -- Return
return
end subroutine apt_process_obsID12
+ !> @brief Setup a table object an advanced package
+ !!
+ !! Set up the table object that is used to write the apt concentration
+ !! (or temperature) data. The terms listed here must correspond in the
+ !! apt_ot method.
+ !<
subroutine apt_setup_tableobj(this)
-! ******************************************************************************
-! apt_setup_tableobj -- Set up the table object that is used to write the apt
-! conc data. The terms listed here must correspond in
-! in the apt_ot method.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LINELENGTH, LENBUDTXT
! -- dummy
- class(GwtAptType) :: this
+ class(TspAptType) :: this
! -- local
integer(I4B) :: nterms
character(len=LINELENGTH) :: title
@@ -3179,7 +3139,8 @@ subroutine apt_setup_tableobj(this)
! -- set up table title
title = trim(adjustl(this%text))//' PACKAGE ('// &
trim(adjustl(this%packName))// &
- ') CONCENTRATION FOR EACH CONTROL VOLUME'
+ ') '//trim(adjustl(this%depvartype))// &
+ &' FOR EACH CONTROL VOLUME'
!
! -- set up dv tableobj
call table_cr(this%dvtab, this%packName, title)
@@ -3197,12 +3158,13 @@ subroutine apt_setup_tableobj(this)
call this%dvtab%initialize_column(text_temp, 10, alignment=TABCENTER)
!
! -- feature conc
- text_temp = 'CONC'
+ !text_temp = 'CONC'
+ text_temp = this%depvartype(1:4)
call this%dvtab%initialize_column(text_temp, 12, alignment=TABCENTER)
end if
!
- ! -- return
+ ! -- Return
return
end subroutine apt_setup_tableobj
-end module GwtAptModule
+end module TspAptModule
diff --git a/src/Model/GroundWaterTransport/gwt1cnc1.f90 b/src/Model/TransportModel/tsp1cnc1.f90
similarity index 69%
rename from src/Model/GroundWaterTransport/gwt1cnc1.f90
rename to src/Model/TransportModel/tsp1cnc1.f90
index 5fc5378f078..ec2c6c5a15b 100644
--- a/src/Model/GroundWaterTransport/gwt1cnc1.f90
+++ b/src/Model/TransportModel/tsp1cnc1.f90
@@ -1,8 +1,8 @@
-module GwtCncModule
+module TspCncModule
!
use KindModule, only: DP, I4B
use ConstantsModule, only: DZERO, DONE, NAMEDBOUNDFLAG, LENFTYPE, &
- LENPACKAGENAME
+ LENPACKAGENAME, LENVARNAME
use ObsModule, only: DefaultObsIdProcessor
use BndModule, only: BndType
use ObserveModule, only: ObserveType
@@ -18,10 +18,14 @@ module GwtCncModule
character(len=LENFTYPE) :: ftype = 'CNC'
character(len=LENPACKAGENAME) :: text = ' CNC'
!
- type, extends(BndType) :: GwtCncType
+ type, extends(BndType) :: TspCncType
+
real(DP), dimension(:), pointer, contiguous :: ratecncin => null() !simulated flows into constant conc (excluding other concs)
real(DP), dimension(:), pointer, contiguous :: ratecncout => null() !simulated flows out of constant conc (excluding to other concs)
+ character(len=LENVARNAME) :: depvartype = '' !< stores string of dependent variable type, depending on model type
+
contains
+
procedure :: bnd_rp => cnc_rp
procedure :: bnd_ad => cnc_ad
procedure :: bnd_ck => cnc_ck
@@ -36,19 +40,17 @@ module GwtCncModule
procedure, public :: bnd_df_obs => cnc_df_obs
! -- method for time series
procedure, public :: bnd_rp_ts => cnc_rp_ts
- end type GwtCncType
+
+ end type TspCncType
contains
- subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
-! ******************************************************************************
-! cnc_create -- Create a New Constant Concentration Package
-! Subroutine: (1) create new-style package
-! (2) point packobj to the new package
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Create a new constant concentration or temperature package
+ !!
+ !! Routine points packobj to the newly created package
+ !<
+ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
+ depvartype)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
@@ -57,8 +59,9 @@ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
+ character(len=LENVARNAME), intent(in) :: depvartype
! -- local
- type(GwtCncType), pointer :: cncobj
+ type(TspCncType), pointer :: cncobj
! ------------------------------------------------------------------------------
!
! -- allocate the object and assign values to object variables
@@ -83,21 +86,21 @@ subroutine cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
packobj%ncolbnd = 1
packobj%iscloc = 1
!
- ! -- return
+ ! -- Store the appropriate label based on the dependent variable
+ cncobj%depvartype = depvartype
+ !
+ ! -- Return
return
end subroutine cnc_create
+ !> @brief Allocate arrays specific to the constant concentration/tempeature
+ !! package.
+ !<
subroutine cnc_allocate_arrays(this, nodelist, auxvar)
-! ******************************************************************************
-! allocate_scalars -- allocate arrays
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar
! -- local
@@ -116,22 +119,20 @@ subroutine cnc_allocate_arrays(this, nodelist, auxvar)
this%ratecncout(i) = DZERO
end do
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_allocate_arrays
+ !> @brief Constant concentration/temperature read and prepare (rp) routine
+ !<
subroutine cnc_rp(this)
-! ******************************************************************************
-! cnc_rp -- Read and prepare
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
use SimModule, only: store_error
+ use InputOutputModule, only: lowcase
implicit none
- class(GwtCncType), intent(inout) :: this
+ class(TspCncType), intent(inout) :: this
integer(I4B) :: i, node, ibd, ierr
character(len=30) :: nodestr
+ character(len=LENVARNAME) :: dvtype
! ------------------------------------------------------------------------------
!
! -- Reset previous CNCs to active cell
@@ -143,15 +144,17 @@ subroutine cnc_rp(this)
! -- Call the parent class read and prepare
call this%BndType%bnd_rp()
!
- ! -- Set ibound to -(ibcnum + 1) for constant concentration cells
+ ! -- Set ibound to -(ibcnum + 1) for constant concentration/temperature cells
ierr = 0
do i = 1, this%nbound
node = this%nodelist(i)
ibd = this%ibound(node)
if (ibd < 0) then
call this%dis%noder_to_string(node, nodestr)
- call store_error('Cell is already a constant concentration: ' &
- //trim(adjustl(nodestr)))
+ dvtype = trim(this%depvartype)
+ call lowcase(dvtype)
+ call store_error('Cell is already a constant ' &
+ //dvtype//': '//trim(adjustl(nodestr)))
ierr = ierr + 1
else
this%ibound(node) = -this%ibcnum
@@ -163,10 +166,14 @@ subroutine cnc_rp(this)
call this%parser%StoreErrorUnit()
end if
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_rp
+ !> @brief Constant concentration/temperature package advance routine
+ !!
+ !! Add package connections to matrix
+ !<
subroutine cnc_ad(this)
! ******************************************************************************
! cnc_ad -- Advance
@@ -176,7 +183,7 @@ subroutine cnc_ad(this)
! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
! -- local
integer(I4B) :: i, node
real(DP) :: cb
@@ -186,7 +193,7 @@ subroutine cnc_ad(this)
! -- Advance the time series
call this%TsManager%ad()
!
- ! -- Process each entry in the constant concentration cell list
+ ! -- Process each entry in the constant concentration/temperature cell list
do i = 1, this%nbound
node = this%nodelist(i)
cb = this%bound(1, i)
@@ -199,22 +206,18 @@ subroutine cnc_ad(this)
! "current" value.
call this%obs%obs_ad()
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_ad
+ !> @brief Check constant concentration/temperature boundary condition data
+ !<
subroutine cnc_ck(this)
-! ******************************************************************************
-! cnc_ck -- Check cnc boundary condition data
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LINELENGTH
use SimModule, only: store_error, count_errors, store_error_unit
! -- dummy
- class(GwtCncType), intent(inout) :: this
+ class(TspCncType), intent(inout) :: this
! -- local
character(len=LINELENGTH) :: errmsg
character(len=30) :: nodestr
@@ -241,19 +244,18 @@ subroutine cnc_ck(this)
call this%parser%StoreErrorUnit()
end if
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_ck
+ !> @brief Override bnd_fc and do nothing
+ !!
+ !! For constant concentration/temperature boundary type, the call to bnd_fc
+ !! needs to be overwritten to prevent logic found therein from being applied
+ !<
subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln)
-! **************************************************************************
-! cnc_fc -- Override bnd_fc and do nothing
-! **************************************************************************
-!
-! SPECIFICATIONS:
-! --------------------------------------------------------------------------
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
real(DP), dimension(:), intent(inout) :: rhs
integer(I4B), dimension(:), intent(in) :: ia
integer(I4B), dimension(:), intent(in) :: idxglo
@@ -261,20 +263,19 @@ subroutine cnc_fc(this, rhs, ia, idxglo, matrix_sln)
! -- local
! --------------------------------------------------------------------------
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_fc
+ !> @brief Calculate flow associated with constant concentration/tempearture
+ !! boundary
+ !!
+ !! This method overrides bnd_cq()
+ !<
subroutine cnc_cq(this, x, flowja, iadv)
-! ******************************************************************************
-! cnc_cq -- Calculate constant concenration flow. This method overrides bnd_cq().
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtCncType), intent(inout) :: this
+ class(TspCncType), intent(inout) :: this
real(DP), dimension(:), intent(in) :: x
real(DP), dimension(:), contiguous, intent(inout) :: flowja
integer(I4B), optional, intent(in) :: iadv
@@ -303,7 +304,7 @@ subroutine cnc_cq(this, x, flowja, iadv)
! -- Calculate the flow rate into the cell.
do ipos = this%dis%con%ia(node) + 1, &
this%dis%con%ia(node + 1) - 1
- q = flowja(ipos)
+ q = flowja(ipos) ! klughe note: flowja should already be in terms of energy for heat transport
rate = rate - q
! -- only accumulate chin and chout for active
! connected cells
@@ -332,38 +333,44 @@ subroutine cnc_cq(this, x, flowja, iadv)
!
end if
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_cq
+ !> @brief Add package ratin/ratout to model budget
+ !<
subroutine cnc_bd(this, model_budget)
- ! -- add package ratin/ratout to model budget
+ ! -- modules
use TdisModule, only: delt
use BudgetModule, only: BudgetType, rate_accumulator
- class(GwtCncType) :: this
+ ! -- dummy
+ class(TspCncType) :: this
type(BudgetType), intent(inout) :: model_budget
+ ! -- local
real(DP) :: ratin
real(DP) :: ratout
real(DP) :: dum
integer(I4B) :: isuppress_output
+! ------------------------------------------------------------------------------
isuppress_output = 0
call rate_accumulator(this%ratecncin(1:this%nbound), ratin, dum)
call rate_accumulator(this%ratecncout(1:this%nbound), ratout, dum)
call model_budget%addentry(ratin, ratout, delt, this%text, &
isuppress_output, this%packName)
+ !
+ ! -- Return
+ return
end subroutine cnc_bd
+ !> @brief Deallocate memory
+ !!
+ !! Method to deallocate memory for the package.
+ !<
subroutine cnc_da(this)
-! ******************************************************************************
-! cnc_da -- deallocate
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
! ------------------------------------------------------------------------------
!
! -- Deallocate parent package
@@ -373,19 +380,18 @@ subroutine cnc_da(this)
call mem_deallocate(this%ratecncin)
call mem_deallocate(this%ratecncout)
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_da
+ !> @brief Define labels used in list file
+ !!
+ !! Define the list heading that is written to iout when PRINT_INPUT option
+ !! is used.
+ !<
subroutine define_listlabel(this)
-! ******************************************************************************
-! define_listlabel -- Define the list heading that is written to iout when
-! PRINT_INPUT option is used.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- class(GwtCncType), intent(inout) :: this
+ ! -- dummy
+ class(TspCncType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
! -- create the header list label
@@ -400,47 +406,42 @@ subroutine define_listlabel(this)
else
write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
end if
- write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONCENTRATION'
+ write (this%listlabel, '(a, a16)') trim(this%listlabel), &
+ trim(this%depvartype)
if (this%inamedbound == 1) then
write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine define_listlabel
- ! -- Procedures related to observations
-
+ !> @brief Procedure related to observation processing
+ !!
+ !! This routine:
+ !! - returns true because the CNC package supports observations,
+ !! - overrides packagetype%_obs_supported()
logical function cnc_obs_supported(this)
-! ******************************************************************************
-! cnc_obs_supported
-! -- Return true because CNC package supports observations.
-! -- Overrides packagetype%_obs_supported()
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
! ------------------------------------------------------------------------------
!
cnc_obs_supported = .true.
!
- ! -- return
+ ! -- Return
return
end function cnc_obs_supported
+ !> @brief Procedure related to observation processing
+ !!
+ !! This routine:
+ !! - defines observations
+ !! - stores observation types supported by the CNC package,
+ !! - overrides BndType%bnd_df_obs
+ !<
subroutine cnc_df_obs(this)
-! ******************************************************************************
-! cnc_df_obs (implements bnd_df_obs)
-! -- Store observation type supported by CNC package.
-! -- Overrides BndType%bnd_df_obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtCncType) :: this
+ class(TspCncType) :: this
! -- local
integer(I4B) :: indx
! ------------------------------------------------------------------------------
@@ -448,24 +449,19 @@ subroutine cnc_df_obs(this)
call this%obs%StoreObsType('cnc', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_df_obs
- ! -- Procedure related to time series
-
+ !> @brief Procedure related to time series
+ !!
+ !! Assign tsLink%Text appropriately for all time series in use by package.
+ !! In CNC package, variable CONCENTRATION or TEMPERATURE can be controlled
+ !! by time series.
+ !<
subroutine cnc_rp_ts(this)
-! ******************************************************************************
-! -- Assign tsLink%Text appropriately for
-! all time series in use by package.
-! In CNC package variable CONCENTRATION
-! can be controlled by time series.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtCncType), intent(inout) :: this
+ class(TspCncType), intent(inout) :: this
! -- local
integer(I4B) :: i, nlinks
type(TimeSeriesLinkType), pointer :: tslink => null()
@@ -477,13 +473,13 @@ subroutine cnc_rp_ts(this)
if (associated(tslink)) then
select case (tslink%JCol)
case (1)
- tslink%Text = 'CONCENTRATION'
+ tslink%Text = trim(this%depvartype)
end select
end if
end do
!
- ! -- return
+ ! -- Return
return
end subroutine cnc_rp_ts
-end module GwtCncModule
+end module TspCncModule
diff --git a/src/Model/GroundWaterTransport/gwt1fmi1.f90 b/src/Model/TransportModel/tsp1fmi1.f90
similarity index 86%
rename from src/Model/GroundWaterTransport/gwt1fmi1.f90
rename to src/Model/TransportModel/tsp1fmi1.f90
index 4e33a8af884..7b183fe625e 100644
--- a/src/Model/GroundWaterTransport/gwt1fmi1.f90
+++ b/src/Model/TransportModel/tsp1fmi1.f90
@@ -1,8 +1,8 @@
-module GwtFmiModule
+module TspFmiModule
use KindModule, only: DP, I4B
use ConstantsModule, only: DONE, DZERO, DHALF, LINELENGTH, LENBUDTXT, &
- LENPACKAGENAME
+ LENPACKAGENAME, LENVARNAME
use SimModule, only: store_error, store_error_unit
use SimVariablesModule, only: errmsg
use FlowModelInterfaceModule, only: FlowModelInterfaceType
@@ -16,7 +16,7 @@ module GwtFmiModule
implicit none
private
- public :: GwtFmiType
+ public :: TspFmiType
public :: fmi_cr
character(len=LENPACKAGENAME) :: text = ' GWTFMI'
@@ -34,14 +34,16 @@ module GwtFmiModule
type(BudgetObjectType), pointer :: ptr
end type BudObjPtrArray
- type, extends(FlowModelInterfaceType) :: GwtFmiType
+ type, extends(FlowModelInterfaceType) :: TspFmiType
integer(I4B), dimension(:), pointer, contiguous :: iatp => null() !< advanced transport package applied to gwfpackages
integer(I4B), pointer :: iflowerr => null() !< add the flow error correction
real(DP), dimension(:), pointer, contiguous :: flowcorrect => null() !< mass flow correction
+ real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy
type(DataAdvancedPackageType), &
dimension(:), pointer, contiguous :: datp => null()
type(BudObjPtrArray), dimension(:), allocatable :: aptbudobj !< flow budget objects for the advanced packages
+
contains
procedure :: allocate_arrays => gwtfmi_allocate_arrays
@@ -61,18 +63,22 @@ module GwtFmiModule
procedure :: read_options => gwtfmi_read_options
procedure :: set_aptbudobj_pointer
procedure :: read_packagedata => gwtfmi_read_packagedata
+ procedure :: set_active_status
- end type GwtFmiType
+ end type TspFmiType
contains
- !> @brief Create a new FMI object
- subroutine fmi_cr(fmiobj, name_model, inunit, iout)
+ !> @breif Create a new FMI object
+ !<
+ subroutine fmi_cr(fmiobj, name_model, inunit, iout, eqnsclfac, depvartype)
! -- dummy
- type(GwtFmiType), pointer :: fmiobj
+ type(TspFmiType), pointer :: fmiobj
character(len=*), intent(in) :: name_model
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
!
! -- Create the object
allocate (fmiobj)
@@ -91,16 +97,23 @@ subroutine fmi_cr(fmiobj, name_model, inunit, iout)
! -- Initialize block parser
call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout)
!
+ ! -- Assign label based on dependent variable
+ fmiobj%depvartype = depvartype
+ !
+ ! -- Store pointer to governing equation scale factor
+ fmiobj%eqnsclfac => eqnsclfac
+ !
! -- Return
return
end subroutine fmi_cr
!> @brief Read and prepare
+ !<
subroutine fmi_rp(this, inmvr)
! -- modules
use TdisModule, only: kper, kstp
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: inmvr
! -- local
! -- formats
@@ -126,25 +139,16 @@ subroutine fmi_rp(this, inmvr)
return
end subroutine fmi_rp
- !> @brief Advance
+ !> @brief Advance routine for FMI object
+ !<
subroutine fmi_ad(this, cnew)
! -- modules
use ConstantsModule, only: DHDRY
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
real(DP), intent(inout), dimension(:) :: cnew
! -- local
integer(I4B) :: n
- integer(I4B) :: m
- integer(I4B) :: ipos
- real(DP) :: crewet, tflow, flownm
- character(len=15) :: nodestr
- character(len=*), parameter :: fmtdry = &
- &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE &
- &WITH DRY CONCENTRATION = ', G13.5)"
- character(len=*), parameter :: fmtrewet = &
- &"(/1X,'DRY CELL REACTIVATED AT ', a,&
- &' WITH STARTING CONCENTRATION =',G13.5)"
!
! -- Set flag to indicated that flows are being updated. For the case where
! flows may be reused (only when flows are read from a file) then set
@@ -173,68 +177,23 @@ subroutine fmi_ad(this, cnew)
end do
end if
!
- ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry
- do n = 1, this%dis%nodes
- !
- ! -- Calculate the ibound-like array that has 0 if saturation
- ! is zero and 1 otherwise
- if (this%gwfsat(n) > DZERO) then
- this%ibdgwfsat0(n) = 1
- else
- this%ibdgwfsat0(n) = 0
- end if
- !
- ! -- Check if active transport cell is inactive for flow
- if (this%ibound(n) > 0) then
- if (this%gwfhead(n) == DHDRY) then
- ! -- transport cell should be made inactive
- this%ibound(n) = 0
- cnew(n) = DHDRY
- call this%dis%noder_to_string(n, nodestr)
- write (this%iout, fmtdry) trim(nodestr), DHDRY
- end if
- end if
- !
- ! -- Convert dry transport cell to active if flow has rewet
- if (cnew(n) == DHDRY) then
- if (this%gwfhead(n) /= DHDRY) then
- !
- ! -- obtain weighted concentration
- crewet = DZERO
- tflow = DZERO
- do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
- m = this%dis%con%ja(ipos)
- flownm = this%gwfflowja(ipos)
- if (flownm > 0) then
- if (this%ibound(m) /= 0) then
- crewet = crewet + cnew(m) * flownm
- tflow = tflow + this%gwfflowja(ipos)
- end if
- end if
- end do
- if (tflow > DZERO) then
- crewet = crewet / tflow
- else
- crewet = DZERO
- end if
- !
- ! -- cell is now wet
- this%ibound(n) = 1
- cnew(n) = crewet
- call this%dis%noder_to_string(n, nodestr)
- write (this%iout, fmtrewet) trim(nodestr), crewet
- end if
- end if
- end do
+ ! -- set inactive transport cell status
+ if (this%idryinactive /= 0) then
+ call this%set_active_status(cnew)
+ end if
!
! -- Return
return
end subroutine fmi_ad
- !> @brief Calculate coefficients and fill matrix and rhs
+ !> @brief Calculate coefficients and fill matrix and rhs terms associated
+ !! with FMI object
+ !<
subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
+ ! -- modules
+ !use BndModule, only: BndType, GetBndFromList
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer, intent(in) :: nodes
real(DP), intent(in), dimension(nodes) :: cold
integer(I4B), intent(in) :: nja
@@ -261,9 +220,14 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
end subroutine fmi_fc
!> @brief Calculate flow correction
+ !!
+ !! Where there is a flow imbalance for a given cell, a correction may be
+ !! applied if selected
+ !<
subroutine fmi_cq(this, cnew, flowja)
+ ! -- modules
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
real(DP), intent(in), dimension(:) :: cnew
real(DP), dimension(:), contiguous, intent(inout) :: flowja
! -- local
@@ -279,7 +243,7 @@ subroutine fmi_cq(this, cnew, flowja)
rate = DZERO
idiag = this%dis%con%ia(n)
if (this%ibound(n) > 0) then
- rate = -this%gwfflowja(idiag) * cnew(n)
+ rate = -this%gwfflowja(idiag) * cnew(n) * this%eqnsclfac
end if
this%flowcorrect(n) = rate
flowja(idiag) = flowja(idiag) + rate
@@ -290,13 +254,14 @@ subroutine fmi_cq(this, cnew, flowja)
return
end subroutine fmi_cq
- !> @brief Calculate budget terms
+ !> @brief Calculate budget terms associated with FMI object
+ !<
subroutine fmi_bd(this, isuppress_output, model_budget)
! -- modules
use TdisModule, only: delt
use BudgetModule, only: BudgetType, rate_accumulator
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: isuppress_output
type(BudgetType), intent(inout) :: model_budget
! -- local
@@ -313,10 +278,11 @@ subroutine fmi_bd(this, isuppress_output, model_budget)
return
end subroutine fmi_bd
- !> @brief Save budget terms
+ !> @brief Save budget terms associated with FMI object
+ !<
subroutine fmi_ot_flow(this, icbcfl, icbcun)
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: icbcfl
integer(I4B), intent(in) :: icbcun
! -- local
@@ -354,11 +320,14 @@ subroutine fmi_ot_flow(this, icbcfl, icbcun)
end subroutine fmi_ot_flow
!> @brief Deallocate variables
+ !!
+ !! Deallocate memory associated with FMI object
+ !<
subroutine gwtfmi_da(this)
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- todo: finalize hfr and bfr either here or in a finalize routine
!
! -- deallocate any memory stored with gwfpackages
@@ -397,6 +366,7 @@ subroutine gwtfmi_da(this)
call mem_deallocate(this%iuhds)
call mem_deallocate(this%iumvr)
call mem_deallocate(this%nflowpack)
+ call mem_deallocate(this%idryinactive)
!
! -- deallocate parent
call this%NumericalPackageType%da()
@@ -405,12 +375,15 @@ subroutine gwtfmi_da(this)
return
end subroutine gwtfmi_da
- !> @brief Allocate scalars
+ !> @ brief Allocate scalars
+ !!
+ !! Allocate scalar variables for an FMI object
+ !<
subroutine gwtfmi_allocate_scalars(this)
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
!
! -- allocate scalars in parent
@@ -430,13 +403,16 @@ subroutine gwtfmi_allocate_scalars(this)
return
end subroutine gwtfmi_allocate_scalars
- !> @brief Allocate arrays
+ !> @ brief Allocate arrays for FMI object
+ !!
+ !! Method to allocate arrays for the FMI package.
+ !<
subroutine gwtfmi_allocate_arrays(this, nodes)
use MemoryManagerModule, only: mem_allocate
- !modules
+ ! -- modules
use ConstantsModule, only: DZERO
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: nodes
! -- local
integer(I4B) :: n
@@ -458,10 +434,100 @@ subroutine gwtfmi_allocate_arrays(this, nodes)
return
end subroutine gwtfmi_allocate_arrays
- !> @brief Calculate groundwater cell head saturation for end of last time step
+ !> @brief set gwt transport cell status
+ !!
+ !! Dry GWF cells are treated differently by GWT and GWE. Transport does not
+ !! occur in deactivated GWF cells; however, GWE still simulates conduction
+ !! through dry cells.
+ !<
+ subroutine set_active_status(this, cnew)
+ ! -- modules
+ use ConstantsModule, only: DHDRY
+ ! -- dummy
+ class(TspFmiType) :: this
+ real(DP), intent(inout), dimension(:) :: cnew
+ ! -- local
+ integer(I4B) :: n
+ integer(I4B) :: m
+ integer(I4B) :: ipos
+ real(DP) :: crewet, tflow, flownm
+ character(len=15) :: nodestr
+ !
+ do n = 1, this%dis%nodes
+ ! -- Calculate the ibound-like array that has 0 if saturation
+ ! is zero and 1 otherwise
+ if (this%gwfsat(n) > DZERO) then
+ this%ibdgwfsat0(n) = 1
+ else
+ this%ibdgwfsat0(n) = 0
+ end if
+ !
+ ! -- Check if active transport cell is inactive for flow
+ if (this%ibound(n) > 0) then
+ if (this%gwfhead(n) == DHDRY) then
+ ! -- transport cell should be made inactive
+ this%ibound(n) = 0
+ cnew(n) = DHDRY
+ call this%dis%noder_to_string(n, nodestr)
+ write (this%iout, '(/1x,a,1x,a,a,1x,a,1x,a,1x,G13.5)') &
+ 'WARNING: DRY CELL ENCOUNTERED AT', trim(nodestr), '; RESET AS &
+ &INACTIVE WITH DRY', trim(adjustl(this%depvartype)), &
+ '=', DHDRY
+ end if
+ end if
+ end do
+ !
+ ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry
+ do n = 1, this%dis%nodes
+ !
+ ! -- Convert dry transport cell to active if flow has rewet
+ if (cnew(n) == DHDRY) then
+ if (this%gwfhead(n) /= DHDRY) then
+ !
+ ! -- obtain weighted concentration/temperature
+ crewet = DZERO
+ tflow = DZERO
+ do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
+ m = this%dis%con%ja(ipos)
+ flownm = this%gwfflowja(ipos)
+ if (flownm > 0) then
+ if (this%ibound(m) /= 0) then
+ crewet = crewet + cnew(m) * flownm ! kluge note: apparently no need to multiply flows by eqnsclfac
+ tflow = tflow + this%gwfflowja(ipos) ! since it will divide out below anyway
+ end if
+ end if
+ end do
+ if (tflow > DZERO) then
+ crewet = crewet / tflow
+ else
+ crewet = DZERO
+ end if
+ !
+ ! -- cell is now wet
+ this%ibound(n) = 1
+ cnew(n) = crewet
+ call this%dis%noder_to_string(n, nodestr)
+ write (this%iout, '(/1x,a,1x,a,1x,a,1x,a,1x,a,1x,G13.5)') &
+ 'DRY CELL REACTIVATED AT', trim(nodestr), 'WITH STARTING', &
+ trim(adjustl(this%depvartype)), '=', crewet
+ end if
+ end if
+ end do
+
+ !
+ ! -- Return
+ return
+ end subroutine set_active_status
+
+ !> @brief Calculate the previous saturation level
+ !!
+ !! Calculate the groundwater cell head saturation for the end of
+ !! the last time step
+ !<
function gwfsatold(this, n, delt) result(satold)
+ ! -- modules
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: n
real(DP), intent(in) :: delt
! -- result
@@ -484,13 +550,14 @@ function gwfsatold(this, n, delt) result(satold)
end function gwfsatold
!> @brief Read options from input file
+ !<
subroutine gwtfmi_read_options(this)
! -- modules
use ConstantsModule, only: LINELENGTH, DEM6
use InputOutputModule, only: getunit, openfile, urdaux
use SimModule, only: store_error, store_error_unit
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
character(len=LINELENGTH) :: keyword
integer(I4B) :: ierr
@@ -529,11 +596,14 @@ subroutine gwtfmi_read_options(this)
write (this%iout, '(1x,a)') 'END OF FMI OPTIONS'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine gwtfmi_read_options
- !> @brief Read packagedata block from input file
+ !> @brief Read PACKAGEDATA block
+ !!
+ !! Read packagedata block from input file
+ !<
subroutine gwtfmi_read_packagedata(this)
! -- modules
use OpenSpecModule, only: ACCESS, FORM
@@ -541,7 +611,7 @@ subroutine gwtfmi_read_packagedata(this)
use InputOutputModule, only: getunit, openfile, urdaux
use SimModule, only: store_error, store_error_unit
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
type(BudgetObjectType), pointer :: budobjptr
character(len=LINELENGTH) :: keyword, fname
@@ -659,7 +729,7 @@ subroutine gwtfmi_read_packagedata(this)
write (this%iout, '(1x,a)') 'END OF FMI PACKAGEDATA'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine gwtfmi_read_packagedata
@@ -669,11 +739,10 @@ end subroutine gwtfmi_read_packagedata
!! pointer budget object, and this routine will look through the budget
!! objects managed by FMI and point to the one with the same name, such as
!! LAK-1, SFR-1, etc.
- !!
!<
subroutine set_aptbudobj_pointer(this, name, budobjptr)
! -- modules
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- dumm
character(len=*), intent(in) :: name
type(BudgetObjectType), pointer :: budobjptr
@@ -688,17 +757,22 @@ subroutine set_aptbudobj_pointer(this, name, budobjptr)
end if
end do
!
- ! -- return
+ ! -- Return
return
end subroutine set_aptbudobj_pointer
- !> @brief Initialize terms and count unique terms/packages in file
+ !> @brief Initialize the groundwater flow terms based on the budget file
+ !! reader
+ !!
+ !! Initalize terms and figure out how many different terms and packages
+ !! are contained within the file
+ !<
subroutine initialize_gwfterms_from_bfr(this)
! -- modules
use MemoryManagerModule, only: mem_allocate
use SimModule, only: store_error, store_error_unit, count_errors
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
integer(I4B) :: nflowpack
integer(I4B) :: i, ip
@@ -788,16 +862,19 @@ subroutine initialize_gwfterms_from_bfr(this)
call this%parser%StoreErrorUnit()
end if
!
- ! -- return
+ ! -- Return
return
end subroutine initialize_gwfterms_from_bfr
- !> @brief Initialize flow terms from a gwf-gwt exchange
+ !> @brief Initialize groundwater flow terms from the groundwater budget
+ !!
+ !! Flows are coming from a gwf-gwt exchange object
+ !<
subroutine initialize_gwfterms_from_gwfbndlist(this)
! -- modules
use BndModule, only: BndType, GetBndFromList
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
integer(I4B) :: ngwfpack
integer(I4B) :: ngwfterms
@@ -856,21 +933,22 @@ subroutine initialize_gwfterms_from_gwfbndlist(this)
iterm = iterm + 1
end if
end do
+ !
+ ! -- Return
return
end subroutine initialize_gwfterms_from_gwfbndlist
- !> @brief Allocate GWF packages
+ !> @brief Initialize an array for storing PackageBudget objects.
!!
!! This routine allocates gwfpackages (an array of PackageBudget
!! objects) to the proper size and initializes member variables.
- !!
!<
subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms)
! -- modules
use ConstantsModule, only: LENMEMPATH
use MemoryManagerModule, only: mem_allocate
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
integer(I4B), intent(in) :: ngwfterms
! -- local
integer(I4B) :: n
@@ -898,15 +976,18 @@ subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms)
call this%gwfpackages(n)%initialize(memPath)
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwtfmi_allocate_gwfpackages
- !> @brief Deallocate memory in the gwfpackages array
+ !> @brief Deallocate memory
+ !!
+ !! Deallocate memory that stores the gwfpackages array
+ !<
subroutine gwtfmi_deallocate_gwfpackages(this)
! -- modules
! -- dummy
- class(GwtFmiType) :: this
+ class(TspFmiType) :: this
! -- local
integer(I4B) :: n
!
@@ -915,8 +996,8 @@ subroutine gwtfmi_deallocate_gwfpackages(this)
call this%gwfpackages(n)%da()
end do
!
- ! -- return
+ ! -- Return
return
end subroutine gwtfmi_deallocate_gwfpackages
-end module GwtFmiModule
+end module TspFmiModule
diff --git a/src/Model/GroundWaterTransport/gwt1ic1.f90 b/src/Model/TransportModel/tsp1ic1.f90
similarity index 73%
rename from src/Model/GroundWaterTransport/gwt1ic1.f90
rename to src/Model/TransportModel/tsp1ic1.f90
index e9d872a7137..90b805d937d 100644
--- a/src/Model/GroundWaterTransport/gwt1ic1.f90
+++ b/src/Model/TransportModel/tsp1ic1.f90
@@ -1,36 +1,39 @@
-module GwtIcModule
+module TspIcModule
use KindModule, only: DP, I4B
+ use ConstantsModule, only: LENVARNAME
use GwfIcModule, only: GwfIcType
use BlockParserModule, only: BlockParserType
use BaseDisModule, only: DisBaseType
implicit none
private
- public :: GwtIcType
+ public :: TspIcType
public :: ic_cr
- ! -- Most of the GwtIcType functionality comes from GwfIcType
- type, extends(GwfIcType) :: GwtIcType
+ ! -- Most of the TspIcType functionality comes from GwfIcType
+ type, extends(GwfIcType) :: TspIcType
+ ! -- strings
+ character(len=LENVARNAME) :: depvartype = ''
+
contains
+
procedure :: read_data
- end type GwtIcType
+
+ end type TspIcType
contains
- subroutine ic_cr(ic, name_model, inunit, iout, dis)
-! ******************************************************************************
-! ic_cr -- Create a new initial conditions object
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Create a new initial conditions object
+ !<
+ subroutine ic_cr(ic, name_model, inunit, iout, dis, depvartype)
! -- dummy
- type(GwtIcType), pointer :: ic
+ type(TspIcType), pointer :: ic
character(len=*), intent(in) :: name_model
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
class(DisBaseType), pointer, intent(in) :: dis
+ character(len=LENVARNAME), intent(in) :: depvartype
! ------------------------------------------------------------------------------
!
! -- Create the object
@@ -48,6 +51,9 @@ subroutine ic_cr(ic, name_model, inunit, iout, dis)
! -- set pointers
ic%dis => dis
!
+ ! -- Give package access to the assigned labelsd based on dependent variable
+ ic%depvartype = depvartype
+ !
! -- Initialize block parser
call ic%parser%Initialize(ic%inunit, ic%iout)
!
@@ -55,18 +61,16 @@ subroutine ic_cr(ic, name_model, inunit, iout, dis)
return
end subroutine ic_cr
+ !> @brief Read initial conditions
+ !!
+ !! Read initial concentrations or temperatures depending on model type
+ !<
subroutine read_data(this)
-! ******************************************************************************
-! read_data
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LINELENGTH
use SimModule, only: store_error
! -- dummy
- class(GwtIcType) :: this
+ class(TspIcType) :: this
! -- local
character(len=LINELENGTH) :: errmsg, keyword
character(len=:), allocatable :: line
@@ -77,7 +81,7 @@ subroutine read_data(this)
! ------------------------------------------------------------------------------
!
! -- Setup the label
- aname(1) = 'INITIAL CONCENTRATION'
+ write (aname(1), '(a,1x,a)') 'INITIAL', trim(adjustl(this%depvartype))
!
! -- get griddata block
call this%parser%GetBlock('GRIDDATA', isfound, ierr)
@@ -111,4 +115,4 @@ subroutine read_data(this)
return
end subroutine read_data
-end module GwtIcModule
+end module TspIcModule
diff --git a/src/Model/GroundWaterTransport/gwt1mvt1.f90 b/src/Model/TransportModel/tsp1mvt1.f90
similarity index 78%
rename from src/Model/GroundWaterTransport/gwt1mvt1.f90
rename to src/Model/TransportModel/tsp1mvt1.f90
index 732b2e59ac3..ba73d59bea3 100644
--- a/src/Model/GroundWaterTransport/gwt1mvt1.f90
+++ b/src/Model/TransportModel/tsp1mvt1.f90
@@ -2,7 +2,7 @@
! -- This module is responsible for sending mass from providers into
! -- receiver qmfrommvr arrays and writing a mover transport budget
-module GwtMvtModule
+module TspMvtModule
use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, LENPAKLOC, &
@@ -11,7 +11,7 @@ module GwtMvtModule
use SimModule, only: store_error
use BaseDisModule, only: DisBaseType
use NumericalPackageModule, only: NumericalPackageType
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use BudgetModule, only: BudgetType, budget_cr
use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr
use TableModule, only: TableType, table_cr
@@ -19,17 +19,18 @@ module GwtMvtModule
implicit none
private
- public :: GwtMvtType
+ public :: TspMvtType
public :: mvt_cr
- type, extends(NumericalPackageType) :: GwtMvtType
+ type, extends(NumericalPackageType) :: TspMvtType
character(len=LENMODELNAME) :: gwfmodelname1 = '' !< name of model 1
character(len=LENMODELNAME) :: gwfmodelname2 = '' !< name of model 2 (set to modelname 1 for single model MVT)
integer(I4B), pointer :: maxpackages !< max number of packages
integer(I4B), pointer :: ibudgetout => null() !< unit number for budget output file
integer(I4B), pointer :: ibudcsv => null() !< unit number for csv budget output file
- type(GwtFmiType), pointer :: fmi1 => null() !< pointer to fmi object for model 1
- type(GwtFmiType), pointer :: fmi2 => null() !< pointer to fmi object for model 2 (set to fmi1 for single model)
+ real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy
+ type(TspFmiType), pointer :: fmi1 => null() !< pointer to fmi object for model 1
+ type(TspFmiType), pointer :: fmi2 => null() !< pointer to fmi object for model 2 (set to fmi1 for single model)
type(BudgetType), pointer :: budget => null() !< mover transport budget object (used to write balance table)
type(BudgetObjectType), pointer :: budobj => null() !< budget container (used to write binary file)
type(BudgetObjectType), pointer :: mvrbudobj => null() !< pointer to the water mover budget object
@@ -58,27 +59,24 @@ module GwtMvtModule
procedure :: set_fmi_pr_rc
procedure, private :: mvt_setup_outputtab
procedure, private :: mvt_print_outputtab
- end type GwtMvtType
+ end type TspMvtType
contains
- subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, gwfmodelname1, &
- gwfmodelname2, fmi2)
-! ******************************************************************************
-! mvt_cr -- Create a new initial conditions object
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Create a new mover transport object
+ !<
+ subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, & ! kluge note: does this need tsplab?
+ gwfmodelname1, gwfmodelname2, fmi2)
! -- dummy
- type(GwtMvtType), pointer :: mvt
+ type(TspMvtType), pointer :: mvt
character(len=*), intent(in) :: name_model
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
- type(GwtFmiType), intent(in), target :: fmi1
+ type(TspFmiType), intent(in), target :: fmi1
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
character(len=*), intent(in), optional :: gwfmodelname1
character(len=*), intent(in), optional :: gwfmodelname2
- type(GwtFmiType), intent(in), target, optional :: fmi2
+ type(TspFmiType), intent(in), target, optional :: fmi2
! ------------------------------------------------------------------------------
!
! -- Create the object
@@ -113,20 +111,19 @@ subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, gwfmodelname1, &
! -- create the budget object
call budgetobject_cr(mvt%budobj, 'TRANSPORT MOVER')
!
+ ! -- Store pointer to governing equation scale factor
+ mvt%eqnsclfac => eqnsclfac
+ !
! -- Return
return
end subroutine mvt_cr
+ !> @brief Define mover transport object
+ !<
subroutine mvt_df(this, dis)
-! ******************************************************************************
-! mvt_df -- Define
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
class(DisBaseType), pointer, intent(in) :: dis
! -- local
! -- formats
@@ -162,21 +159,17 @@ end subroutine mvt_df
!!
!<
subroutine set_pointer_mvrbudobj(this, mvrbudobj)
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
type(BudgetObjectType), intent(in), target :: mvrbudobj
this%mvrbudobj => mvrbudobj
end subroutine set_pointer_mvrbudobj
+ !> @brief Allocate and read mover-for-transport information
+ !<
subroutine mvt_ar(this)
-! ******************************************************************************
-! mvt_ar -- Allocate and read water mover information
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- locals
! ------------------------------------------------------------------------------
!
@@ -187,17 +180,13 @@ subroutine mvt_ar(this)
return
end subroutine mvt_ar
+ !> @brief Read and prepare mover transport object
+ !<
subroutine mvt_rp(this)
-! ******************************************************************************
-! mvt_rp -- Read and prepare
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: kper, kstp
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- local
! -- formats
! ------------------------------------------------------------------------------
@@ -224,22 +213,18 @@ subroutine mvt_rp(this)
return
end subroutine mvt_rp
+ !> @brief Calculate coefficients and fill amat and rhs
+ !!
+ !! The mvt package adds the mass flow rate to the provider qmfrommvr array.
+ !! The advanced packages know enough to subract any mass that is leaving, so
+ !! the mvt just adds mass coming in from elsewhere. Because the movers
+ !! change by stress period, their solute effects must be added to the right-
+ !! hand side of the transport matrix equations.
+ !<
subroutine mvt_fc(this, cnew1, cnew2)
-! ******************************************************************************
-! mvt_fc -- Calculate coefficients and fill amat and rhs
-!
-! The mvt package adds the mass flow rate to the provider qmfrommvr
-! array. The advanced packages know enough to subract any mass that is
-! leaving, so the mvt just adds mass coming in from elsewhere. Because the
-! movers change change by stress period, their solute effects must be
-! added to the right-hand side of the gwt matrix equations.
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
real(DP), intent(in), dimension(:), contiguous, target :: cnew1
real(DP), intent(in), dimension(:), contiguous, target :: cnew2
! -- local
@@ -251,8 +236,8 @@ subroutine mvt_fc(this, cnew1, cnew2)
real(DP) :: q, cp
real(DP), dimension(:), pointer :: concpak
real(DP), dimension(:), contiguous, pointer :: cnew
- type(GwtFmiType), pointer :: fmi_pr !< pointer to provider model fmi package
- type(GwtFmiType), pointer :: fmi_rc !< pointer to receiver model fmi package
+ type(TspFmiType), pointer :: fmi_pr !< pointer to provider model fmi package
+ type(TspFmiType), pointer :: fmi_rc !< pointer to receiver model fmi package
! ------------------------------------------------------------------------------
!
! -- Add mover QC terms to the receiver packages
@@ -313,7 +298,7 @@ subroutine mvt_fc(this, cnew1, cnew2)
! water into the same receiver
if (fmi_rc%iatp(irc) /= 0) then
fmi_rc%datp(irc)%qmfrommvr(id2) = fmi_rc%datp(irc)%qmfrommvr(id2) - &
- q * cp
+ q * cp * this%eqnsclfac
end if
end do
end if
@@ -325,20 +310,19 @@ end subroutine mvt_fc
!> @ brief Set the fmi_pr and fmi_rc pointers
!!
- !! The fmi_pr and fmi_rc arguments are pointers to the provider
- !! and receiver FMI Packages. If this MVT Package is owned by
- !! a single GWT model, then these pointers are both set to the
- !! FMI Package of this GWT model's FMI Package. If this MVT
- !! Package is owned by a GWTGWT Exchange, then the fmi_pr and
- !! fmi_rc pointers may be assigned to FMI Packages in different models.
- !!
+ !! The fmi_pr and fmi_rc arguments are pointers to the provider and receiver
+ !! FMI Packages. If this MVT Package is owned by a single GWT model, then
+ !! these pointers are both set to the FMI Package of this GWT model's FMI
+ !! package. If this MVT package is owned by a GWTGWT exchange, then the
+ !! fmi_pr and fmi_rc pointers may be assigned to FMI Packages in different
+ !! models.
!<
subroutine set_fmi_pr_rc(this, ibudterm, fmi_pr, fmi_rc)
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
integer(I4B), intent(in) :: ibudterm
- type(GwtFmiType), pointer :: fmi_pr
- type(GwtFmiType), pointer :: fmi_rc
+ type(TspFmiType), pointer :: fmi_pr
+ type(TspFmiType), pointer :: fmi_rc
fmi_pr => null()
fmi_rc => null()
@@ -389,19 +373,16 @@ subroutine set_fmi_pr_rc(this, ibudterm, fmi_pr, fmi_rc)
print *, 'Could not find FMI Package...'
stop "error in set_fmi_pr_rc"
end if
-
+ !
+ ! -- Return
return
end subroutine set_fmi_pr_rc
+ !> @brief Extra convergence check for mover
+ !<
subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak)
-! ******************************************************************************
-! mvt_cc -- extra convergence check for mover
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
integer(I4B), intent(in) :: kiter
integer(I4B), intent(in) :: iend
integer(I4B), intent(in) :: icnvgmod
@@ -423,20 +404,16 @@ subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak)
end if
end if
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_cc
+ !> @brief Write mover terms to listing file
+ !<
subroutine mvt_bd(this, cnew1, cnew2)
-! ******************************************************************************
-! mvt_bd -- Write mover terms to listing file
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
real(DP), dimension(:), contiguous, intent(in) :: cnew1
real(DP), dimension(:), contiguous, intent(in) :: cnew2
! -- local
@@ -445,21 +422,17 @@ subroutine mvt_bd(this, cnew1, cnew2)
! -- fill the budget object
call this%mvt_fill_budobj(cnew1, cnew2)
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_bd
+ !> @brief Write mover budget terms
+ !<
subroutine mvt_ot_saveflow(this, icbcfl, ibudfl)
-! ******************************************************************************
-! mvt_bd -- Write mover terms
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: kstp, kper, delt, pertim, totim
! -- dummy
- class(GwtMvttype) :: this
+ class(TspMvttype) :: this
integer(I4B), intent(in) :: icbcfl
integer(I4B), intent(in) :: ibudfl
! -- locals
@@ -481,16 +454,12 @@ subroutine mvt_ot_saveflow(this, icbcfl, ibudfl)
return
end subroutine mvt_ot_saveflow
+ !> @brief Print mover flow table
+ !<
subroutine mvt_ot_printflow(this, icbcfl, ibudfl)
-! ******************************************************************************
-! mvr_ot_printflow -- Print mover flow table
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
integer(I4B), intent(in) :: icbcfl
integer(I4B), intent(in) :: ibudfl
! -- locals
@@ -505,18 +474,14 @@ subroutine mvt_ot_printflow(this, icbcfl, ibudfl)
return
end subroutine mvt_ot_printflow
+ !> @brief Write mover budget to listing file
+ !<
subroutine mvt_ot_bdsummary(this, ibudfl)
-! ******************************************************************************
-! mvt_ot_bdsummary -- Write mover budget to listing file
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: kstp, kper, delt, totim
use ArrayHandlersModule, only: ifind, expandarray
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
integer(I4B), intent(in) :: ibudfl
! -- locals
integer(I4B) :: i, j, n
@@ -582,17 +547,15 @@ subroutine mvt_ot_bdsummary(this, ibudfl)
return
end subroutine mvt_ot_bdsummary
+ !> @ brief Deallocate memory
+ !!
+ !! Method to deallocate memory for the package.
+ !<
subroutine mvt_da(this)
-! ******************************************************************************
-! mvt_da -- deallocate
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -634,17 +597,15 @@ subroutine mvt_da(this)
return
end subroutine mvt_da
+ !> @ brief Allocate scalar variables for package
+ !!
+ !! Method to allocate scalar variables for the MVT package.
+ !<
subroutine allocate_scalars(this)
-! ******************************************************************************
-! allocate_scalars
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- local
! ------------------------------------------------------------------------------
!
@@ -665,18 +626,14 @@ subroutine allocate_scalars(this)
return
end subroutine allocate_scalars
+ !> @brief Read mover-for-transport options block
+ !<
subroutine read_options(this)
-! ******************************************************************************
-! read_options -- Read Options
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use OpenSpecModule, only: access, form
use InputOutputModule, only: getunit, openfile
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- local
character(len=LINELENGTH) :: errmsg, keyword
character(len=MAXCHARLEN) :: fname
@@ -747,21 +704,17 @@ subroutine read_options(this)
write (this%iout, '(1x,a)') 'END OF MVT OPTIONS'
end if
!
- ! -- return
+ ! -- Return
return
end subroutine read_options
+ !> @brief Set up the budget object that stores all the mvr flows
+ !<
subroutine mvt_setup_budobj(this)
-! ******************************************************************************
-! mvt_setup_budobj -- Set up the budget object that stores all the mvr flows
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
use ConstantsModule, only: LENBUDTXT
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
! -- local
integer(I4B) :: nbudterm
integer(I4B) :: ncv
@@ -798,27 +751,22 @@ subroutine mvt_setup_budobj(this)
maxlist, .false., .false., &
naux)
end do
-
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_setup_budobj
+ !> @brief Copy mover-for-transport flow terms into this%budobj
+ !<
subroutine mvt_fill_budobj(this, cnew1, cnew2)
-! ******************************************************************************
-! mvt_fill_budobj -- copy flow terms into this%budobj
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- modules
! -- dummy
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
real(DP), intent(in), dimension(:), contiguous, target :: cnew1
real(DP), intent(in), dimension(:), contiguous, target :: cnew2
! -- local
- type(GwtFmiType), pointer :: fmi_pr
- type(GwtFmiType), pointer :: fmi_rc
+ type(TspFmiType), pointer :: fmi_pr
+ type(TspFmiType), pointer :: fmi_rc
real(DP), dimension(:), contiguous, pointer :: cnew
integer(I4B) :: nbudterm
integer(I4B) :: nlist
@@ -864,7 +812,7 @@ subroutine mvt_fill_budobj(this, cnew1, cnew2)
! -- Calculate solute mover rate
rate = DZERO
if (fmi_rc%iatp(irc) /= 0) then
- rate = -q * cp
+ rate = -q * cp * this%eqnsclfac
end if
!
! -- add the rate to the budterm
@@ -875,19 +823,17 @@ subroutine mvt_fill_budobj(this, cnew1, cnew2)
! --Terms are filled, now accumulate them for this time step
call this%budobj%accumulate_terms()
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_fill_budobj
+ !> @brief Determine max number of packages in use
+ !!
+ !! Scan through the gwf water mover budget object and determine the maximum
+ !! number of packages and unique package names
+ !<
subroutine mvt_scan_mvrbudobj(this)
-! ******************************************************************************
-! mvt_scan_mvrbudobj -- scan through the gwf water mover budget object and
-! determine the maximum number of packages and unique package names
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- class(GwtMvtType) :: this
+ class(TspMvtType) :: this
integer(I4B) :: nbudterm
integer(I4B) :: maxpackages
integer(I4B) :: i, j
@@ -931,15 +877,11 @@ subroutine mvt_scan_mvrbudobj(this)
return
end subroutine mvt_scan_mvrbudobj
+ !> @brief Set up the mover-for-transport output table
+ !<
subroutine mvt_setup_outputtab(this)
-! ******************************************************************************
-! mvt_setup_outputtab -- set up output table
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
- class(GwtMvtType), intent(inout) :: this
+ class(TspMvtType), intent(inout) :: this
! -- local
character(len=LINELENGTH) :: title
character(len=LINELENGTH) :: text
@@ -980,21 +922,16 @@ subroutine mvt_setup_outputtab(this)
end if
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_setup_outputtab
+ !> @brief Set up mover-for-transport output table
subroutine mvt_print_outputtab(this)
-! ******************************************************************************
-! mvt_print_outputtab -- set up output table
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- module
use TdisModule, only: kstp, kper
! -- dummy
- class(GwtMvttype), intent(inout) :: this
+ class(TspMvttype), intent(inout) :: this
! -- local
character(len=LINELENGTH) :: title
character(len=LENMODELNAME + LENPACKAGENAME + 1) :: cloc1, cloc2
@@ -1041,9 +978,9 @@ subroutine mvt_print_outputtab(this)
end do
end do
!
- ! -- return
+ ! -- Return
return
end subroutine mvt_print_outputtab
-end module GwtMvtModule
+end module TspMvtModule
diff --git a/src/Model/GroundWaterTransport/gwt1obs1.f90 b/src/Model/TransportModel/tsp1obs1.f90
similarity index 63%
rename from src/Model/GroundWaterTransport/gwt1obs1.f90
rename to src/Model/TransportModel/tsp1obs1.f90
index 48dd58f0e7c..3964e3f5630 100644
--- a/src/Model/GroundWaterTransport/gwt1obs1.f90
+++ b/src/Model/TransportModel/tsp1obs1.f90
@@ -1,9 +1,9 @@
-module GwtObsModule
+module TspObsModule
use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, MAXOBSTYPES
use BaseDisModule, only: DisBaseType
- use GwtIcModule, only: GwtIcType
+ use TspIcModule, only: TspIcType
use ObserveModule, only: ObserveType
use ObsModule, only: ObsType
use SimModule, only: count_errors, store_error, &
@@ -11,38 +11,36 @@ module GwtObsModule
implicit none
private
- public :: GwtObsType, gwt_obs_cr
+ public :: TspObsType, tsp_obs_cr
- type, extends(ObsType) :: GwtObsType
+ type, extends(ObsType) :: TspObsType
! -- Private members
- type(GwtIcType), pointer, private :: ic => null() ! initial conditions
+ type(TspIcType), pointer, private :: ic => null() ! initial conditions
real(DP), dimension(:), pointer, contiguous, private :: x => null() ! concentration
real(DP), dimension(:), pointer, contiguous, private :: flowja => null() ! intercell flows
contains
! -- Public procedures
- procedure, public :: gwt_obs_ar
- procedure, public :: obs_bd => gwt_obs_bd
- procedure, public :: obs_df => gwt_obs_df
- procedure, public :: obs_rp => gwt_obs_rp
- procedure, public :: obs_da => gwt_obs_da
+ procedure, public :: tsp_obs_ar
+ procedure, public :: obs_bd => tsp_obs_bd
+ procedure, public :: obs_df => tsp_obs_df
+ procedure, public :: obs_rp => tsp_obs_rp
+ procedure, public :: obs_da => tsp_obs_da
! -- Private procedures
procedure, private :: set_pointers
- end type GwtObsType
+ end type TspObsType
contains
- subroutine gwt_obs_cr(obs, inobs)
-! ******************************************************************************
-! gwt_obs_cr -- Create a new GwtObsType object
-! Subroutine: (1) creates object
-! (2) allocates pointers
-! (3) initializes values
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Create a new TspObsType object
+ !!
+ !! This routine:
+ !! - creates an observation object
+ !! - allocates pointers
+ !! - initializes values
+ !<
+ subroutine tsp_obs_cr(obs, inobs)
! -- dummy
- type(GwtObsType), pointer, intent(out) :: obs
+ type(TspObsType), pointer, intent(out) :: obs
integer(I4B), pointer, intent(in) :: inobs
! ------------------------------------------------------------------------------
!
@@ -52,19 +50,18 @@ subroutine gwt_obs_cr(obs, inobs)
obs%inputFilename = ''
obs%inUnitObs => inobs
!
+ ! -- Return
return
- end subroutine gwt_obs_cr
+ end subroutine tsp_obs_cr
- subroutine gwt_obs_ar(this, ic, x, flowja)
-! ******************************************************************************
-! gwt_obs_ar -- allocate and read
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Allocate and read method for package
+ !!
+ !! Method to allocate and read static data for the package.
+ !<
+ subroutine tsp_obs_ar(this, ic, x, flowja)
! -- dummy
- class(GwtObsType), intent(inout) :: this
- type(GwtIcType), pointer, intent(in) :: ic
+ class(TspObsType), intent(inout) :: this
+ type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
@@ -75,18 +72,15 @@ subroutine gwt_obs_ar(this, ic, x, flowja)
! set pointers
call this%set_pointers(ic, x, flowja)
!
+ ! -- Return
return
- end subroutine gwt_obs_ar
+ end subroutine tsp_obs_ar
- subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis)
-! ******************************************************************************
-! gwt_obs_df -- define
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Define observation object
+ !<
+ subroutine tsp_obs_df(this, iout, pkgname, filtyp, dis)
! -- dummy
- class(GwtObsType), intent(inout) :: this
+ class(TspObsType), intent(inout) :: this
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: pkgname
character(len=*), intent(in) :: filtyp
@@ -107,20 +101,17 @@ subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis)
!
! -- Store obs type and assign procedure pointer for flow-ja-face observation type
call this%StoreObsType('flow-ja-face', .true., indx)
- this%obsData(indx)%ProcessIdPtr => gwt_process_intercell_obs_id
+ this%obsData(indx)%ProcessIdPtr => tsp_process_intercell_obs_id
!
+ ! -- Return
return
- end subroutine gwt_obs_df
+ end subroutine tsp_obs_df
- subroutine gwt_obs_bd(this)
-! ******************************************************************************
-! gwt_obs_bd -- save obs
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Save observations
+ !<
+ subroutine tsp_obs_bd(this)
! -- dummy
- class(GwtObsType), intent(inout) :: this
+ class(TspObsType), intent(inout) :: this
! -- local
integer(I4B) :: i, jaindex, nodenumber
character(len=100) :: msg
@@ -148,32 +139,27 @@ subroutine gwt_obs_bd(this)
end do
end if
!
+ ! -- Return
return
- end subroutine gwt_obs_bd
+ end subroutine tsp_obs_bd
- subroutine gwt_obs_rp(this)
-! ******************************************************************************
-! gwt_obs_rp
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
- class(GwtObsType), intent(inout) :: this
+ !> @brief If transport model observations need checks, add them here
+ !<
+ subroutine tsp_obs_rp(this)
+ ! -- dummy
+ class(TspObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
- ! Do GWT observations need any checking? If so, add checks here
+ ! -- Return
return
- end subroutine gwt_obs_rp
+ end subroutine tsp_obs_rp
- subroutine gwt_obs_da(this)
-! ******************************************************************************
-! gwt_obs_da
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> Deallocate memory
+ !!
+ !! Deallocate memory associated with transport model
+ subroutine tsp_obs_da(this)
! -- dummy
- class(GwtObsType), intent(inout) :: this
+ class(TspObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
nullify (this%ic)
@@ -181,9 +167,12 @@ subroutine gwt_obs_da(this)
nullify (this%flowja)
call this%ObsType%obs_da()
!
+ ! -- Return
return
- end subroutine gwt_obs_da
+ end subroutine tsp_obs_da
+ !> @brief Set pointers needed by the transport OBS package
+ !<
subroutine set_pointers(this, ic, x, flowja)
! ******************************************************************************
! set_pointers
@@ -192,8 +181,8 @@ subroutine set_pointers(this, ic, x, flowja)
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
- class(GwtObsType), intent(inout) :: this
- type(GwtIcType), pointer, intent(in) :: ic
+ class(TspObsType), intent(inout) :: this
+ type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
@@ -205,15 +194,11 @@ subroutine set_pointers(this, ic, x, flowja)
return
end subroutine set_pointers
- ! -- Procedures related to GWF observations (NOT type-bound)
-
+ !> @brief Procedure related to Tsp observations (NOT type-bound)
+ !!
+ !! Process a specific observation ID
+ !<
subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout)
-! ******************************************************************************
-! gwt_process_concentration_obs_id
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
@@ -242,16 +227,15 @@ subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout)
call store_error_unit(inunitobs)
end if
!
+ ! -- Return
return
end subroutine gwt_process_concentration_obs_id
- subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
-! ******************************************************************************
-! gwt_process_intercell_obs_id
-! ******************************************************************************
-!
-! SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+ !> @brief Procedure related to Tsp observations (NOT type-bound)
+ !!
+ !! Process an intercell observation requested by the user
+ !<
+ subroutine tsp_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
@@ -304,7 +288,8 @@ subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
call store_error_unit(inunitobs)
end if
!
+ ! -- Return
return
- end subroutine gwt_process_intercell_obs_id
+ end subroutine tsp_process_intercell_obs_id
-end module GwtObsModule
+end module TspObsModule
diff --git a/src/Model/GroundWaterTransport/gwt1oc1.f90 b/src/Model/TransportModel/tsp1oc1.f90
similarity index 72%
rename from src/Model/GroundWaterTransport/gwt1oc1.f90
rename to src/Model/TransportModel/tsp1oc1.f90
index d186d713259..49d1ff0b772 100644
--- a/src/Model/GroundWaterTransport/gwt1oc1.f90
+++ b/src/Model/TransportModel/tsp1oc1.f90
@@ -1,4 +1,4 @@
-module GwtOcModule
+module TspOcModule
use BaseDisModule, only: DisBaseType
use KindModule, only: DP, I4B
@@ -8,29 +8,29 @@ module GwtOcModule
implicit none
private
- public GwtOcType, oc_cr
+ public TspOcType, oc_cr
!> @ brief Output control for GWT
!!
!! Concrete implementation of OutputControlType for the
!! GWT Model
!<
- type, extends(OutputControlType) :: GwtOcType
+ type, extends(OutputControlType) :: TspOcType
contains
procedure :: oc_ar
- end type GwtOcType
+ end type TspOcType
contains
- !> @ brief Create GwtOcType
+ !> @ brief Create TspOcType
!!
- !! Create by allocating a new GwtOcType object and initializing
+ !! Create by allocating a new TspOcType object and initializing
!! member variables.
!!
!<
subroutine oc_cr(ocobj, name_model, inunit, iout)
! -- dummy
- type(GwtOcType), pointer :: ocobj !< GwtOcType object
+ type(TspOcType), pointer :: ocobj !< TspOcType object
character(len=*), intent(in) :: name_model !< name of the model
integer(I4B), intent(in) :: inunit !< unit number for input
integer(I4B), intent(in) :: iout !< unit number for output
@@ -52,15 +52,17 @@ subroutine oc_cr(ocobj, name_model, inunit, iout)
return
end subroutine oc_cr
- !> @ brief Allocate and read GwtOcType
+ !> @ brief Allocate and read TspOcType
!!
- !! Setup concentration and budget as output control variables.
+ !! Setup dependent variable (e.g., concentration or temperature)
+ !! and budget as output control variables.
!!
!<
- subroutine oc_ar(this, conc, dis, dnodata)
+ subroutine oc_ar(this, depvar, dis, dnodata, dvname)
! -- dummy
- class(GwtOcType) :: this !< GwtOcType object
- real(DP), dimension(:), pointer, contiguous, intent(in) :: conc !< model concentration
+ class(TspOcType) :: this !< TspOcType object
+ real(DP), dimension(:), pointer, contiguous, intent(in) :: depvar !< model concentration
+ character(len=*), intent(in) :: dvname !< name of dependent variable solved by generalized transport model (concentration, temperature)
class(DisBaseType), pointer, intent(in) :: dis !< model discretization package
real(DP), intent(in) :: dnodata !< no data value
! -- local
@@ -80,7 +82,7 @@ subroutine oc_ar(this, conc, dis, dnodata)
'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', &
this%iout, dnodata)
case (2)
- call ocdobjptr%init_dbl('CONCENTRATION', conc, dis, 'PRINT LAST ', &
+ call ocdobjptr%init_dbl(trim(dvname), depvar, dis, 'PRINT LAST ', &
'COLUMNS 10 WIDTH 11 DIGITS 4 GENERAL ', &
this%iout, dnodata)
end select
@@ -97,4 +99,4 @@ subroutine oc_ar(this, conc, dis, dnodata)
return
end subroutine oc_ar
-end module GwtOcModule
+end module TspOcModule
diff --git a/src/Model/GroundWaterTransport/gwt1ssm1.f90 b/src/Model/TransportModel/tsp1ssm1.f90
similarity index 92%
rename from src/Model/GroundWaterTransport/gwt1ssm1.f90
rename to src/Model/TransportModel/tsp1ssm1.f90
index e8684820918..92ee47adb33 100644
--- a/src/Model/GroundWaterTransport/gwt1ssm1.f90
+++ b/src/Model/TransportModel/tsp1ssm1.f90
@@ -1,27 +1,27 @@
-!> @brief This module contains the GwtSsm Module
+!> @brief This module contains the TspSsm Module
!!
!! This module contains the code for handling sources and sinks
!! associated with groundwater flow model stress packages.
!!
!! todo: need observations for SSM terms
!<
-module GwtSsmModule
+module TspSsmModule
use KindModule, only: DP, I4B, LGP
use ConstantsModule, only: DONE, DZERO, LENAUXNAME, LENFTYPE, &
LENPACKAGENAME, LINELENGTH, &
- TABLEFT, TABCENTER, LENBUDROWLABEL
+ TABLEFT, TABCENTER, LENBUDROWLABEL, LENVARNAME
use SimModule, only: store_error, count_errors, store_error_unit
use SimVariablesModule, only: errmsg
use NumericalPackageModule, only: NumericalPackageType
use BaseDisModule, only: DisBaseType
- use GwtFmiModule, only: GwtFmiType
+ use TspFmiModule, only: TspFmiType
use TableModule, only: TableType, table_cr
use GwtSpcModule, only: GwtSpcType
use MatrixBaseModule
implicit none
- public :: GwtSsmType
+ public :: TspSsmType
public :: ssm_cr
character(len=LENFTYPE) :: ftype = 'SSM'
@@ -32,18 +32,21 @@ module GwtSsmModule
!! This derived type corresponds to the SSM Package, which adds
!! the effects of groundwater sources and sinks to the solute transport
!! equation.
- !!
!<
- type, extends(NumericalPackageType) :: GwtSsmType
+ type, extends(NumericalPackageType) :: TspSsmType
integer(I4B), pointer :: nbound !< total number of flow boundaries in this time step
integer(I4B), dimension(:), pointer, contiguous :: isrctype => null() !< source type 0 is unspecified, 1 is aux, 2 is auxmixed, 3 is ssmi, 4 is ssmimixed
integer(I4B), dimension(:), pointer, contiguous :: iauxpak => null() !< aux col for concentration
integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound
real(DP), dimension(:), pointer, contiguous :: cnew => null() !< pointer to gwt%x
- type(GwtFmiType), pointer :: fmi => null() !< pointer to fmi object
+ real(DP), dimension(:), pointer, contiguous :: cpw => null() !< pointer to gwe%cpw
+ real(DP), dimension(:), pointer, contiguous :: rhow => null() !< pointer to gwe%rhow
+ type(TspFmiType), pointer :: fmi => null() !< pointer to fmi object
type(TableType), pointer :: outputtab => null() !< output table object
type(GwtSpcType), dimension(:), pointer :: ssmivec => null() !< array of stress package concentration objects
+ real(DP), pointer :: eqnsclfac => null() !< governing equation scale factor; =1. for solute; =rhow*cpw for energy
+ character(len=LENVARNAME) :: depvartype = ''
contains
@@ -68,7 +71,7 @@ module GwtSsmModule
procedure, private :: set_ssmivec
procedure, private :: get_ssm_conc
- end type GwtSsmType
+ end type TspSsmType
contains
@@ -76,15 +79,17 @@ module GwtSsmModule
!!
!! Create a new SSM package by defining names, allocating scalars
!! and initializing the parser.
- !!
!<
- subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi)
+ subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi, eqnsclfac, &
+ depvartype)
! -- dummy
- type(GwtSsmType), pointer :: ssmobj !< GwtSsmType object
+ type(TspSsmType), pointer :: ssmobj !< TspSsmType object
character(len=*), intent(in) :: name_model !< name of the model
integer(I4B), intent(in) :: inunit !< fortran unit for input
integer(I4B), intent(in) :: iout !< fortran unit for output
- type(GwtFmiType), intent(in), target :: fmi !< GWT FMI package
+ type(TspFmiType), intent(in), target :: fmi !< Transport FMI package
+ real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
+ character(len=LENVARNAME), intent(in) :: depvartype
!
! -- Create the object
allocate (ssmobj)
@@ -99,10 +104,15 @@ subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi)
ssmobj%inunit = inunit
ssmobj%iout = iout
ssmobj%fmi => fmi
+ ssmobj%eqnsclfac => eqnsclfac
!
! -- Initialize block parser
call ssmobj%parser%Initialize(ssmobj%inunit, ssmobj%iout)
!
+ ! -- Store pointer to labels associated with the current model so that the
+ ! package has access to the corresponding dependent variable type
+ ssmobj%depvartype = depvartype
+ !
! -- Return
return
end subroutine ssm_cr
@@ -112,13 +122,12 @@ end subroutine ssm_cr
!! This routine is called from gwt_df(), but does not do anything because
!! df is typically used to set up dimensions. For the ssm package, the
!! total number of ssm entries is defined by the flow model.
- !!
!<
subroutine ssm_df(this)
! -- modules
use MemoryManagerModule, only: mem_setptr
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
! -- formats
!
@@ -130,13 +139,12 @@ end subroutine ssm_df
!!
!! This routine is called from gwt_ar(). It allocates arrays, reads
!! options and data, and sets up the output table.
- !!
!<
subroutine ssm_ar(this, dis, ibound, cnew)
! -- modules
use MemoryManagerModule, only: mem_setptr
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
class(DisBaseType), pointer, intent(in) :: dis !< discretization package
integer(I4B), dimension(:), pointer, contiguous :: ibound !< GWT model ibound
real(DP), dimension(:), pointer, contiguous :: cnew !< GWT model dependent variable
@@ -188,12 +196,11 @@ end subroutine ssm_ar
!! each stress period. If any SPC input files are used to provide source
!! and sink concentrations, then period blocks for the current stress period
!! are read.
- !!
!<
subroutine ssm_rp(this)
! -- modules
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
integer(I4B) :: ip
type(GwtSpcType), pointer :: ssmiptr
@@ -219,12 +226,11 @@ end subroutine ssm_rp
!! in this%nbound. Also, if any SPC input files are used to provide source
!! and sink concentrations and time series are referenced in those files,
!! then ssm concenrations must be interpolated for the time step.
- !!
!<
subroutine ssm_ad(this)
! -- modules
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
integer(I4B) :: ip
type(GwtSpcType), pointer :: ssmiptr
@@ -267,12 +273,11 @@ end subroutine ssm_ad
!! and right-hand-side value for any package and package entry. It returns
!! several different optional variables that are used throughout this
!! package to update matrix terms, budget calculations, and output tables.
- !!
!<
subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, &
cssm, qssm)
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType
+ class(TspSsmType) :: this !< TspSsmType
integer(I4B), intent(in) :: ipackage !< package number
integer(I4B), intent(in) :: ientry !< bound number
real(DP), intent(out), optional :: rrate !< calculated mass flow rate
@@ -342,9 +347,9 @@ subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, &
!
! -- Add terms based on qbnd sign
if (qbnd <= DZERO) then
- hcoftmp = qbnd * omega
+ hcoftmp = qbnd * omega * this%eqnsclfac
else
- rhstmp = -qbnd * ctmp * (DONE - omega)
+ rhstmp = -qbnd * ctmp * (DONE - omega) * this%eqnsclfac
end if
!
! -- end of active ibound
@@ -357,23 +362,23 @@ subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, &
if (present(cssm)) cssm = ctmp
if (present(qssm)) qssm = qbnd
!
- ! -- return
+ ! -- Return
return
end subroutine ssm_term
- !> @ brief Provide bound concentration and mixed flag
- !!
- !! SSM concentrations can be provided in auxiliary variables or
- !! through separate SPC files. If not provided, the default
- !! concentration is zero. This single routine provides the SSM
- !! bound concentration based on these different approaches.
- !! The mixed flag indicates whether or not
+ !> @ brief Provide bound concentration (or temperature) and mixed flag
!!
+ !! SSM concentrations and temperatures can be provided in auxiliary variables
+ !! or through separate SPC files. If not provided, the default
+ !! concentration (or temperature) is zero. This single routine provides
+ !! the SSM bound concentration (or temperature) based on these different
+ !! approaches. The mixed flag indicates whether or not the boundary as a
+ !! mixed type.
!<
subroutine get_ssm_conc(this, ipackage, ientry, nbound_flow, conc, &
lauxmixed)
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType
+ class(TspSsmType) :: this !< TspSsmType
integer(I4B), intent(in) :: ipackage !< package number
integer(I4B), intent(in) :: ientry !< bound number
integer(I4B), intent(in) :: nbound_flow !< size of flow package bound list
@@ -404,12 +409,11 @@ end subroutine get_ssm_conc
!!
!! This routine adds the effects of the SSM to the matrix equations by
!! updating the a matrix and right-hand side vector.
- !!
!<
subroutine ssm_fc(this, matrix_sln, idxglo, rhs)
! -- modules
! -- dummy
- class(GwtSsmType) :: this
+ class(TspSsmType) :: this
class(MatrixBaseType), pointer :: matrix_sln
integer(I4B), intent(in), dimension(:) :: idxglo
real(DP), intent(inout), dimension(:) :: rhs
@@ -451,12 +455,11 @@ end subroutine ssm_fc
!! Calulate the resulting mass flow between the boundary and the connected
!! GWT model cell. Update the diagonal position of the flowja array so that
!! it ultimately contains the solute balance residual.
- !!
!<
subroutine ssm_cq(this, flowja)
! -- modules
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow across each face in the model grid
! -- local
integer(I4B) :: ip
@@ -491,14 +494,13 @@ end subroutine ssm_cq
!!
!! Calculate the global SSM budget terms using separate in and out entries
!! for each flow package.
- !!
!<
subroutine ssm_bd(this, isuppress_output, model_budget)
! -- modules
use TdisModule, only: delt
use BudgetModule, only: BudgetType
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
integer(I4B), intent(in) :: isuppress_output !< flag to suppress output
type(BudgetType), intent(inout) :: model_budget !< budget object for the GWT model
! -- local
@@ -549,14 +551,13 @@ end subroutine ssm_bd
!! Based on user-specified controls, print SSM mass flow rates to the GWT
!! listing file and/or write the SSM mass flow rates to the GWT binary
!! budget file.
- !!
!<
subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
! -- modules
use TdisModule, only: kstp, kper
use ConstantsModule, only: LENPACKAGENAME, LENBOUNDNAME, LENAUXNAME, DZERO
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
integer(I4B), intent(in) :: icbcfl !< flag for writing binary budget terms
integer(I4B), intent(in) :: ibudfl !< flag for printing budget terms to list file
integer(I4B), intent(in) :: icbcun !< fortran unit number for binary budget file
@@ -672,20 +673,19 @@ subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
end if
end if
!
- ! -- return
+ ! -- Return
return
end subroutine ssm_ot_flow
!> @ brief Deallocate
!!
!! Deallocate the memory associated with this derived type
- !!
!<
subroutine ssm_da(this)
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
integer(I4B) :: ip
type(GwtSpcType), pointer :: ssmiptr
@@ -729,13 +729,12 @@ end subroutine ssm_da
!> @ brief Allocate scalars
!!
!! Allocate scalar variables for this derived type
- !!
!<
subroutine allocate_scalars(this)
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
!
! -- allocate scalars in NumericalPackageType
@@ -754,13 +753,12 @@ end subroutine allocate_scalars
!> @ brief Allocate arrays
!!
!! Allocate array variables for this derived type
- !!
!<
subroutine allocate_arrays(this)
! -- modules
use MemoryManagerModule, only: mem_allocate, mem_setptr
! -- dummy
- class(GwtSsmType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
integer(I4B) :: nflowpack
integer(I4B) :: i
@@ -786,12 +784,11 @@ end subroutine allocate_arrays
!> @ brief Read package options
!!
!! Read and set the SSM Package options
- !!
!<
subroutine read_options(this)
! -- modules
! -- dummy
- class(GwtSSMType) :: this !< GwtSsmType object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
character(len=LINELENGTH) :: keyword
integer(I4B) :: ierr
@@ -838,11 +835,10 @@ end subroutine read_options
!> @ brief Read package data
!!
!! Read and set the SSM Package data
- !!
!<
subroutine read_data(this)
! -- dummy
- class(GwtSsmtype) :: this !< GwtSsmtype object
+ class(TspSsmType) :: this !< TspSsmType object
!
! -- read and process required SOURCES block
call this%read_sources_aux()
@@ -856,11 +852,10 @@ end subroutine read_data
!!
!! Read SOURCES block and look for auxiliary columns in
!! corresponding flow data.
- !!
!<
subroutine read_sources_aux(this)
! -- dummy
- class(GwtSsmtype) :: this !< GwtSsmtype object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
character(len=LINELENGTH) :: keyword
character(len=20) :: srctype
@@ -959,11 +954,10 @@ end subroutine read_sources_aux
!!
!! Read optional FILEINPUT block and initialize an
!! SPC input file reader for each entry.
- !!
!<
subroutine read_sources_fileinput(this)
! -- dummy
- class(GwtSsmtype) :: this !< GwtSsmtype object
+ class(TspSsmType) :: this !< TspSsmType object
! -- local
character(len=LINELENGTH) :: keyword
character(len=LINELENGTH) :: keyword2
@@ -1080,11 +1074,10 @@ end subroutine read_sources_fileinput
!! through the auxiliary names in package ip and sets iauxpak
!! to the column number corresponding to the correct auxiliary
!! column.
- !!
!<
subroutine set_iauxpak(this, ip, packname)
! -- dummy
- class(GwtSsmtype), intent(inout) :: this !< GwtSsmtype
+ class(TspSsmType), intent(inout) :: this !< TspSsmType
integer(I4B), intent(in) :: ip !< package number
character(len=*), intent(in) :: packname !< name of package
! -- local
@@ -1114,7 +1107,7 @@ subroutine set_iauxpak(this, ip, packname)
write (this%iout, '(4x, a, i0, a, a)') 'USING AUX COLUMN ', &
iaux, ' IN PACKAGE ', trim(packname)
!
- ! -- return
+ ! -- Return
return
end subroutine set_iauxpak
@@ -1123,13 +1116,12 @@ end subroutine set_iauxpak
!! The next call to parser will return the input file name for
!! package ip in the SSM SOURCES block. The routine then
!! initializes the SPC input file.
- !!
!<
subroutine set_ssmivec(this, ip, packname)
! -- module
use InputOutputModule, only: openfile, getunit
! -- dummy
- class(GwtSsmtype), intent(inout) :: this !< GwtSsmtype
+ class(TspSsmType), intent(inout) :: this !< TspSsmType
integer(I4B), intent(in) :: ip !< package number
character(len=*), intent(in) :: packname !< name of package
! -- local
@@ -1147,21 +1139,21 @@ subroutine set_ssmivec(this, ip, packname)
call ssmiptr%initialize(this%dis, ip, inunit, this%iout, this%name_model, &
trim(packname))
- write (this%iout, '(4x, a, a, a, a)') 'USING SPC INPUT FILE ', &
- trim(filename), ' TO SET CONCENTRATIONS FOR PACKAGE ', trim(packname)
+ write (this%iout, '(4x, a, a, a, a, a)') 'USING SPC INPUT FILE ', &
+ trim(filename), ' TO SET ', trim(this%depvartype), &
+ 'S FOR PACKAGE ', trim(packname)
!
- ! -- return
+ ! -- Return
return
end subroutine set_ssmivec
!> @ brief Setup the output table
!!
!! Setup the output table by creating the column headers.
- !!
!<
subroutine pak_setup_outputtab(this)
! -- dummy
- class(GwtSsmtype), intent(inout) :: this
+ class(TspSsmType), intent(inout) :: this
! -- local
character(len=LINELENGTH) :: title
character(len=LINELENGTH) :: text
@@ -1199,8 +1191,8 @@ subroutine pak_setup_outputtab(this)
!end if
end if
!
- ! -- return
+ ! -- Return
return
end subroutine pak_setup_outputtab
-end module GwtSsmModule
+end module TspSsmModule
diff --git a/src/Utilities/Budget.f90 b/src/Utilities/Budget.f90
index e3947909e80..d7b63a4b4a6 100644
--- a/src/Utilities/Budget.f90
+++ b/src/Utilities/Budget.f90
@@ -25,7 +25,9 @@ module BudgetModule
DTWO, DHUNDRED
implicit none
+
private
+
public :: BudgetType
public :: budget_cr
public :: rate_accumulator
@@ -56,6 +58,7 @@ module BudgetModule
integer(I4B), pointer :: icsvheader => null()
contains
+
procedure :: budget_df
procedure :: budget_ot
procedure :: budget_da
@@ -70,6 +73,7 @@ module BudgetModule
procedure, private :: allocate_arrays
procedure, private :: resize
procedure, private :: write_csv_header
+
end type BudgetType
contains
@@ -300,11 +304,11 @@ subroutine budget_ot(this, kstp, kper, iout)
, ' TIME STEP', I5, ', STRESS PERIOD', I4 / 2X, 78('-'))
261 FORMAT(//2X, a, ' BUDGET FOR ', a, ' AT END OF' &
, ' TIME STEP', I5, ', STRESS PERIOD', I4 / 2X, 99('-'))
-265 FORMAT(1X, /5X, 'CUMULATIVE ', a, 6X, a, 7X &
- , 'RATES FOR THIS TIME STEP', 6X, a, '/T'/5X, 18('-'), 17X, 24('-') &
+265 FORMAT(1X, /5X, 'CUMULATIVE ', a, 11X, a, 6X &
+ , 'RATES FOR THIS TIME STEP', 8X, a, '/T'/5X, 18('-'), 17X, 24('-') &
//11X, 'IN:', 38X, 'IN:'/11X, '---', 38X, '---')
-266 FORMAT(1X, /5X, 'CUMULATIVE ', a, 6X, a, 7X &
- , 'RATES FOR THIS TIME STEP', 6X, a, '/T', 10X, A16, &
+266 FORMAT(1X, /5X, 'CUMULATIVE ', a, 11X, a, 6X &
+ , 'RATES FOR THIS TIME STEP', 8X, a, '/T', 10X, A16, &
/5X, 18('-'), 17X, 24('-'), 21X, 16('-') &
//11X, 'IN:', 38X, 'IN:'/11X, '---', 38X, '---')
275 FORMAT(1X, 3X, A16, ' =', A17, 6X, A16, ' =', A17)
diff --git a/src/Utilities/BudgetObject.f90 b/src/Utilities/BudgetObject.f90
index 35836bf50b6..d7824340ecb 100644
--- a/src/Utilities/BudgetObject.f90
+++ b/src/Utilities/BudgetObject.f90
@@ -149,7 +149,7 @@ subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, &
!
! -- Set the budget dimension
if (present(bddim_opt)) then
- bddim = bddim_opt
+ bddim = trim(bddim_opt)
else
bddim = 'L**3'
end if
diff --git a/src/Utilities/InputOutput.f90 b/src/Utilities/InputOutput.f90
index f81c44b48eb..beedb19d9ce 100644
--- a/src/Utilities/InputOutput.f90
+++ b/src/Utilities/InputOutput.f90
@@ -17,7 +17,7 @@ module InputOutputModule
UPCASE, URWORD, ULSTLB, UBDSV4, &
ubdsv06, UBDSVB, UCOLNO, ULAPRW, &
ULASAV, ubdsv1, ubdsvc, ubdsvd, UWWORD, &
- same_word, get_node, get_ijk, unitinquire, &
+ same_word, get_node, get_ijk, padl, unitinquire, &
ParseLine, ulaprufw, openfile, &
linear_interpolate, lowcase, &
read_line, &
@@ -1197,6 +1197,22 @@ subroutine get_ijk(nodenumber, nrow, ncol, nlay, irow, icol, ilay)
!
return
end subroutine get_ijk
+
+ !> @brief Function for string manipulation
+ !<
+ function padl(str, width) result(res)
+ ! -- local
+ character(len=*), intent(in) :: str
+ integer, intent(in) :: width
+ ! -- Return
+ character(len=max(len_trim(str), width)) :: res
+! ------------------------------------------------------------------------------
+ res = str
+ res = adjustr(res)
+ !
+ ! -- Return
+ return
+ end function
subroutine get_jk(nodenumber, ncpl, nlay, icpl, ilay)
! Calculate icpl, and ilay from the nodenumber and grid
diff --git a/src/meson.build b/src/meson.build
index e86adab8e17..552acffea9e 100644
--- a/src/meson.build
+++ b/src/meson.build
@@ -90,27 +90,18 @@ modflow_sources = files(
'Model' / 'GroundWaterFlow' / 'gwf3wel8.f90',
'Model' / 'GroundWaterFlow' / 'gwf3wel8idm.f90',
'Model' / 'GroundWaterTransport' / 'gwt1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1adv1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1apt1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1cnc1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1dis1idm.f90',
'Model' / 'GroundWaterTransport' / 'gwt1disu1idm.f90',
'Model' / 'GroundWaterTransport' / 'gwt1disv1idm.f90',
'Model' / 'GroundWaterTransport' / 'gwt1dsp1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1dsp1idm.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1fmi1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1ic1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1idm.f90',
'Model' / 'GroundWaterTransport' / 'gwt1ist1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1lkt1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1mst1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1mvt1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1mwt1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1obs1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1oc1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1sft1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1src1.f90',
- 'Model' / 'GroundWaterTransport' / 'gwt1ssm1.f90',
'Model' / 'GroundWaterTransport' / 'gwt1uzt1.f90',
'Model' / 'ModelUtilities' / 'BoundaryPackage.f90',
'Model' / 'ModelUtilities' / 'BoundaryPackageExt.f90',
@@ -123,17 +114,26 @@ modflow_sources = files(
'Model' / 'ModelUtilities' / 'GwfNpfOptions.f90',
'Model' / 'ModelUtilities' / 'GwfStorageUtils.f90',
'Model' / 'ModelUtilities' / 'GwfVscInputData.f90',
- 'Model' / 'ModelUtilities' / 'GwtAdvOptions.f90',
'Model' / 'ModelUtilities' / 'GwtDspOptions.f90',
'Model' / 'ModelUtilities' / 'GwtSpc.f90',
'Model' / 'ModelUtilities' / 'Mover.f90',
'Model' / 'ModelUtilities' / 'PackageMover.f90',
'Model' / 'ModelUtilities' / 'SfrCrossSectionManager.f90',
'Model' / 'ModelUtilities' / 'SfrCrossSectionUtils.f90',
+ 'Model' / 'ModelUtilities' / 'TspAdvOptions.f90',
'Model' / 'ModelUtilities' / 'UzfCellGroup.f90',
'Model' / 'ModelUtilities' / 'Xt3dAlgorithm.f90',
'Model' / 'ModelUtilities' / 'Xt3dInterface.f90',
'Model' / 'TransportModel' / 'tsp1.f90',
+ 'Model' / 'TransportModel' / 'tsp1adv1.f90',
+ 'Model' / 'TransportModel' / 'tsp1apt1.f90',
+ 'Model' / 'TransportModel' / 'tsp1cnc1.f90',
+ 'Model' / 'TransportModel' / 'tsp1fmi1.f90',
+ 'Model' / 'TransportModel' / 'tsp1ic1.f90',
+ 'Model' / 'TransportModel' / 'tsp1mvt1.f90',
+ 'Model' / 'TransportModel' / 'tsp1obs1.f90',
+ 'Model' / 'TransportModel' / 'tsp1oc1.f90',
+ 'Model' / 'TransportModel' / 'tsp1ssm1.f90',
'Model' / 'BaseModel.f90',
'Model' / 'ExplicitModel.f90',
'Model' / 'NumericalModel.f90',