From 3efca8c306758cbdb25685384b3dec8a595d640a Mon Sep 17 00:00:00 2001 From: Eric Morway Date: Mon, 6 Nov 2023 10:17:26 -0800 Subject: [PATCH] advanced packages need eqnsclfac parameter, updated docstrings in advanced transport packages --- src/Model/GroundWaterTransport/gwt1.f90 | 8 +- src/Model/GroundWaterTransport/gwt1lkt1.f90 | 261 ++++++++------------ src/Model/GroundWaterTransport/gwt1mwt1.f90 | 227 ++++++----------- src/Model/GroundWaterTransport/gwt1sft1.f90 | 236 +++++++----------- src/Model/GroundWaterTransport/gwt1uzt1.f90 | 250 ++++++++----------- src/Model/TransportModel/tsp1apt1.f90 | 2 - 6 files changed, 362 insertions(+), 622 deletions(-) diff --git a/src/Model/GroundWaterTransport/gwt1.f90 b/src/Model/GroundWaterTransport/gwt1.f90 index d8bbc3ff975..04d7ae8e017 100644 --- a/src/Model/GroundWaterTransport/gwt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1.f90 @@ -793,16 +793,16 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname) case ('LKT6') call lkt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac) case ('SFT6') call sft_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac) case ('MWT6') call mwt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac) case ('UZT6') call uzt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, this%fmi) + pakname, this%fmi, this%eqnsclfac) case ('IST6') call ist_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, this%fmi, this%mst) diff --git a/src/Model/GroundWaterTransport/gwt1lkt1.f90 b/src/Model/GroundWaterTransport/gwt1lkt1.f90 index 4762a492b71..727afdc6551 100644 --- a/src/Model/GroundWaterTransport/gwt1lkt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1lkt1.f90 @@ -92,14 +92,10 @@ 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) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -109,9 +105,9 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor ! -- local type(GwtLktType), pointer :: lktobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (lktobj) @@ -139,17 +135,16 @@ subroutine lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! the flow packages lktobj%fmi => fmi ! - ! -- return + ! -- 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 @@ -160,7 +155,6 @@ subroutine find_lkt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -270,14 +264,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 TspAptType%apt_fc_expanded() -! in order to add matrix terms specifically for LKT -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this @@ -292,7 +284,6 @@ subroutine lkt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -364,20 +355,15 @@ 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 integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -431,21 +417,17 @@ 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 ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 6 nbudterms = 6 @@ -454,13 +436,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 @@ -469,9 +447,8 @@ subroutine lkt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux 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 +461,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 +475,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 +488,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 +501,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 +514,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,17 +528,13 @@ subroutine lkt_setup_budobj(this, idx) maxlist, .false., .false., & naux) ! - ! -- return + ! -- Return return end subroutine lkt_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! lkt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtLktType) :: this @@ -572,8 +547,7 @@ subroutine lkt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RAIN idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist @@ -583,7 +557,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 +567,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 +577,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 +587,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 +597,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,25 +607,20 @@ 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 class(GwtLktType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in TspAptType call this%TspAptType%allocate_scalars() @@ -676,20 +645,16 @@ 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 class(GwtLktType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrain, this%ncv, 'CONCRAIN', this%memoryPath) @@ -713,19 +678,14 @@ 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 class(GwtLktType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrain) @@ -748,14 +708,10 @@ subroutine lkt_da(this) 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 @@ -767,7 +723,7 @@ subroutine lkt_rain_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry) @@ -776,18 +732,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 @@ -800,7 +752,7 @@ subroutine lkt_evap_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry) ! -- note that qbnd is negative for evap @@ -817,18 +769,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 @@ -840,7 +788,7 @@ subroutine lkt_roff_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry) @@ -849,18 +797,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 @@ -872,7 +819,7 @@ subroutine lkt_iflw_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry) @@ -881,18 +828,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 @@ -904,7 +850,7 @@ subroutine lkt_wdrl_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudwdrl)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudwdrl)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudwdrl)%flow(ientry) @@ -913,18 +859,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 @@ -936,7 +881,7 @@ subroutine lkt_outf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry) @@ -945,25 +890,21 @@ 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 ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -1030,13 +971,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 +1007,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 @@ -1084,7 +1022,6 @@ subroutine lkt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -1116,16 +1053,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 @@ -1138,7 +1072,6 @@ subroutine lkt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RAINFALL ! EVAPORATION @@ -1200,7 +1133,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/gwt1mwt1.f90 b/src/Model/GroundWaterTransport/gwt1mwt1.f90 index 65de383d194..4d787d8137e 100644 --- a/src/Model/GroundWaterTransport/gwt1mwt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1mwt1.f90 @@ -85,14 +85,10 @@ 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) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -102,9 +98,9 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor ! -- local type(GwtMwtType), pointer :: mwtobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (mwtobj) @@ -132,17 +128,16 @@ subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! the flow packages mwtobj%fmi => fmi ! - ! -- return + ! -- 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 @@ -153,7 +148,6 @@ subroutine find_mwt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -257,14 +251,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 TspAptType%apt_fc_expanded() -! in order to add matrix terms specifically for this package -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this @@ -279,7 +271,6 @@ subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add puping rate contribution if (this%idxbudrate /= 0) then @@ -329,21 +320,16 @@ 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 integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add well pumping contribution if (this%idxbudrate /= 0) then @@ -381,21 +367,17 @@ 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 - ! -- return + ! -- Return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 4 nbudterms = 1 @@ -407,14 +389,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 @@ -423,7 +400,6 @@ subroutine mwt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! ! -- text = ' RATE' @@ -437,7 +413,6 @@ subroutine mwt_setup_budobj(this, idx) this%packName, & maxlist, .false., .false., & naux) - ! ! -- if (this%idxbudfwrt /= 0) then @@ -453,7 +428,6 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! ! -- if (this%idxbudrtmv /= 0) then @@ -469,7 +443,6 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! ! -- if (this%idxbudfrtm /= 0) then @@ -485,19 +458,14 @@ subroutine mwt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- return + ! -- Return return end subroutine mwt_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! mwt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtMwtType) :: this @@ -510,8 +478,7 @@ subroutine mwt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RATE idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist @@ -521,7 +488,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 +500,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 +512,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,25 +524,20 @@ 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 class(GwtMwtType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in TspAptType call this%TspAptType%allocate_scalars() @@ -596,20 +558,16 @@ 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 class(GwtMwtType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrate, this%ncv, 'CONCRATE', this%memoryPath) @@ -627,19 +585,14 @@ 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 class(GwtMwtType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrate) @@ -657,14 +610,10 @@ subroutine mwt_da(this) 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 @@ -677,7 +626,7 @@ subroutine mwt_rate_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: h, r -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry) ! -- note that qbnd is negative for extracting well @@ -695,18 +644,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 @@ -718,7 +664,7 @@ subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry) @@ -727,18 +673,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 @@ -750,7 +695,7 @@ subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry) @@ -759,18 +704,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 @@ -782,7 +726,7 @@ subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry) @@ -791,25 +735,21 @@ 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 ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -864,13 +804,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 +833,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 @@ -911,7 +848,6 @@ subroutine mwt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -935,16 +871,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 @@ -957,7 +891,6 @@ subroutine mwt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RATE ! @@ -982,7 +915,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 65cb99ffeec..66639d12a7c 100644 --- a/src/Model/GroundWaterTransport/gwt1sft1.f90 +++ b/src/Model/GroundWaterTransport/gwt1sft1.f90 @@ -89,14 +89,10 @@ 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) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -106,9 +102,9 @@ subroutine sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor ! -- local type(GwtSftType), pointer :: sftobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (sftobj) @@ -123,30 +119,29 @@ 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 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 sftobj%fmi => fmi ! - ! -- return + ! -- Store pointer to governing equation scale factor + sftobj%eqnsclfac => eqnsclfac + ! + ! -- 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 @@ -157,7 +152,6 @@ subroutine find_sft_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -264,14 +258,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 TspAptType%apt_fc_expanded() -! in order to add matrix terms specifically for SFT -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this @@ -286,7 +278,6 @@ subroutine sft_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -347,20 +338,15 @@ 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 integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add rainfall contribution if (this%idxbudrain /= 0) then @@ -406,36 +392,28 @@ 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 ! -- return integer(I4B) :: 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 @@ -444,7 +422,6 @@ subroutine sft_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! ! -- text = ' RAINFALL' @@ -515,13 +492,9 @@ subroutine sft_setup_budobj(this, idx) return end subroutine sft_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! sft_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtSftType) :: this @@ -534,8 +507,7 @@ subroutine sft_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- RAIN idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist @@ -545,7 +517,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 +527,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 +537,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 +547,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,25 +557,20 @@ 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 class(GwtSftType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in TspAptType call this%TspAptType%allocate_scalars() @@ -626,20 +593,16 @@ 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 class(GwtSftType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concrain, this%ncv, 'CONCRAIN', this%memoryPath) @@ -658,24 +621,18 @@ 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 class(GwtSftType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudrain) @@ -697,14 +654,10 @@ subroutine sft_da(this) 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 @@ -716,7 +669,7 @@ subroutine sft_rain_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry) @@ -725,18 +678,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 @@ -749,7 +698,7 @@ subroutine sft_evap_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry) ! -- note that qbnd is negative for evap @@ -766,18 +715,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 @@ -789,7 +734,7 @@ subroutine sft_roff_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry) @@ -798,18 +743,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 @@ -821,7 +766,7 @@ subroutine sft_iflw_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry) @@ -830,18 +775,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 @@ -853,7 +797,7 @@ subroutine sft_outf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry) @@ -862,25 +806,21 @@ 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 ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -942,13 +882,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 +915,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 @@ -993,7 +930,6 @@ subroutine sft_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -1021,16 +957,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 @@ -1043,7 +976,6 @@ subroutine sft_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! RAINFALL ! EVAPORATION @@ -1105,7 +1037,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/gwt1uzt1.f90 b/src/Model/GroundWaterTransport/gwt1uzt1.f90 index 593eececbb1..2f0bf250a1e 100644 --- a/src/Model/GroundWaterTransport/gwt1uzt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1uzt1.f90 @@ -77,14 +77,10 @@ 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) ! -- dummy class(BndType), pointer :: packobj integer(I4B), intent(in) :: id @@ -94,9 +90,9 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: namemodel character(len=*), intent(in) :: pakname type(TspFmiType), pointer :: fmi + real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor ! -- local type(GwtUztType), pointer :: uztobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (uztobj) @@ -111,30 +107,29 @@ subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & ! ! -- initialize package call packobj%pack_initialize() - + ! packobj%inunit = inunit packobj%iout = iout packobj%id = id 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 uztobj%fmi => fmi ! - ! -- return + ! -- 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 @@ -145,7 +140,6 @@ subroutine find_uzt_package(this) integer(I4B) :: ip, icount integer(I4B) :: nbudterm logical :: found -! ------------------------------------------------------------------------------ ! ! -- Initialize found to false, and error later if flow package cannot ! be found @@ -249,14 +243,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 TspAptType%apt_fc_expanded() -! in order to add matrix terms specifically for this package -! **************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this @@ -271,7 +263,6 @@ subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln) real(DP) :: rrate real(DP) :: rhsval real(DP) :: hcofval -! ------------------------------------------------------------------------------ ! ! -- add infiltration contribution if (this%idxbudinfl /= 0) then @@ -321,21 +312,17 @@ 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 integer(I4B) :: j integer(I4B) :: n1, n2 real(DP) :: rrate -! ------------------------------------------------------------------------------ ! ! -- add infiltration contribution if (this%idxbudinfl /= 0) then @@ -373,21 +360,17 @@ 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 ! -- return integer(I4B) :: nbudterms ! -- local -! ------------------------------------------------------------------------------ ! ! -- Number of budget terms is 4 nbudterms = 0 @@ -400,14 +383,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 @@ -416,9 +394,8 @@ subroutine uzt_setup_budobj(this, idx) ! -- local integer(I4B) :: maxlist, naux character(len=LENBUDTXT) :: text -! ------------------------------------------------------------------------------ ! - ! -- + ! -- Infiltration flux text = ' INFILTRATION' idx = idx + 1 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist @@ -430,9 +407,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 +422,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 +437,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,19 +452,13 @@ subroutine uzt_setup_budobj(this, idx) maxlist, .false., .false., & naux) end if - ! - ! -- return + ! -- Return return end subroutine uzt_setup_budobj + !> @brief Copy flow terms into this%budobj subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) -! ****************************************************************************** -! uzt_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(GwtUztType) :: this @@ -503,8 +471,7 @@ subroutine uzt_fill_budobj(this, idx, x, ccratin, ccratout) integer(I4B) :: nlist real(DP) :: q ! -- formats -! ----------------------------------------------------------------------------- - + ! ! -- INFILTRATION idx = idx + 1 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist @@ -514,7 +481,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 +493,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 +505,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,25 +517,21 @@ 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 class(GwtUztType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- allocate scalars in TspAptType call this%TspAptType%allocate_scalars() @@ -589,20 +552,17 @@ 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 class(GwtUztType), intent(inout) :: this ! -- local integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- time series call mem_allocate(this%concinfl, this%ncv, 'CONCINFL', this%memoryPath) @@ -617,24 +577,20 @@ subroutine uzt_allocate_arrays(this) this%concuzet(n) = DZERO end do ! - ! ! -- Return 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 class(GwtUztType) :: this ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate scalars call mem_deallocate(this%idxbudinfl) @@ -653,14 +609,13 @@ subroutine uzt_da(this) 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 @@ -673,7 +628,7 @@ subroutine uzt_infl_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: h, r -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry) ! -- note that qbnd is negative for negative infiltration @@ -691,18 +646,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 @@ -714,7 +670,7 @@ subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry) @@ -723,18 +679,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 @@ -747,7 +702,7 @@ subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, & real(DP) :: qbnd real(DP) :: ctmp real(DP) :: omega -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry) ! -- note that qbnd is negative for uzet @@ -764,18 +719,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 @@ -787,7 +743,7 @@ subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, & ! -- local real(DP) :: qbnd real(DP) :: ctmp -! ------------------------------------------------------------------------------ + ! n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry) n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry) qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry) @@ -796,25 +752,22 @@ 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 ! -- local integer(I4B) :: indx -! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! for concentration observation type. @@ -870,13 +823,13 @@ 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 +855,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 @@ -917,7 +866,6 @@ subroutine uzt_bd_obs(this, obstypeid, jj, v, found) logical, intent(inout) :: found ! -- local integer(I4B) :: n1, n2 -! ------------------------------------------------------------------------------ ! found = .true. select case (obstypeid) @@ -941,16 +889,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 @@ -963,7 +908,6 @@ subroutine uzt_set_stressperiod(this, itemno, keyword, found) integer(I4B) :: jj real(DP), pointer :: bndElem => null() ! -- formats -! ------------------------------------------------------------------------------ ! ! INFILTRATION ! UZET @@ -1000,7 +944,7 @@ subroutine uzt_set_stressperiod(this, itemno, keyword, found) ! 999 continue ! - ! -- return + ! -- Return return end subroutine uzt_set_stressperiod diff --git a/src/Model/TransportModel/tsp1apt1.f90 b/src/Model/TransportModel/tsp1apt1.f90 index 120daac7715..c16fc40f9cc 100644 --- a/src/Model/TransportModel/tsp1apt1.f90 +++ b/src/Model/TransportModel/tsp1apt1.f90 @@ -1275,8 +1275,6 @@ 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