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',