diff --git a/src/Model/GroundWaterFlow/gwf3uzf8.f90 b/src/Model/GroundWaterFlow/gwf3uzf8.f90 index a688c277208..5a89041cb39 100644 --- a/src/Model/GroundWaterFlow/gwf3uzf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3uzf8.f90 @@ -169,15 +169,9 @@ module UzfModule contains + !> @brief Create a New UZF Package and point packobj to the new package + !< subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) -! ****************************************************************************** -! uzf_create -- Create a New UZF Package -! Subroutine: (1) create new-style package -! (2) point packobj to the new package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -190,7 +184,6 @@ subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) character(len=*), intent(in) :: pakname ! -- local type(UzfType), pointer :: uzfobj -! ------------------------------------------------------------------------------ ! ! -- allocate the object and assign values to object variables allocate (uzfobj) @@ -215,17 +208,13 @@ subroutine uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname) packobj%isadvpak = 1 packobj%ictMemPath = create_mem_path(namemodel, 'NPF') ! - ! -- return + ! -- Return return end subroutine uzf_create + !> @brief Allocate and Read + !< subroutine uzf_ar(this) -! ****************************************************************************** -! uzf_ar -- Allocate and Read -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_reallocate ! -- dummy @@ -233,7 +222,6 @@ subroutine uzf_ar(this) ! -- local integer(I4B) :: n, i real(DP) :: hgwf -! ------------------------------------------------------------------------------ ! call this%obs%obs_ar() ! @@ -269,24 +257,18 @@ subroutine uzf_ar(this) call this%pakmvrobj%ar(this%maxbound, this%maxbound, this%memoryPath) end if ! - ! -- return + ! -- Return return end subroutine uzf_ar + !> @brief Allocate arrays used for uzf + !< subroutine uzf_allocate_arrays(this) -! ****************************************************************************** -! allocate_arrays -- allocate arrays used for uzf -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfType), intent(inout) :: this ! -- local integer(I4B) :: i integer(I4B) :: j -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars (now done from AR) !call this%BndType%allocate_arrays() @@ -309,11 +291,11 @@ subroutine uzf_allocate_arrays(this) call mem_allocate(this%rch0, this%nodes, 'RCH0', this%memoryPath) call mem_allocate(this%qsto, this%nodes, 'QSTO', this%memoryPath) call mem_allocate(this%deriv, this%nodes, 'DERIV', this%memoryPath) - + ! ! -- integer vectors call mem_allocate(this%ia, this%dis%nodes + 1, 'IA', this%memoryPath) call mem_allocate(this%ja, this%nodes, 'JA', this%memoryPath) - + ! ! -- allocate timeseries aware variables call mem_allocate(this%sinf, this%nodes, 'SINF', this%memoryPath) call mem_allocate(this%pet, this%nodes, 'PET', this%memoryPath) @@ -324,7 +306,7 @@ subroutine uzf_allocate_arrays(this) call mem_allocate(this%rootact, this%nodes, 'ROOTACT', this%memoryPath) call mem_allocate(this%uauxvar, this%naux, this%nodes, 'UAUXVAR', & this%memoryPath) - + ! ! -- initialize do i = 1, this%nodes this%appliedinf(i) = DZERO @@ -388,20 +370,16 @@ subroutine uzf_allocate_arrays(this) this%qauxcbc(i) = DZERO end do ! - ! -- return + ! -- Return return end subroutine uzf_allocate_arrays -! + !> @brief Set options specific to UzfType + !! + !! Overrides BoundaryPackageType%child_class_options + !< subroutine uzf_options(this, option, found) -! ****************************************************************************** -! uzf_options -- set options specific to UzfType -! -! uzf_options overrides BoundaryPackageType%child_class_options -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use ConstantsModule, only: DZERO, MNORMAL use OpenSpecModule, only: access, form use SimModule, only: store_error @@ -436,8 +414,6 @@ subroutine uzf_options(this, option, found) &a, /4x, 'OPENED ON UNIT: ', I0)" character(len=*), parameter :: fmtuzfopt = & &"(4x, 'UZF ', a, ' VALUE (',g15.7,') SPECIFIED.')" - -! ------------------------------------------------------------------------------ ! ! found = .true. @@ -541,26 +517,20 @@ subroutine uzf_options(this, option, found) ! -- No options found found = .false. end select - ! -- return + ! -- Return return end subroutine uzf_options ! + !> @brief Set dimensions specific to UzfType + !< subroutine uzf_readdimensions(this) -! ****************************************************************************** -! uzf_readdimensions -- set dimensions specific to UzfType -! -! uzf_readdimensions BoundaryPackageType%readdimensions -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors class(uzftype), intent(inout) :: this character(len=LINELENGTH) :: keyword integer(I4B) :: ierr logical :: isfound, endOfBlock -! ------------------------------------------------------------------------------ ! ! -- initialize dimensions to -1 this%nodes = -1 @@ -659,20 +629,17 @@ subroutine uzf_readdimensions(this) ! -- setup the budget object call this%uzf_setup_budobj() ! - ! -- return + ! -- Return return end subroutine uzf_readdimensions + !> @brief Read stress data + !! + !! - check if bc changes + !! - read new bc for stress period + !! - set kinematic variables to bc values + !< subroutine uzf_rp(this) -! ****************************************************************************** -! uzf_rp -- Read stress data -! Subroutine: (1) check if bc changes -! (2) read new bc for stress period -! (3) set kinematic variables to bc values -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: kper, nper use TimeSeriesManagerModule, only: read_value_or_time_series_adv @@ -708,7 +675,6 @@ subroutine uzf_rp(this) &WHENEVER ICBCFL IS NOT ZERO.')" character(len=*), parameter :: fmtflow = & &"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)" -! ------------------------------------------------------------------------------ ! ! -- Set ionper to the stress period number for which a new block of data ! will be read. @@ -958,17 +924,13 @@ subroutine uzf_rp(this) ! -- Save old ss flag this%issflagold = this%issflag ! - ! -- return + ! -- Return return end subroutine uzf_rp + !> @brief Advance UZF Package + !< subroutine uzf_ad(this) -! ****************************************************************************** -! uzf_ad -- Advance UZF Package -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use SimVariablesModule, only: iFailedStepRetry ! -- dummy @@ -978,7 +940,6 @@ subroutine uzf_ad(this) integer(I4B) :: ivertflag integer(I4B) :: n, iaux real(DP) :: rval1, rval2, rval3 -! ------------------------------------------------------------------------------ ! ! -- Advance the time series call this%TsManager%ad() @@ -1069,21 +1030,17 @@ subroutine uzf_ad(this) return end subroutine uzf_ad + !> @brief Formulate the HCOF and RHS terms + !! + !! - skip if no UZF cells + !! - calculate hcof and rhs + !< subroutine uzf_cf(this) -! ****************************************************************************** -! uzf_cf -- Formulate the HCOF and RHS terms -! Subroutine: (1) skip if no UZF cells -! (2) calculate hcof and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules ! -- dummy class(UzfType) :: this ! -- locals integer(I4B) :: n -! ------------------------------------------------------------------------------ ! ! -- Return if no UZF cells if (this%nodes == 0) return @@ -1096,17 +1053,13 @@ subroutine uzf_cf(this) this%gwd0(n) = this%gwd(n) end do ! - ! -- return + ! -- Return return end subroutine uzf_cf + !> @brief Copy rhs and hcof into solution rhs and amat + !< subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) -! ****************************************************************************** -! uzf_fc -- Copy rhs and hcof into solution rhs and amat -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -1115,7 +1068,6 @@ subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, n, ipos -! ------------------------------------------------------------------------------ ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -1134,17 +1086,13 @@ subroutine uzf_fc(this, rhs, ia, idxglo, matrix_sln) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) end do ! - ! -- return + ! -- Return return end subroutine uzf_fc -! + + !> @brief Fill newton terms + !< subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) -! ************************************************************************** -! uzf_fn -- Fill newton terms -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- dummy class(UzfType) :: this real(DP), dimension(:), intent(inout) :: rhs @@ -1154,7 +1102,6 @@ subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) ! -- local integer(I4B) :: i, n integer(I4B) :: ipos -! -------------------------------------------------------------------------- ! ! -- Add derivative terms to rhs and amat do i = 1, this%nodes @@ -1164,17 +1111,14 @@ subroutine uzf_fn(this, rhs, ia, idxglo, matrix_sln) rhs(n) = rhs(n) + this%deriv(i) * this%xnew(n) end do ! - ! -- return + ! -- Return return end subroutine uzf_fn + !> @brief Final convergence check for package + !< subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) -! ************************************************************************** -! uzf_cc -- Final convergence check for package -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- + ! -- modules use TdisModule, only: totim, kstp, kper, delt ! -- dummy class(Uzftype), intent(inout) :: this @@ -1208,8 +1152,6 @@ subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) real(DP) :: dseepmax real(DP) :: dqfrommvr real(DP) :: dqfrommvrmax - ! format -! -------------------------------------------------------------------------- ! ! -- initialize local variables icheck = this%iconvchk @@ -1400,17 +1342,13 @@ subroutine uzf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak) end if end if ! - ! -- return + ! -- Return return end subroutine uzf_cc + !> @brief Calculate flows + !< subroutine uzf_cq(this, x, flowja, iadv) -! ************************************************************************** -! uzf_cq -- Calculate flows -! ************************************************************************** -! -! SPECIFICATIONS: -! -------------------------------------------------------------------------- ! -- modules use TdisModule, only: delt use ConstantsModule, only: LENBOUNDNAME, DZERO, DHNOFLO, DHDRY @@ -1431,7 +1369,6 @@ subroutine uzf_cq(this, x, flowja, iadv) ! -- formats character(len=*), parameter :: fmttkk = & &"(1X,/1X,A,' PERIOD ',I0,' STEP ',I0)" -! ------------------------------------------------------------------------------ ! ! -- Make uzf solution for budget calculations, and then reset waves. ! Final uzf solve will be done as part of ot(). @@ -1509,12 +1446,13 @@ subroutine uzf_cq(this, x, flowja, iadv) ! -- fill the budget object call this%uzf_fill_budobj() ! - ! -- return + ! -- Return return end subroutine uzf_cq function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & thtr, delt, iss) result(qsto) + ! -- dummy real(DP), intent(in) :: top real(DP), intent(in) :: bot real(DP), intent(in) :: hold @@ -1525,7 +1463,9 @@ function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & real(DP), intent(in) :: carea real(DP), intent(in) :: delt integer(I4B) :: iss + ! -- return real(DP) :: qsto + ! -- local real(DP) :: thknew real(DP) :: thkold if (iss == 0) then @@ -1542,9 +1482,13 @@ function get_storage_change(top, bot, carea, hold, hnew, wcold, wcnew, & else qsto = DZERO end if + ! + ! -- Return return end function get_storage_change + !> @brief Add package ratin/ratout to model budget + !< subroutine uzf_bd(this, model_budget) ! -- add package ratin/ratout to model budget use TdisModule, only: delt @@ -1555,12 +1499,12 @@ subroutine uzf_bd(this, model_budget) real(DP) :: ratout integer(I4B) :: isuppress_output isuppress_output = 0 - + ! ! -- Calculate flow from uzf to gwf (UZF-GWRCH) call rate_accumulator(this%rch, ratin, ratout) call model_budget%addentry(ratin, ratout, delt, this%bdtxt(2), & isuppress_output, this%packName) - + ! ! -- GW discharge and GW discharge to mover if (this%iseepflag == 1) then call rate_accumulator(-this%gwd, ratin, ratout) @@ -1572,24 +1516,21 @@ subroutine uzf_bd(this, model_budget) isuppress_output, this%packName) end if end if - + ! ! -- groundwater et (gwet array is positive, so switch ratin/ratout) if (this%igwetflag /= 0) then call rate_accumulator(-this%gwet, ratin, ratout) call model_budget%addentry(ratin, ratout, delt, this%bdtxt(4), & isuppress_output, this%packName) end if - + ! + ! -- Return return end subroutine uzf_bd + !> @brief Write flows to binary file and/or print flows to budget + !< subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) -! ****************************************************************************** -! bnd_ot_model_flows -- write flows to binary file and/or print flows to budget -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBOUNDNAME, DZERO use BndModule, only: save_print_model_flows @@ -1602,8 +1543,6 @@ subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) ! -- local character(len=LINELENGTH) :: title integer(I4B) :: itxt - ! -- formats -! ------------------------------------------------------------------------------ ! ! -- UZF-GWRCH itxt = 2 @@ -1663,12 +1602,16 @@ subroutine uzf_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap) this%boundname) end if ! - ! -- return + ! -- Return return end subroutine uzf_ot_model_flows + !> @brief Output UZF package flow terms + !< subroutine uzf_ot_package_flows(this, icbcfl, ibudfl) + ! -- modules use TdisModule, only: kstp, kper, delt, pertim, totim + ! -- dummy class(UzfType) :: this integer(I4B), intent(in) :: icbcfl integer(I4B), intent(in) :: ibudfl @@ -1689,15 +1632,22 @@ subroutine uzf_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 uzf_ot_package_flows + !> @brief Save UZF-calculated values to binary file + !< subroutine uzf_ot_dv(this, idvsave, idvprint) + ! -- modules use TdisModule, only: kstp, kper, pertim, totim + ! -- dummy use InputOutputModule, only: ulasav class(UzfType) :: this integer(I4B), intent(in) :: idvsave integer(I4B), intent(in) :: idvprint + ! -- local integer(I4B) :: ibinun ! ! -- set unit number for binary dependent variable output @@ -1712,8 +1662,13 @@ subroutine uzf_ot_dv(this, idvsave, idvprint) call ulasav(this%wcnew, ' WATER-CONTENT', kstp, kper, pertim, & totim, this%nodes, 1, 1, ibinun) end if + ! + ! -- Return + return end subroutine uzf_ot_dv + !> @brief Write UZF budget to listing file + !< subroutine uzf_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! -- module use TdisModule, only: totim @@ -1726,17 +1681,13 @@ subroutine uzf_ot_bdsummary(this, kstp, kper, iout, ibudfl) ! call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim) ! - ! -- return + ! -- Return return end subroutine uzf_ot_bdsummary + !> @brief Formulate the HCOF and RHS terms + !< subroutine uzf_solve(this, reset_state) -! ****************************************************************************** -! uzf_solve -- Formulate the HCOF and RHS terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt logical, intent(in) :: reset_state !< flag indicating that waves should be reset after solution @@ -1751,7 +1702,6 @@ subroutine uzf_solve(this, reset_state) real(DP) :: qformvr real(DP) :: wc real(DP) :: watabold -! ------------------------------------------------------------------------------ ! ! -- Initialize ierr = 0 @@ -1853,20 +1803,16 @@ subroutine uzf_solve(this, reset_state) end if end do ! - ! -- return + ! -- Return return end subroutine uzf_solve + !> @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: -! ------------------------------------------------------------------------------ + ! -- dummy class(UzfType), intent(inout) :: this -! ------------------------------------------------------------------------------ ! ! -- create the header list label this%listlabel = trim(this%filtyp)//' NO.' @@ -1885,18 +1831,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 Identify overlying cell ID based on user-specified mapping + !< subroutine findcellabove(this, n, nml) + ! -- dummy class(UzfType) :: this integer(I4B), intent(in) :: n integer(I4B), intent(inout) :: nml + ! -- local integer(I4B) :: m, ipos -! ------------------------------------------------------------------------------ -! - ! -- return nml = n if no cell is above it + ! + ! -- Return nml = n if no cell is above it nml = n do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 m = this%dis%con%ja(ipos) @@ -1909,17 +1858,17 @@ subroutine findcellabove(this, n, nml) end if end if end do + ! + ! -- Return return end subroutine findcellabove + !> @brief Read UZF cell properties and set them for UzfCellGroup type + !< subroutine read_cell_properties(this) -! ****************************************************************************** -! read_cell_properties -- Read UZF cell properties and set them for -! UzfCellGroup type. -! ****************************************************************************** + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType), intent(inout) :: this ! -- local @@ -1936,8 +1885,6 @@ subroutine read_cell_properties(this) integer(I4B), dimension(:), allocatable :: rowmaxnnz type(sparsematrix) :: sparse integer(I4B), dimension(:), allocatable :: nboundchk -! ------------------------------------------------------------------------------ -! ! ! -- allocate space for node counter and initilize allocate (rowmaxnnz(this%dis%nodes)) @@ -2149,16 +2096,13 @@ subroutine read_cell_properties(this) deallocate (rowmaxnnz) deallocate (nboundchk) ! - ! -- return + ! -- Return return end subroutine read_cell_properties + !> @brief Read UZF cell properties and set them for UZFCellGroup type + !< subroutine print_cell_properties(this) -! ****************************************************************************** -! print_cell_properties -- Read UZF cell properties and set them for -! UZFCellGroup type. -! ****************************************************************************** -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType), intent(inout) :: this ! -- local @@ -2169,8 +2113,6 @@ subroutine print_cell_properties(this) integer(I4B) :: ntabcols integer(I4B) :: i integer(I4B) :: node -! ------------------------------------------------------------------------------ -! ! ! -- setup inputtab tableobj ! @@ -2238,17 +2180,16 @@ subroutine print_cell_properties(this) end if end do ! - ! -- return + ! -- Return return end subroutine print_cell_properties + !> @brief Check UZF cell areas + !< subroutine check_cell_area(this) -! ****************************************************************************** -! check_cell_area -- Check UZF cell areas. -! ****************************************************************************** + ! -- modules use InputOutputModule, only: urword use SimModule, only: store_error, count_errors -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this ! -- local @@ -2266,8 +2207,6 @@ subroutine check_cell_area(this) real(DP) :: sumarea real(DP) :: cellarea real(DP) :: d -! ------------------------------------------------------------------------------ -! ! ! -- check that the area of vertically connected uzf cells is the equal do i = 1, this%nodes @@ -2322,40 +2261,36 @@ subroutine check_cell_area(this) if (count_errors() > 0) then call this%parser%StoreErrorUnit() end if - ! -- return + ! -- Return return end subroutine check_cell_area ! -- Procedures related to observations (type-bound) + + !> @brief Return true because uzf package supports observations + !! + !! Overrides BndType%bnd_obs_supported + !< logical function uzf_obs_supported(this) -! ****************************************************************************** -! uzf_obs_supported -! -- Return true because uzf package supports observations. -! -- Overrides BndType%bnd_obs_supported -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- dummy class(UzfType) :: this -! ------------------------------------------------------------------------------ + ! uzf_obs_supported = .true. + ! + ! -- Return return end function uzf_obs_supported + !> @brief Implements bnd_df_obs + !! + !! Store observation type supported by uzf package. + !! Overrides BndType%bnd_df_obs + !< subroutine uzf_df_obs(this) -! ****************************************************************************** -! uzf_df_obs (implements bnd_df_obs) -! -- Store observation type supported by uzf package. -! -- Overrides BndType%bnd_df_obs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfType) :: this ! -- local integer(I4B) :: indx - ! ------------------------------------------------------------------------------ ! ! -- Store obs type and assign procedure pointer ! @@ -2407,19 +2342,14 @@ subroutine uzf_df_obs(this) call this%obs%StoreObsType('water-content', .false., indx) this%obs%obsData(indx)%ProcessIdPtr => uzf_process_obsID ! - ! -- return + ! -- Return return end subroutine uzf_df_obs -! + + !> @brief Calculate observations this time step and call ObsType%SaveOneSimval + !! for each UzfType observation + !< subroutine uzf_bd_obs(this) - ! ************************************************************************** - ! uzf_bd_obs - ! -- Calculate observations this time step and call - ! ObsType%SaveOneSimval for each UzfType observation. - ! ************************************************************************** - ! - ! SPECIFICATIONS: - ! -------------------------------------------------------------------------- ! -- dummy class(UzfType) :: this ! -- local @@ -2428,7 +2358,6 @@ subroutine uzf_bd_obs(this) integer(I4B) :: n real(DP) :: v type(ObserveType), pointer :: obsrv => null() - !--------------------------------------------------------------------------- ! ! -- Make final uzf solution, and do not reset waves. This will advance ! the waves to their new state at the end of the time step. This should @@ -2510,11 +2439,17 @@ subroutine uzf_bd_obs(this) end if end if ! - ! -- return + ! -- Return return end subroutine uzf_bd_obs -! + + !> @brief Process each observation + !! + !! Only done the first stress period since boundaries are fixed for the + !! simulation + !< subroutine uzf_rp_obs(this) + ! -- modules use TdisModule, only: kper ! -- dummy class(UzfType), intent(inout) :: this @@ -2528,13 +2463,9 @@ subroutine uzf_rp_obs(this) real(DP) :: dmax character(len=LENBOUNDNAME) :: bname class(ObserveType), pointer :: obsrv => null() - ! -------------------------------------------------------------------------- ! -- formats 60 format('Invalid node number in OBS input: ', i0) ! - ! -- process each package observation - ! only done the first stress period since boundaries are fixed - ! for the simulation if (kper == 1) then do i = 1, this%obs%npakobs obsrv => this%obs%pakobs(i)%obsrv @@ -2633,13 +2564,19 @@ subroutine uzf_rp_obs(this) end if end if ! + ! -- Return return end subroutine uzf_rp_obs - ! + ! -- Procedures related to observations (NOT type-bound) + + !> @brief This procedure is pointed to by ObsDataType%ProcesssIdPtr + !! + !! Process the ID string of an observation definition for UZF-package + !! observations + !< subroutine uzf_process_obsID(obsrv, dis, inunitobs, iout) - ! -- This procedure is pointed to by ObsDataType%ProcesssIdPtr. It processes - ! the ID string of an observation definition for UZF-package observations. + ! -- . ! -- dummy type(ObserveType), intent(inout) :: obsrv class(DisBaseType), intent(in) :: dis @@ -2684,22 +2621,17 @@ subroutine uzf_process_obsID(obsrv, dis, inunitobs, iout) obsrv%Obsdepth = obsdepth end if ! + ! -- Return return end subroutine uzf_process_obsID + !> @brief Allocate scalar members + !< subroutine uzf_allocate_scalars(this) -! ****************************************************************************** -! allocate_scalars -- allocate scalar members -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules - use MemoryManagerModule, only: mem_allocate ! -- dummy class(UzfType) :: this -! ------------------------------------------------------------------------------ ! ! -- call standard BndType allocate scalars call this%BndType%allocate_scalars() @@ -2727,7 +2659,7 @@ subroutine uzf_allocate_scalars(this) call mem_allocate(this%igwetflag, 'IGWETFLAG', this%memoryPath) call mem_allocate(this%iuzf2uzf, 'IUZF2UZF', this%memoryPath) call mem_allocate(this%cbcauxitems, 'CBCAUXITEMS', this%memoryPath) - + ! call mem_allocate(this%iconvchk, 'ICONVCHK', this%memoryPath) ! ! -- initialize scalars @@ -2752,30 +2684,24 @@ subroutine uzf_allocate_scalars(this) ! -- convergence check this%iconvchk = 1 ! - ! -- return + ! -- Return return end subroutine uzf_allocate_scalars -! + + !> @brief Deallocate objects + !< subroutine uzf_da(this) -! ****************************************************************************** -! uzf_da -- Deallocate objects -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ + ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(UzfType) :: this - ! -- locals - ! -- format -! ------------------------------------------------------------------------------ ! ! -- deallocate uzf objects call this%uzfobj%dealloc() deallocate (this%uzfobj) nullify (this%uzfobj) call this%uzfobjwork%dealloc() - + ! call this%budobj%budgetobject_da() deallocate (this%budobj) nullify (this%budobj) @@ -2862,15 +2788,12 @@ subroutine uzf_da(this) return end subroutine uzf_da + !> @brief Set up the budget object that stores all the uzf flows + !! + !! The terms listed here must correspond in number and order to the ones + !! listed in the uzf_fill_budobj routine + !< subroutine uzf_setup_budobj(this) -! ****************************************************************************** -! uzf_setup_budobj -- Set up the budget object that stores all the uzf flows -! The terms listed here must correspond in number and order to the ones -! listed in the uzf_fill_budobj routine. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use ConstantsModule, only: LENBUDTXT ! -- dummy @@ -2885,7 +2808,6 @@ subroutine uzf_setup_budobj(this) real(DP) :: q character(len=LENBUDTXT) :: text character(len=LENBUDTXT), dimension(1) :: auxtxt -! ------------------------------------------------------------------------------ ! ! -- Determine the number of uzf to uzf connections nlen = 0 @@ -3068,19 +2990,13 @@ subroutine uzf_setup_budobj(this) call this%budobj%flowtable_df(this%iout, cellids='GWF') end if ! - ! -- return + ! -- Return return - end subroutine uzf_setup_budobj + !> @brief Copy flow terms into this%budobj + !< subroutine uzf_fill_budobj(this) -! ****************************************************************************** -! uzf_fill_budobj -- copy flow terms into this%budobj -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfType) :: this ! -- local @@ -3096,8 +3012,6 @@ subroutine uzf_fill_budobj(this) real(DP) :: thick real(DP) :: fm real(DP) :: v - ! -- formats -! ----------------------------------------------------------------------------- ! ! -- initialize counter idx = 0 @@ -3229,7 +3143,7 @@ subroutine uzf_fill_budobj(this) ! --Terms are filled, now accumulate them for this time step call this%budobj%accumulate_terms() ! - ! -- return + ! -- Return return end subroutine uzf_fill_budobj diff --git a/src/Model/ModelUtilities/UzfCellGroup.f90 b/src/Model/ModelUtilities/UzfCellGroup.f90 index 5e8cc879535..91c0221ff4b 100644 --- a/src/Model/ModelUtilities/UzfCellGroup.f90 +++ b/src/Model/ModelUtilities/UzfCellGroup.f90 @@ -12,6 +12,7 @@ module UzfCellGroupModule public :: UzfCellGroupType type :: UzfCellGroupType + integer(I4B) :: imem_manager real(DP), pointer, dimension(:), contiguous :: thtr => null() real(DP), pointer, dimension(:), contiguous :: thts => null() @@ -53,7 +54,9 @@ module UzfCellGroupModule real(DP), pointer, dimension(:), contiguous :: gwpet => null() integer(I4B), pointer, dimension(:), contiguous :: landflag => null() integer(I4B), pointer, dimension(:), contiguous :: ivertcon => null() + contains + procedure :: init procedure :: setdata procedure :: sethead @@ -86,18 +89,12 @@ module UzfCellGroupModule procedure :: get_water_content_at_depth procedure :: get_wcnew end type UzfCellGroupType -! + contains -! -! ------------------------------------------------------------------------------ + !> @brief Allocate and set uzf object variables + !< subroutine init(this, ncells, nwav, memory_path) -! ****************************************************************************** -! init -- allocate and set uzf object variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_allocate ! -- dummy @@ -107,7 +104,6 @@ subroutine init(this, ncells, nwav, memory_path) character(len=*), intent(in), optional :: memory_path ! -- local integer(I4B) :: icell -! ------------------------------------------------------------------------------ ! ! -- Use mem_allocate if memory path is passed in, otherwise it's a temp object if (present(memory_path)) then @@ -238,23 +234,17 @@ subroutine init(this, ncells, nwav, memory_path) this%ivertcon(icell) = 0 end do ! - ! -- return + ! -- Return return end subroutine init + !> @brief Deallocate uzf object variables + !< subroutine dealloc(this) -! ****************************************************************************** -! dealloc -- deallocate uzf object variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(UzfCellGroupType) :: this - ! -- local -! ------------------------------------------------------------------------------ ! ! -- deallocate based on whether or not memory manager was used if (this%imem_manager == 0) then @@ -341,19 +331,14 @@ subroutine dealloc(this) call mem_deallocate(this%ivertcon) end if ! - ! -- return + ! -- Return return end subroutine dealloc + !> @brief Set uzf object material properties + !< subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & thti, eps, ntrail, landflag, ivertcon) -! ****************************************************************************** -! setdata -- set uzf object material properties -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -369,7 +354,6 @@ subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & integer(I4B), intent(in) :: ntrail integer(I4B), intent(in) :: landflag integer(I4B), intent(in) :: ivertcon -! ------------------------------------------------------------------------------ ! ! -- set the values for uzf cell icell this%landflag(icell) = landflag @@ -396,19 +380,13 @@ subroutine setdata(this, icell, area, top, bot, surfdep, vks, thtr, thts, & this%hroot(icell) = DZERO end subroutine setdata + !> @brief Set initial head for uzf object + !< subroutine sethead(this, icell, hgwf) -! ****************************************************************************** -! sethead -- set uzf object material properties -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: hgwf -! ------------------------------------------------------------------------------ ! ! -- set initial head this%watab(icell) = this%celbot(icell) @@ -416,22 +394,19 @@ subroutine sethead(this, icell, hgwf) if (this%watab(icell) > this%celtop(icell)) & this%watab(icell) = this%celtop(icell) this%watabold(icell) = this%watab(icell) + ! + ! -- Return + return end subroutine sethead + !> @brief Set infiltration + !< subroutine setdatafinf(this, icell, finf) -! ****************************************************************************** -! setdatafinf -- set infiltration -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: finf -! ------------------------------------------------------------------------------ + ! if (this%landflag(icell) == 1) then this%sinf(icell) = finf this%finf(icell) = finf @@ -442,39 +417,29 @@ subroutine setdatafinf(this, icell, finf) this%finf_rej(icell) = DZERO this%surflux(icell) = DZERO this%surfluxbelow(icell) = DZERO + ! + ! -- Return + return end subroutine setdatafinf + !> @brief Set uzfarea using cellarea and areamult + !< subroutine setdatauzfarea(this, icell, areamult) -! ****************************************************************************** -! setdatauzfarea -- set uzfarea using cellarea and areamult -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: areamult -! ------------------------------------------------------------------------------ ! ! -- set uzf area this%uzfarea(icell) = this%cellarea(icell) * areamult ! - ! -- return + ! -- Return return end subroutine setdatauzfarea -! ------------------------------------------------------------------------------ -! + !> @brief Set unsaturated ET-related variables + !< subroutine setdataet(this, icell, jbelow, pet, extdp) -! ****************************************************************************** -! setdataet -- set unsat. et variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -483,7 +448,7 @@ subroutine setdataet(this, icell, jbelow, pet, extdp) real(DP), intent(in) :: extdp ! -- local real(DP) :: thick -! ------------------------------------------------------------------------------ + ! if (this%landflag(icell) == 1) then this%pet(icell) = pet this%gwpet(icell) = pet @@ -515,18 +480,13 @@ subroutine setdataet(this, icell, jbelow, pet, extdp) this%petmax(jbelow) = this%petmax(icell) end if ! - ! -- return + ! -- Return return end subroutine setdataet + !> @brief Subtract aet from pet to calculate residual et for gw + !< subroutine setgwpet(this, icell) -! ****************************************************************************** -! setgwpet -- subtract aet from pet to calculate residual et for gw -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -534,7 +494,7 @@ subroutine setgwpet(this, icell) integer(I4B), intent(in) :: icell ! -- dummy real(DP) :: pet -! ------------------------------------------------------------------------------ + ! pet = DZERO ! ! -- reduce pet for gw by uzet @@ -542,18 +502,13 @@ subroutine setgwpet(this, icell) if (pet < DZERO) pet = DZERO this%gwpet(icell) = pet ! - ! -- return + ! -- Return return end subroutine setgwpet + !> @brief Subtract aet from pet to calculate residual et for deeper cells + !< subroutine setbelowpet(this, icell, jbelow) -! ****************************************************************************** -! setbelowpet -- subtract aet from pet to calculate residual et -! for deeper cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -562,7 +517,7 @@ subroutine setbelowpet(this, icell, jbelow) integer(I4B), intent(in) :: jbelow ! -- dummy real(DP) :: pet -! ------------------------------------------------------------------------------ + ! pet = DZERO ! ! -- transfer unmet pet to lower cell @@ -574,39 +529,30 @@ subroutine setbelowpet(this, icell, jbelow) end if this%pet(jbelow) = pet ! - ! -- return + ! -- Return return end subroutine setbelowpet + !> @brief Set extinction water content + !< subroutine setdataetwc(this, icell, jbelow, extwc) -! ****************************************************************************** -! setdataetwc -- set extinction water content -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell integer(I4B), intent(in) :: jbelow real(DP), intent(in) :: extwc -! ------------------------------------------------------------------------------ ! ! -- set extinction water content this%extwc(icell) = extwc if (jbelow > 0) this%extwc(jbelow) = extwc ! - ! -- return + ! -- Return return end subroutine setdataetwc + !> @brief Set variables for head-based unsaturated flow + !< subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) -! ****************************************************************************** -! setdataetha -- set variables for head-based unsat. flow -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -614,7 +560,6 @@ subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) real(DP), intent(in) :: ha real(DP), intent(in) :: hroot real(DP), intent(in) :: rootact -! ------------------------------------------------------------------------------ ! ! -- set variables this%ha(icell) = ha @@ -626,39 +571,30 @@ subroutine setdataetha(this, icell, jbelow, ha, hroot, rootact) this%rootact(jbelow) = rootact end if ! - ! -- return + ! -- Return return end subroutine setdataetha + !> @brief Set variables to advance to new time step. nothing yet. + !< subroutine advance(this, icell) -! ****************************************************************************** -! advance -- set variables to advance to new time step. nothing yet. -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell -! ------------------------------------------------------------------------------ ! ! -- set variables this%surfseep(icell) = DZERO ! - ! -- return + ! -- Return return end subroutine advance + !> @brief Formulate the unsaturated flow object, calculate terms for gwf + !! equation + !< subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & issflag, iseepflag, hgwf, qfrommvr, ierr, & reset_state, trhs, thcof, deriv, watercontent) -! ****************************************************************************** -! formulate -- formulate the unsaturated flow object, calculate terms for -! gwf equation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt ! -- dummy @@ -690,7 +626,6 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & real(DP) :: thcofseep real(DP) :: deriv1 real(DP) :: deriv2 -! ------------------------------------------------------------------------------ ! ! -- initialize variables totfluxtot = DZERO @@ -721,7 +656,7 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & if (reset_state) then call thiswork%wave_shift(this, 1, icell, 0, 1, this%nwavst(icell), 1) end if - + ! if (this%watab(icell) > this%celtop(icell)) & this%watab(icell) = this%celtop(icell) ! @@ -791,17 +726,13 @@ subroutine solve(this, thiswork, jbelow, icell, totfluxtot, ietflag, & call this%wave_shift(thiswork, icell, 1, 0, 1, thiswork%nwavst(1), 1) end if ! + ! -- Return return end subroutine solve + !> @brief Add recharge or infiltration to cells + !< subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) -! ****************************************************************************** -! addrech -- add recharge or infiltration to cells -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -814,7 +745,6 @@ subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) ! -- local real(DP) :: fcheck real(DP) :: x, scale, range -! ------------------------------------------------------------------------------ ! ! -- initialize range = DEM5 @@ -838,18 +768,13 @@ subroutine addrech(this, icell, jbelow, hgwf, trhs, thcof, deriv, delt) this%totflux(icell) = scale * this%totflux(icell) + fcheck * delt trhs = this%uzfarea(icell) * this%totflux(icell) / delt ! - ! -- return + ! -- Return return end subroutine addrech + !> @brief Reject applied infiltration due to low vks + !< subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) -! ****************************************************************************** -! rejfinf -- reject applied infiltration due to low vks -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -860,7 +785,7 @@ subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) real(DP), intent(in) :: hgwf ! -- local real(DP) :: x, range, scale, q -! ------------------------------------------------------------------------------ + ! range = this%surfdep(icell) q = this%surflux(icell) finfact = q @@ -874,18 +799,13 @@ subroutine rejfinf(this, icell, deriv, hgwf, trhs, thcof, finfact) thcof = finfact * this%uzfarea(icell) / range end if ! - ! -- return + ! -- Return return end subroutine rejfinf + !> @brief Calculate groudwater discharge to land surface + !< subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) -! ****************************************************************************** -! gwseep -- calc. groudwater discharge to land surface -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -897,7 +817,7 @@ subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) real(DP), intent(in) :: hgwf ! -- local real(DP) :: x, range, y, deriv1, d1, d2, Q -! ------------------------------------------------------------------------------ + ! seep = DZERO deriv = DZERO deriv1 = DZERO @@ -922,18 +842,13 @@ subroutine gwseep(this, icell, deriv, scale, hgwf, trhs, thcof, seep) thcof = DZERO end if ! - ! -- return + ! -- Return return end subroutine gwseep + !> @brief Calculate gwf et using residual uzf pet + !< subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) -! ****************************************************************************** -! simgwet -- calc. gwf et using residual uzf pet -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: igwetflag @@ -944,7 +859,6 @@ subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) real(DP), intent(inout) :: det ! -- local real(DP) :: s, x, c, b, et -! ------------------------------------------------------------------------------ ! this%gwet(icell) = DZERO trhs = DZERO @@ -962,26 +876,20 @@ subroutine simgwet(this, igwetflag, icell, hgwf, trhs, thcof, det) else if (igwetflag == 2) then et = etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) end if -! this%gwet(icell) = et * this%uzfarea(icell) + ! this%gwet(icell) = et * this%uzfarea(icell) trhs = trhs * this%uzfarea(icell) thcof = thcof * this%uzfarea(icell) this%gwet(icell) = trhs - (thcof * hgwf) - ! write(99,*)'in group', icell, this%gwet(icell) + ! write(99,*)'in group', icell, this%gwet(icell) ! - ! -- return + ! -- Return return end subroutine simgwet + !> @brief Calculate gwf et using linear ET function from mf-2005 + !< function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) -! ****************************************************************************** -! etfunc_lin -- calc. gwf et using linear ET function from mf-2005 -! -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: etfunc_lin ! -- dummy real(DP), intent(in) :: s @@ -997,7 +905,6 @@ function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) real(DP) :: etgw real(DP) :: range real(DP) :: depth, scale, thick -! ------------------------------------------------------------------------------ ! ! -- Between ET surface and extinction depth if (hgwf > (s - x) .and. hgwf < s) THEN @@ -1033,18 +940,14 @@ function etfunc_lin(s, x, c, det, trhs, thcof, hgwf, celtop, celbot) det = -det * etgw etfunc_lin = etgw ! - ! -- return + ! -- Return return end function etfunc_lin + !> @brief Square-wave ET function with smoothing at extinction depth + !< function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) -! ****************************************************************************** -! etfunc_nlin -- Square-wave ET function with smoothing at extinction depth -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- return + ! -- Return real(DP) :: etfunc_nlin ! -- dummy real(DP), intent(in) :: s @@ -1058,7 +961,7 @@ function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) real(DP) :: etgw real(DP) :: range real(DP) :: depth, scale -! ------------------------------------------------------------------------------ + ! depth = hgwf - (s - x) if (depth < DZERO) depth = DZERO etgw = c @@ -1069,24 +972,19 @@ function etfunc_nlin(s, x, c, det, trhs, thcof, hgwf) det = -det * etgw etfunc_nlin = etgw ! - ! -- return + ! -- Return return end function etfunc_nlin + !> @brief Calculate recharge due to a rise in the gwf head + !< subroutine uz_rise(this, icell, totfluxtot) -! ****************************************************************************** -! uz_rise -- calculate recharge due to a rise in the gwf head -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(inout) :: totfluxtot ! -- local real(DP) :: fm1, fm2, d1 -! ------------------------------------------------------------------------------ ! ! -- additional recharge from a rising water table if (this%watab(icell) - this%watabold(icell) > DEM30) then @@ -1097,17 +995,13 @@ subroutine uz_rise(this, icell, totfluxtot) totfluxtot = totfluxtot + (fm1 - fm2) end if ! - ! -- return + ! -- Return return end subroutine uz_rise + !> @brief Reset waves to default values at start of simulation + !< subroutine setwaves(this, icell) -! ****************************************************************************** -! setwaves -- reset waves to default values at start of simulation -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this ! -- local @@ -1115,7 +1009,6 @@ subroutine setwaves(this, icell) real(DP) :: bottom, top integer(I4B) :: jk real(DP) :: thick -! ------------------------------------------------------------------------------ ! ! -- initialize this%totflux(icell) = DZERO @@ -1154,18 +1047,13 @@ subroutine setwaves(this, icell) this%uzthst(1, icell) = this%thtr(icell) end if ! - ! -- return + ! -- Return return end subroutine + !> @brief Prepare and route waves over time step + !< subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) -! ****************************************************************************** -! routewaves -- prepare and route waves over time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: totfluxtot @@ -1176,7 +1064,6 @@ subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) ! -- local real(DP) :: thick, thickold integer(I4B) :: idelt, iwav, ik -! ------------------------------------------------------------------------------ ! ! -- initialize this%totflux(icell) = DZERO @@ -1201,17 +1088,13 @@ subroutine routewaves(this, totfluxtot, delt, ietflag, icell, ierr) totfluxtot = totfluxtot + this%totflux(icell) end do ! - ! -- return + ! -- Return return end subroutine routewaves + !> @brief Copy waves or shift waves in arrays + !< subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) -! ****************************************************************************** -! wave_shift -- copy waves or shift waves in arrays -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(UzfCellGroupType) :: this type(UzfCellGroupType) :: this2 @@ -1223,7 +1106,6 @@ subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) integer(I4B), intent(in) :: cntr ! -- local integer(I4B) :: j -! ------------------------------------------------------------------------------ ! ! -- copy waves from one uzf cell group to another do j = strt, stp, cntr @@ -1234,17 +1116,13 @@ subroutine wave_shift(this, this2, icell, icell2, shft, strt, stp, cntr) end do this%nwavst(icell) = this2%nwavst(icell2) ! - ! -- return + ! -- Return return end subroutine + !> @brief Method of Characteristics solution for kinematic wave equation + !< subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) -! ****************************************************************************** -! uzflow -- moc solution for kinematic wave equation -! ****************************************************************************** -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: thickold @@ -1257,7 +1135,7 @@ subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) real(DP) :: ffcheck, time, feps1, feps2 real(DP) :: thetadif, thetab, fluxb, oldsflx integer(I4B) :: itrailflg, itester -! ------------------------------------------------------------------------------ + ! time = DZERO this%totflux(icell) = DZERO itrailflg = 0 @@ -1330,24 +1208,18 @@ subroutine uzflow(this, thick, thickold, delt, ietflag, icell, ierr) if (ietflag > 0) call this%uzet(icell, delt, ietflag, ierr) if (ierr > 0) return ! - ! -- return + ! -- Return return end subroutine uzflow + !> @brief Calculate unit specific tolerances + !< subroutine factors(feps1, feps2) -! ****************************************************************************** -! factors----calculate unit specific tolerances -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy real(DP), intent(out) :: feps1 real(DP), intent(out) :: feps2 real(DP) :: factor1 real(DP) :: factor2 -! ------------------------------------------------------------------------------ ! ! calculate constants for uzflow factor1 = DONE @@ -1367,18 +1239,13 @@ subroutine factors(feps1, feps2) feps1 = feps1 * factor1 * factor2 feps2 = feps2 * factor1 * factor2 ! - ! -- return + ! -- Return return end subroutine factors + !> @brief Create and set trail waves + !< subroutine trailwav(this, icell, ierr) -! ****************************************************************************** -! trailwav----create and set trail waves -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1389,7 +1256,6 @@ subroutine trailwav(this, icell, ierr) real(DP) :: flux1, flux2, theta1, theta2 real(DP) :: fnuminc integer(I4B) :: j, jj, jk, nwavstm1 -! ------------------------------------------------------------------------------ ! ! -- initialize eps_m1 = dble(this%eps(icell)) - DONE @@ -1462,19 +1328,14 @@ subroutine trailwav(this, icell, ierr) this%thtr(icell), this%eps(icell), this%vks(icell)) end if ! - ! -- return + ! -- Return return end subroutine trailwav + !> @brief Create a lead wave and route over time step + !< subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & ffcheck, feps2, delt, icell) -! ****************************************************************************** -! leadwav----create a lead wave and route over time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this real(DP), intent(inout) :: thetab @@ -1495,7 +1356,7 @@ subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & integer(I4B) :: iflx, iremove, j, l integer(I4B) :: nwavp1, jshort integer(I4B), allocatable, dimension(:) :: more -! ------------------------------------------------------------------------------ + ! allocate (checktime(this%nwavst(icell))) allocate (more(this%nwavst(icell))) ftest = DZERO @@ -1671,19 +1532,14 @@ subroutine leadwav(this, time, itester, itrailflg, thetab, fluxb, & deallocate (checktime) deallocate (more) ! - ! -- return + ! -- Return return end subroutine leadwav + !> @brief Calculates waves speed from dflux/dtheta + !< function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) -! ****************************************************************************** -! leadspeed----calculates waves speed from dflux/dtheta -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: leadspeed ! -- dummy real(DP), intent(in) :: theta1 @@ -1697,7 +1553,6 @@ function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) ! -- local real(DP) :: comp1, comp2, thsrinv, epsfksths real(DP) :: eps_m1, fhold, comp3 -! ------------------------------------------------------------------------------ ! eps_m1 = eps - DONE thsrinv = DONE / (thts - thtr) @@ -1715,19 +1570,14 @@ function leadspeed(theta1, theta2, flux1, flux2, thts, thtr, eps, vks) end if if (leadspeed < DEM30) leadspeed = DEM30 ! - ! -- return + ! -- Return return end function leadspeed + !> @brief Sums up mobile water over depth interval + !< function unsat_stor(this, icell, d1) -! ****************************************************************************** -! unsat_stor---- sums up mobile water over depth interval -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: unsat_stor ! -- dummy class(UzfCellGroupType) :: this @@ -1736,7 +1586,7 @@ function unsat_stor(this, icell, d1) ! -- local real(DP) :: fm integer(I4B) :: j, k, nwavm1, jj -! ------------------------------------------------------------------------------ + ! fm = DZERO j = this%nwavst(icell) + 1 k = this%nwavst(icell) @@ -1766,16 +1616,14 @@ function unsat_stor(this, icell, d1) fm = fm + (this%uzthst(1, icell) - this%thtr(icell)) * d1 end if unsat_stor = fm + ! + ! -- Return + return end function unsat_stor + !> @brief Update to new state of uz at end of time step + !< subroutine update_wav(this, icell, delt, iss, itest) -! ****************************************************************************** -! update_wav -- update to new state of uz at end of time step -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1786,7 +1634,6 @@ subroutine update_wav(this, icell, delt, iss, itest) real(DP) :: bot, depthsave, top real(DP) :: thick, thtsrinv integer(I4B) :: nwavhld, k, j -! ------------------------------------------------------------------------------ ! bot = this%watab(icell) top = this%celtop(icell) @@ -1848,16 +1695,14 @@ subroutine update_wav(this, icell, delt, iss, itest) end if this%watabold(icell) = this%watab(icell) end if + ! + ! -- Return + return end subroutine update_wav + !> @brief Remove water from uz due to et + !< subroutine uzet(this, icell, delt, ietflag, ierr) -! ****************************************************************************** -! uzet -- remove water from uz due to et -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell @@ -1894,7 +1739,6 @@ subroutine uzet(this, icell, delt, ietflag, ierr) integer(I4B) :: k integer(I4B) :: nwv integer(I4B) :: itest -! ------------------------------------------------------------------------------ ! ! -- initialize this%etact(icell) = DZERO @@ -2189,25 +2033,20 @@ subroutine uzet(this, icell, delt, ietflag, ierr) ! -- deallocate temporary worker call uzfktemp%dealloc() ! - ! -- return + ! -- Return return end subroutine uzet + !> @brief Calculate capillary pressure head from B-C equation + !< function caph(this, icell, tho) -! ****************************************************************************** -! caph---- calculate capillary pressure head from B-C equation -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: tho ! -- local real(DP) :: caph, lambda, star -! ------------------------------------------------------------------------------ + ! caph = -DEM6 star = (tho - this%thtr(icell)) / (this%thts(icell) - this%thtr(icell)) if (star < DEM15) star = DEM15 @@ -2219,37 +2058,45 @@ function caph(this, icell, tho) caph = DZERO end if end if + ! + ! -- Return + return end function caph + !> @brief Calculate capillary pressure-based uz et function rate_et_z(this, icell, factor, fktho, h) -! ****************************************************************************** -! rate_et_z---- capillary pressure based uz et -! ****************************************************************************** -! SPECIFICATIONS: -! -! ------------------------------------------------------------------------------ - ! -- modules - ! -- return + ! -- Return real(DP) :: rate_et_z ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell real(DP), intent(in) :: factor, fktho, h - ! -- local -! ------------------------------------------------------------------------------ + ! rate_et_z = factor * fktho * (h - this%hroot(icell)) if (rate_et_z < DZERO) rate_et_z = DZERO + ! + ! -- Return + return end function rate_et_z + !> @brief Determine the water content at a specific depth + !! + !! Because UZF-calculated waves are internal to UZF objects, different water + !! contents exists at different depths. + !< function get_water_content_at_depth(this, icell, depth) result(theta_at_depth) + ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell !< uzf cell containing depth real(DP), intent(in) :: depth !< depth within the cell + ! -- return real(DP) :: theta_at_depth + ! -- local real(DP) :: d1 real(DP) :: d2 real(DP) :: f1 real(DP) :: f2 + ! if (this%watab(icell) < this%celtop(icell)) then if (this%celtop(icell) - depth > this%watab(icell)) then d1 = depth - DEM3 @@ -2263,14 +2110,20 @@ function get_water_content_at_depth(this, icell, depth) result(theta_at_depth) else theta_at_depth = this%thts(icell) end if + ! + ! -- Return return end function get_water_content_at_depth + !> @brief Calculate and return the cell-based water content value + !< function get_wcnew(this, icell) result(watercontent) + ! -- dummy class(UzfCellGroupType) :: this integer(I4B), intent(in) :: icell !< uzf cell containing depth - ! + ! -- return real(DP) :: watercontent + ! -- local real(DP) :: top real(DP) :: bot real(DP) :: theta_r @@ -2292,6 +2145,8 @@ function get_wcnew(this, icell) result(watercontent) else watercontent = DZERO end if + ! + ! -- Return return end function get_wcnew