MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
gwelkemodule Module Reference

Data Types

type  gwelketype
 

Functions/Subroutines

subroutine, public lke_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
 Create a new lke package. More...
 
subroutine find_lke_package (this)
 Find corresponding lke package. More...
 
real(dp) function lke_setting_value (this, itemno, key)
 Value for a package-specific PERIOD setting. More...
 
subroutine lke_fc_expanded (this, rhs, ia, idxglo, matrix_sln)
 Add matrix terms related to LKE. More...
 
subroutine lke_solve (this)
 Add terms specific to lakes to the explicit lake solve. More...
 
integer(i4b) function lke_get_nbudterms (this)
 Function to return the number of budget terms just for this package. More...
 
subroutine lke_setup_budobj (this, idx)
 Set up the budget object that stores all the lake flows. More...
 
subroutine lke_fill_budobj (this, idx, x, flowja, ccratin, ccratout)
 Copy flow terms into thisbudobj. More...
 
subroutine allocate_scalars (this)
 Allocate scalars specific to the lake energy transport (LKE) package. More...
 
subroutine lke_allocate_arrays (this)
 Allocate arrays specific to the lake energy transport (LKE) package. More...
 
subroutine lke_checkin_deprecated_names (this)
 Alias deprecated LKE variable names to their current storage. More...
 
subroutine lke_da (this)
 Deallocate memory. More...
 
subroutine lke_rain_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Rain term. More...
 
subroutine lke_evap_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Evaporative term. More...
 
subroutine lke_roff_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Runoff term. More...
 
subroutine lke_iflw_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Inflow Term. More...
 
subroutine lke_wdrl_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Specified withdrawal term. More...
 
subroutine lke_outf_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Outflow term. More...
 
subroutine lke_df_obs (this)
 Defined observation types. More...
 
subroutine lke_rp_obs (this, obsrv, found)
 Process package specific obs. More...
 
subroutine lke_bd_obs (this, obstypeid, jj, v, found)
 Calculate observation value and pass it back to APT. More...
 
subroutine lke_read_cvs (this)
 Source LKE PACKAGEDATA, including thermal conduction fields. More...
 

Variables

character(len= *), parameter ftype = 'LKE'
 
character(len= *), parameter flowtype = 'LAK'
 
character(len=16) text = ' LKE'
 

Function/Subroutine Documentation

◆ allocate_scalars()

subroutine gwelkemodule::allocate_scalars ( class(gwelketype)  this)

Definition at line 743 of file gwe-lke.f90.

744  ! -- modules
746  ! -- dummy
747  class(GweLkeType) :: this
748  !
749  ! -- Allocate scalars in TspAptType
750  call this%TspAptType%allocate_scalars()
751  !
752  ! -- Allocate
753  call mem_allocate(this%idxbudrain, 'IDXBUDRAIN', this%memoryPath)
754  call mem_allocate(this%idxbudevap, 'IDXBUDEVAP', this%memoryPath)
755  call mem_allocate(this%idxbudroff, 'IDXBUDROFF', this%memoryPath)
756  call mem_allocate(this%idxbudiflw, 'IDXBUDIFLW', this%memoryPath)
757  call mem_allocate(this%idxbudwdrl, 'IDXBUDWDRL', this%memoryPath)
758  call mem_allocate(this%idxbudoutf, 'IDXBUDOUTF', this%memoryPath)
759  call mem_allocate(this%idxbudlbcd, 'IDXBUDLBCD', this%memoryPath)
760  !
761  ! -- Initialize
762  this%idxbudrain = 0
763  this%idxbudevap = 0
764  this%idxbudroff = 0
765  this%idxbudiflw = 0
766  this%idxbudwdrl = 0
767  this%idxbudoutf = 0
768  this%idxbudlbcd = 0

◆ find_lke_package()

subroutine gwelkemodule::find_lke_package ( class(gwelketype)  this)

Definition at line 173 of file gwe-lke.f90.

174  ! -- modules
176  ! -- dummy
177  class(GweLkeType) :: this
178  ! -- local
179  character(len=LINELENGTH) :: errmsg
180  class(BndType), pointer :: packobj
181  integer(I4B) :: ip, icount
182  integer(I4B) :: nbudterm
183  logical :: found
184  !
185  ! -- Initialize found to false, and error later if flow package cannot
186  ! be found
187  found = .false.
188  !
189  ! -- If user is specifying flows in a binary budget file, then set up
190  ! the budget file reader, otherwise set a pointer to the flow package
191  ! budobj
192  if (this%fmi%flows_from_file) then
193  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
194  if (associated(this%flowbudptr)) found = .true.
195  !
196  else
197  if (associated(this%fmi%gwfbndlist)) then
198  ! -- Look through gwfbndlist for a flow package with the same name as
199  ! this transport package name
200  do ip = 1, this%fmi%gwfbndlist%Count()
201  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
202  if (packobj%packName == this%flowpackagename) then
203  found = .true.
204  !
205  ! -- Store BndType pointer to packobj, and then
206  ! use the select type to point to the budobj in flow package
207  this%flowpackagebnd => packobj
208  select type (packobj)
209  type is (laktype)
210  this%flowbudptr => packobj%budobj
211  end select
212  end if
213  if (found) exit
214  end do
215  end if
216  end if
217  !
218  ! -- Error if flow package not found
219  if (.not. found) then
220  write (errmsg, '(a)') 'Could not find flow package with name '&
221  &//trim(adjustl(this%flowpackagename))//'.'
222  call store_error(errmsg)
223  call store_error_filename(this%input_fname)
224  end if
225  !
226  ! -- Allocate space for idxbudssm, which indicates whether this is a
227  ! special budget term or one that is a general source and sink
228  nbudterm = this%flowbudptr%nbudterm
229  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
230  !
231  ! -- Process budget terms and identify special budget terms
232  write (this%iout, '(/, a, a)') &
233  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
234  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
235  write (this%iout, '(a, i0)') &
236  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
237  icount = 1
238  do ip = 1, this%flowbudptr%nbudterm
239  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
240  case ('FLOW-JA-FACE')
241  this%idxbudfjf = ip
242  this%idxbudssm(ip) = 0
243  case ('GWF')
244  this%idxbudgwf = ip
245  this%idxbudlbcd = ip
246  this%idxbudssm(ip) = 0
247  case ('STORAGE')
248  this%idxbudsto = ip
249  this%idxbudssm(ip) = 0
250  case ('RAINFALL')
251  this%idxbudrain = ip
252  this%idxbudssm(ip) = 0
253  case ('EVAPORATION')
254  this%idxbudevap = ip
255  this%idxbudssm(ip) = 0
256  case ('RUNOFF')
257  this%idxbudroff = ip
258  this%idxbudssm(ip) = 0
259  case ('EXT-INFLOW')
260  this%idxbudiflw = ip
261  this%idxbudssm(ip) = 0
262  case ('WITHDRAWAL')
263  this%idxbudwdrl = ip
264  this%idxbudssm(ip) = 0
265  case ('EXT-OUTFLOW')
266  this%idxbudoutf = ip
267  this%idxbudssm(ip) = 0
268  case ('TO-MVR')
269  this%idxbudtmvr = ip
270  this%idxbudssm(ip) = 0
271  case ('FROM-MVR')
272  this%idxbudfmvr = ip
273  this%idxbudssm(ip) = 0
274  case ('AUXILIARY')
275  this%idxbudaux = ip
276  this%idxbudssm(ip) = 0
277  case default
278  !
279  ! -- Set idxbudssm equal to a column index for where the temperatures
280  ! are stored in the tempbud(nbudssm, ncv) array
281  this%idxbudssm(ip) = icount
282  icount = icount + 1
283  end select
284  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
285  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
286  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
287  end do
288  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
Here is the call graph for this function:

◆ lke_allocate_arrays()

subroutine gwelkemodule::lke_allocate_arrays ( class(gwelketype), intent(inout)  this)

Definition at line 774 of file gwe-lke.f90.

775  ! -- modules
777  ! -- dummy
778  class(GweLkeType), intent(inout) :: this
779  !
780  ! -- alias into the input context's permanent, feature-indexed arrays
781  ! (allocated and DZERO-initialized by the input context)
782  call mem_setptr(this%temprain, 'RAINFALL', this%input_mempath)
783  call mem_setptr(this%tempevap, 'EVAPORATION', this%input_mempath)
784  call mem_setptr(this%temproff, 'RUNOFF', this%input_mempath)
785  call mem_setptr(this%tempiflw, 'EXT_INFLOW', this%input_mempath)
786  !
787  ! -- Call standard TspAptType allocate arrays
788  call this%TspAptType%apt_allocate_arrays()
789  !

◆ lke_bd_obs()

subroutine gwelkemodule::lke_bd_obs ( class(gwelketype), intent(inout)  this,
character(len=*), intent(in)  obstypeid,
integer(i4b), intent(in)  jj,
real(dp), intent(inout)  v,
logical, intent(inout)  found 
)

Definition at line 1116 of file gwe-lke.f90.

1117  ! -- dummy
1118  class(GweLkeType), intent(inout) :: this
1119  character(len=*), intent(in) :: obstypeid
1120  real(DP), intent(inout) :: v
1121  integer(I4B), intent(in) :: jj
1122  logical, intent(inout) :: found
1123  ! -- local
1124  integer(I4B) :: n1, n2
1125  !
1126  found = .true.
1127  select case (obstypeid)
1128  case ('RAINFALL')
1129  if (this%iboundpak(jj) /= 0) then
1130  call this%lke_rain_term(jj, n1, n2, v)
1131  end if
1132  case ('EVAPORATION')
1133  if (this%iboundpak(jj) /= 0) then
1134  call this%lke_evap_term(jj, n1, n2, v)
1135  end if
1136  case ('RUNOFF')
1137  if (this%iboundpak(jj) /= 0) then
1138  call this%lke_roff_term(jj, n1, n2, v)
1139  end if
1140  case ('EXT-INFLOW')
1141  if (this%iboundpak(jj) /= 0) then
1142  call this%lke_iflw_term(jj, n1, n2, v)
1143  end if
1144  case ('WITHDRAWAL')
1145  if (this%iboundpak(jj) /= 0) then
1146  call this%lke_wdrl_term(jj, n1, n2, v)
1147  end if
1148  case ('EXT-OUTFLOW')
1149  if (this%iboundpak(jj) /= 0) then
1150  call this%lke_outf_term(jj, n1, n2, v)
1151  end if
1152  case default
1153  found = .false.
1154  end select

◆ lke_checkin_deprecated_names()

subroutine gwelkemodule::lke_checkin_deprecated_names ( class(gwelketype), intent(inout)  this)

Definition at line 794 of file gwe-lke.f90.

795  ! -- modules
797  ! -- dummy
798  class(GweLkeType), intent(inout) :: this
799  ! -- code
800  !
801  ! -- names common to all advanced transport packages
802  call this%TspAptType%apt_checkin_deprecated_names()
803  !
804  call mem_alias_deprecated(this%temprain, 'TEMPRAIN', this%memoryPath, &
805  'RAINFALL', this%input_mempath, '6.8.2')
806  call mem_alias_deprecated(this%tempevap, 'TEMPEVAP', this%memoryPath, &
807  'EVAPORATION', this%input_mempath, '6.8.2')
808  call mem_alias_deprecated(this%temproff, 'TEMPROFF', this%memoryPath, &
809  'RUNOFF', this%input_mempath, '6.8.2')
810  call mem_alias_deprecated(this%tempiflw, 'TEMPIFLW', this%memoryPath, &
811  'EXT_INFLOW', this%input_mempath, '6.8.2')
Previous variable names checked in as deprecated aliases.
Definition: MemoryAlias.f90:7

◆ lke_create()

subroutine, public gwelkemodule::lke_create ( class(bndtype), pointer  packobj,
integer(i4b), intent(in)  id,
integer(i4b), intent(in)  ibcnum,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  namemodel,
character(len=*), intent(in)  pakname,
character(len=*), intent(in)  mempath,
type(tspfmitype), pointer  fmi,
real(dp), intent(in), pointer  eqnsclfac,
type(gweinputdatatype), intent(in), target  gwecommon,
character(len=*), intent(in)  dvt,
character(len=*), intent(in)  dvu,
character(len=*), intent(in)  dvua 
)
Parameters
[in]mempathinput memory path
[in]eqnsclfacgoverning equation scale factor
[in]gwecommonshared data container for use by multiple GWE packages
[in]dvtFor GWE, set to "TEMPERATURE" in TspAptType
[in]dvuFor GWE, set to "energy" in TspAptType
[in]dvuaFor GWE, set to "E" in TspAptType

Definition at line 110 of file gwe-lke.f90.

112  ! -- dummy
113  class(BndType), pointer :: packobj
114  integer(I4B), intent(in) :: id
115  integer(I4B), intent(in) :: ibcnum
116  integer(I4B), intent(in) :: inunit
117  integer(I4B), intent(in) :: iout
118  character(len=*), intent(in) :: namemodel
119  character(len=*), intent(in) :: pakname
120  character(len=*), intent(in) :: mempath !< input memory path
121  type(TspFmiType), pointer :: fmi
122  real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
123  type(GweInputDataType), intent(in), target :: gwecommon !< shared data container for use by multiple GWE packages
124  character(len=*), intent(in) :: dvt !< For GWE, set to "TEMPERATURE" in TspAptType
125  character(len=*), intent(in) :: dvu !< For GWE, set to "energy" in TspAptType
126  character(len=*), intent(in) :: dvua !< For GWE, set to "E" in TspAptType
127  ! -- local
128  type(GweLkeType), pointer :: lkeobj
129  !
130  ! -- Allocate the object and assign values to object variables
131  allocate (lkeobj)
132  packobj => lkeobj
133  !
134  ! -- Create name and memory path
135  call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
136  packobj%text = text
137  !
138  ! -- Allocate scalars
139  call lkeobj%allocate_scalars()
140  !
141  ! -- Initialize package
142  call packobj%pack_initialize()
143  !
144  packobj%inunit = inunit
145  packobj%iout = iout
146  packobj%id = id
147  packobj%ibcnum = ibcnum
148  packobj%ncolbnd = 1
149  packobj%iscloc = 1
150  packobj%isadvpak = 1
151  !
152  ! -- Store pointer to flow model interface. When the GwfGwe exchange is
153  ! created, it sets fmi%bndlist so that the GWE model has access to all
154  ! the flow packages
155  lkeobj%fmi => fmi
156  !
157  ! -- Store pointer to governing equation scale factor
158  lkeobj%eqnsclfac => eqnsclfac
159  !
160  ! -- Store pointer to shared data module for accessing cpw, rhow
161  ! for the budget calculations, and for accessing the latent heat of
162  ! vaporization for evaporative cooling.
163  lkeobj%gwecommon => gwecommon
164  !
165  ! -- Set labels that will be used in generalized APT class
166  lkeobj%depvartype = dvt
167  lkeobj%depvarunit = dvu
168  lkeobj%depvarunitabbrev = dvua
Here is the caller graph for this function:

◆ lke_da()

subroutine gwelkemodule::lke_da ( class(gwelketype)  this)

Definition at line 816 of file gwe-lke.f90.

817  ! -- modules
819  ! -- dummy
820  class(GweLkeType) :: this
821  !
822  ! -- Deallocate scalars
823  call mem_deallocate(this%idxbudrain)
824  call mem_deallocate(this%idxbudevap)
825  call mem_deallocate(this%idxbudroff)
826  call mem_deallocate(this%idxbudiflw)
827  call mem_deallocate(this%idxbudwdrl)
828  call mem_deallocate(this%idxbudoutf)
829  call mem_deallocate(this%idxbudlbcd)
830  !
831  ! -- input-context-owned aliases, not package-allocated
832  nullify (this%temprain)
833  nullify (this%tempevap)
834  nullify (this%temproff)
835  nullify (this%tempiflw)
836  !
837  ! -- Deallocate arrays
838  call mem_deallocate(this%ktf)
839  call mem_deallocate(this%rfeatthk)
840  !
841  ! -- Deallocate scalars in TspAptType
842  call this%TspAptType%bnd_da()

◆ lke_df_obs()

subroutine gwelkemodule::lke_df_obs ( class(gwelketype)  this)

Store the observation type supported by the APT package and override BndTypebnd_df_obs

Definition at line 1010 of file gwe-lke.f90.

1011  ! -- dummy
1012  class(GweLkeType) :: this
1013  ! -- local
1014  integer(I4B) :: indx
1015  !
1016  ! -- Store obs type and assign procedure pointer
1017  ! for temperature observation type.
1018  call this%obs%StoreObsType('temperature', .false., indx)
1019  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1020  !
1021  ! -- Store obs type and assign procedure pointer
1022  ! for flow between features, such as lake to lake.
1023  call this%obs%StoreObsType('flow-ja-face', .true., indx)
1024  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
1025  !
1026  ! -- Store obs type and assign procedure pointer
1027  ! for from-mvr observation type.
1028  call this%obs%StoreObsType('from-mvr', .true., indx)
1029  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1030  !
1031  ! -- Store obs type and assign procedure pointer
1032  ! for to-mvr observation type.
1033  call this%obs%StoreObsType('to-mvr', .true., indx)
1034  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1035  !
1036  ! -- Store obs type and assign procedure pointer
1037  ! for storage observation type.
1038  call this%obs%StoreObsType('storage', .true., indx)
1039  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1040  !
1041  ! -- Store obs type and assign procedure pointer
1042  ! for constant observation type.
1043  call this%obs%StoreObsType('constant', .true., indx)
1044  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1045  !
1046  ! -- Store obs type and assign procedure pointer
1047  ! for observation type: lke
1048  call this%obs%StoreObsType('lke', .true., indx)
1049  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1050  !
1051  ! -- Store obs type and assign procedure pointer
1052  ! for rainfall observation type.
1053  call this%obs%StoreObsType('rainfall', .true., indx)
1054  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1055  !
1056  ! -- Store obs type and assign procedure pointer
1057  ! for evaporation observation type.
1058  call this%obs%StoreObsType('evaporation', .true., indx)
1059  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1060  !
1061  ! -- Store obs type and assign procedure pointer
1062  ! for runoff observation type.
1063  call this%obs%StoreObsType('runoff', .true., indx)
1064  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1065  !
1066  ! -- Store obs type and assign procedure pointer
1067  ! for inflow observation type.
1068  call this%obs%StoreObsType('ext-inflow', .true., indx)
1069  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1070  !
1071  ! -- Store obs type and assign procedure pointer
1072  ! for withdrawal observation type.
1073  call this%obs%StoreObsType('withdrawal', .true., indx)
1074  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1075  !
1076  ! -- Store obs type and assign procedure pointer
1077  ! for ext-outflow observation type.
1078  call this%obs%StoreObsType('ext-outflow', .true., indx)
1079  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
Here is the call graph for this function:

◆ lke_evap_term()

subroutine gwelkemodule::lke_evap_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 872 of file gwe-lke.f90.

874  ! -- dummy
875  class(GweLkeType) :: this
876  integer(I4B), intent(in) :: ientry
877  integer(I4B), intent(inout) :: n1
878  integer(I4B), intent(inout) :: n2
879  real(DP), intent(inout), optional :: rrate
880  real(DP), intent(inout), optional :: rhsval
881  real(DP), intent(inout), optional :: hcofval
882  ! -- local
883  real(DP) :: qbnd
884  real(DP) :: heatlat
885  !
886  n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
887  n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
888  ! -- Note that qbnd is negative for evap
889  qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
890  heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
891  if (present(rrate)) rrate = qbnd * heatlat
892  if (present(rhsval)) rhsval = -rrate
893  if (present(hcofval)) hcofval = dzero

◆ lke_fc_expanded()

subroutine gwelkemodule::lke_fc_expanded ( class(gwelketype)  this,
real(dp), dimension(:), intent(inout)  rhs,
integer(i4b), dimension(:), intent(in)  ia,
integer(i4b), dimension(:), intent(in)  idxglo,
class(matrixbasetype), pointer  matrix_sln 
)

This will be called from TspAptTypeapt_fc_expanded() in order to add matrix terms specifically for LKE

Definition at line 321 of file gwe-lke.f90.

322  ! -- dummy
323  class(GweLkeType) :: this
324  real(DP), dimension(:), intent(inout) :: rhs
325  integer(I4B), dimension(:), intent(in) :: ia
326  integer(I4B), dimension(:), intent(in) :: idxglo
327  class(MatrixBaseType), pointer :: matrix_sln
328  ! -- local
329  integer(I4B) :: j, n, n1, n2
330  integer(I4B) :: iloc
331  integer(I4B) :: iposd, iposoffd
332  integer(I4B) :: ipossymd, ipossymoffd
333  integer(I4B) :: auxpos
334  real(DP) :: rrate
335  real(DP) :: rhsval
336  real(DP) :: hcofval
337  real(DP) :: ctherm !< thermal conductance
338  real(DP) :: wa !< wetted area
339  real(DP) :: ktf !< thermal conductivity of streambed material
340  real(DP) :: s !< thickness of conductive streambed material
341  !
342  ! -- Add rainfall contribution
343  if (this%idxbudrain /= 0) then
344  do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
345  call this%lke_rain_term(j, n1, n2, rrate, rhsval, hcofval)
346  iloc = this%idxlocnode(n1)
347  iposd = this%idxpakdiag(n1)
348  call matrix_sln%add_value_pos(iposd, hcofval)
349  rhs(iloc) = rhs(iloc) + rhsval
350  end do
351  end if
352  !
353  ! -- Add evaporation contribution
354  if (this%idxbudevap /= 0) then
355  do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
356  call this%lke_evap_term(j, n1, n2, rrate, rhsval, hcofval)
357  iloc = this%idxlocnode(n1)
358  iposd = this%idxpakdiag(n1)
359  call matrix_sln%add_value_pos(iposd, hcofval)
360  rhs(iloc) = rhs(iloc) + rhsval
361  end do
362  end if
363  !
364  ! -- Add runoff contribution
365  if (this%idxbudroff /= 0) then
366  do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
367  call this%lke_roff_term(j, n1, n2, rrate, rhsval, hcofval)
368  iloc = this%idxlocnode(n1)
369  iposd = this%idxpakdiag(n1)
370  call matrix_sln%add_value_pos(iposd, hcofval)
371  rhs(iloc) = rhs(iloc) + rhsval
372  end do
373  end if
374  !
375  ! -- Add inflow contribution
376  if (this%idxbudiflw /= 0) then
377  do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
378  call this%lke_iflw_term(j, n1, n2, rrate, rhsval, hcofval)
379  iloc = this%idxlocnode(n1)
380  iposd = this%idxpakdiag(n1)
381  call matrix_sln%add_value_pos(iposd, hcofval)
382  rhs(iloc) = rhs(iloc) + rhsval
383  end do
384  end if
385  !
386  ! -- Add withdrawal contribution
387  if (this%idxbudwdrl /= 0) then
388  do j = 1, this%flowbudptr%budterm(this%idxbudwdrl)%nlist
389  call this%lke_wdrl_term(j, n1, n2, rrate, rhsval, hcofval)
390  iloc = this%idxlocnode(n1)
391  iposd = this%idxpakdiag(n1)
392  call matrix_sln%add_value_pos(iposd, hcofval)
393  rhs(iloc) = rhs(iloc) + rhsval
394  end do
395  end if
396  !
397  ! -- Add outflow contribution
398  if (this%idxbudoutf /= 0) then
399  do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
400  call this%lke_outf_term(j, n1, n2, rrate, rhsval, hcofval)
401  iloc = this%idxlocnode(n1)
402  iposd = this%idxpakdiag(n1)
403  call matrix_sln%add_value_pos(iposd, hcofval)
404  rhs(iloc) = rhs(iloc) + rhsval
405  end do
406  end if
407  !
408  ! -- Add lakebed conduction contribution
409  do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
410  !
411  ! -- Set n to feature number and process if active feature
412  n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
413  if (this%iboundpak(n) /= 0) then
414  !
415  ! -- Set acoef and rhs to negative so they are relative to sfe and not gwe
416  auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
417  wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
418  ktf = this%ktf(n)
419  s = this%rfeatthk(n)
420  ctherm = ktf * wa / s
421  !
422  ! -- Add to sfe row
423  iposd = this%idxdglo(j)
424  iposoffd = this%idxoffdglo(j)
425  call matrix_sln%add_value_pos(iposd, -ctherm) ! kluge note: make sure the signs on ctherm are correct here and below
426  call matrix_sln%add_value_pos(iposoffd, ctherm)
427  !
428  ! -- Add to gwe row for sfe connection
429  ipossymd = this%idxsymdglo(j)
430  ipossymoffd = this%idxsymoffdglo(j)
431  call matrix_sln%add_value_pos(ipossymd, -ctherm)
432  call matrix_sln%add_value_pos(ipossymoffd, ctherm)
433  end if
434  end do

◆ lke_fill_budobj()

subroutine gwelkemodule::lke_fill_budobj ( class(gwelketype)  this,
integer(i4b), intent(inout)  idx,
real(dp), dimension(:), intent(in)  x,
real(dp), dimension(:), intent(inout), contiguous  flowja,
real(dp), intent(inout)  ccratin,
real(dp), intent(inout)  ccratout 
)

Definition at line 634 of file gwe-lke.f90.

635  ! -- dummy
636  class(GweLkeType) :: this
637  integer(I4B), intent(inout) :: idx
638  real(DP), dimension(:), intent(in) :: x
639  real(DP), dimension(:), contiguous, intent(inout) :: flowja
640  real(DP), intent(inout) :: ccratin
641  real(DP), intent(inout) :: ccratout
642  ! -- local
643  integer(I4B) :: j, n1, n2
644  integer(I4B) :: nlist
645  integer(I4B) :: igwfnode
646  integer(I4B) :: idiag
647  integer(I4B) :: auxpos
648  real(DP) :: q
649  real(DP) :: ctherm !< thermal conductance
650  real(DP) :: wa !< wetted area
651  real(DP) :: ktf !< thermal conductivity of streambed material
652  real(DP) :: s !< thickness of conductive streambed materia
653  !
654  ! -- Rain
655  idx = idx + 1
656  nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
657  call this%budobj%budterm(idx)%reset(nlist)
658  do j = 1, nlist
659  call this%lke_rain_term(j, n1, n2, q)
660  call this%budobj%budterm(idx)%update_term(n1, n2, q)
661  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
662  end do
663  !
664  ! -- Evaporation
665  idx = idx + 1
666  nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
667  call this%budobj%budterm(idx)%reset(nlist)
668  do j = 1, nlist
669  call this%lke_evap_term(j, n1, n2, q)
670  call this%budobj%budterm(idx)%update_term(n1, n2, q)
671  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
672  end do
673  !
674  ! -- Runoff
675  idx = idx + 1
676  nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
677  call this%budobj%budterm(idx)%reset(nlist)
678  do j = 1, nlist
679  call this%lke_roff_term(j, n1, n2, q)
680  call this%budobj%budterm(idx)%update_term(n1, n2, q)
681  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
682  end do
683  !
684  ! -- Est-Inflow
685  idx = idx + 1
686  nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
687  call this%budobj%budterm(idx)%reset(nlist)
688  do j = 1, nlist
689  call this%lke_iflw_term(j, n1, n2, q)
690  call this%budobj%budterm(idx)%update_term(n1, n2, q)
691  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
692  end do
693  !
694  ! -- Withdrawal
695  idx = idx + 1
696  nlist = this%flowbudptr%budterm(this%idxbudwdrl)%nlist
697  call this%budobj%budterm(idx)%reset(nlist)
698  do j = 1, nlist
699  call this%lke_wdrl_term(j, n1, n2, q)
700  call this%budobj%budterm(idx)%update_term(n1, n2, q)
701  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
702  end do
703  !
704  ! -- Ext-Outflow
705  idx = idx + 1
706  nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
707  call this%budobj%budterm(idx)%reset(nlist)
708  do j = 1, nlist
709  call this%lke_outf_term(j, n1, n2, q)
710  call this%budobj%budterm(idx)%update_term(n1, n2, q)
711  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
712  end do
713  !
714  ! -- Lakebed-Cond
715  idx = idx + 1
716  call this%budobj%budterm(idx)%reset(this%maxbound)
717  do j = 1, this%flowbudptr%budterm(this%idxbudlbcd)%nlist
718  q = dzero
719  n1 = this%flowbudptr%budterm(this%idxbudlbcd)%id1(j)
720  igwfnode = this%flowbudptr%budterm(this%idxbudlbcd)%id2(j)
721  if (this%iboundpak(n1) /= 0) then
722  auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux ! for now there is only 1 aux variable under 'GWF'
723  wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
724  ktf = this%ktf(n1)
725  s = this%rfeatthk(n1)
726  ctherm = ktf * wa / s
727  q = ctherm * (x(igwfnode) - this%xnewpak(n1))
728  end if
729  call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
730  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
731  if (this%iboundpak(n1) /= 0) then
732  ! -- Contribution to gwe cell budget
733  this%simvals(n1) = this%simvals(n1) - q
734  idiag = this%dis%con%ia(igwfnode)
735  flowja(idiag) = flowja(idiag) - q
736  end if
737  end do

◆ lke_get_nbudterms()

integer(i4b) function gwelkemodule::lke_get_nbudterms ( class(gwelketype)  this)

This overrides a function in the parent class.

Definition at line 500 of file gwe-lke.f90.

501  ! -- dummy
502  class(GweLkeType) :: this
503  ! -- Return
504  integer(I4B) :: nbudterms
505  !
506  ! -- Number of budget terms is 7
507  ! 1) rainfall
508  ! 2) evap
509  ! 3) runoff
510  ! 4) ext-inflow
511  ! 5) withdrawal
512  ! 6) ext-outflow
513  ! 7) lakebed-cond
514  !
515  nbudterms = 7

◆ lke_iflw_term()

subroutine gwelkemodule::lke_iflw_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Accounts for energy flowing into a lake from a connected stream, for example.

Definition at line 926 of file gwe-lke.f90.

928  ! -- dummy
929  class(GweLkeType) :: this
930  integer(I4B), intent(in) :: ientry
931  integer(I4B), intent(inout) :: n1
932  integer(I4B), intent(inout) :: n2
933  real(DP), intent(inout), optional :: rrate
934  real(DP), intent(inout), optional :: rhsval
935  real(DP), intent(inout), optional :: hcofval
936  ! -- local
937  real(DP) :: qbnd
938  real(DP) :: ctmp
939  !
940  n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
941  n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
942  qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
943  ctmp = this%tempiflw(n1)
944  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
945  if (present(rhsval)) rhsval = -rrate
946  if (present(hcofval)) hcofval = dzero

◆ lke_outf_term()

subroutine gwelkemodule::lke_outf_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Accounts for the energy leaving a lake, for example, energy exiting a lake via a flow into a draining stream channel.

Definition at line 982 of file gwe-lke.f90.

984  ! -- dummy
985  class(GweLkeType) :: this
986  integer(I4B), intent(in) :: ientry
987  integer(I4B), intent(inout) :: n1
988  integer(I4B), intent(inout) :: n2
989  real(DP), intent(inout), optional :: rrate
990  real(DP), intent(inout), optional :: rhsval
991  real(DP), intent(inout), optional :: hcofval
992  ! -- local
993  real(DP) :: qbnd
994  real(DP) :: ctmp
995  !
996  n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
997  n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
998  qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
999  ctmp = this%xnewpak(n1)
1000  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1001  if (present(rhsval)) rhsval = dzero
1002  if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

◆ lke_rain_term()

subroutine gwelkemodule::lke_rain_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 847 of file gwe-lke.f90.

849  ! -- dummy
850  class(GweLkeType) :: this
851  integer(I4B), intent(in) :: ientry
852  integer(I4B), intent(inout) :: n1
853  integer(I4B), intent(inout) :: n2
854  real(DP), intent(inout), optional :: rrate
855  real(DP), intent(inout), optional :: rhsval
856  real(DP), intent(inout), optional :: hcofval
857  ! -- local
858  real(DP) :: qbnd
859  real(DP) :: ctmp
860  !
861  n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry)
862  n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
863  qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
864  ctmp = this%temprain(n1)
865  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
866  if (present(rhsval)) rhsval = -rrate
867  if (present(hcofval)) hcofval = dzero

◆ lke_read_cvs()

subroutine gwelkemodule::lke_read_cvs ( class(gwelketype), intent(inout)  this)

Definition at line 1159 of file gwe-lke.f90.

1162  class(GweLkeType), intent(inout) :: this
1163  integer(I4B) :: n, ifeat
1164  real(DP), dimension(:), pointer, contiguous :: ktf_ptr => null()
1165  real(DP), dimension(:), pointer, contiguous :: rbthcnd_ptr => null()
1166  !
1167  ! -- base class reads STRT, AUX, BOUNDNAME and sets pkg_ifno
1168  call this%TspAptType%apt_source_cvs()
1169  !
1170  ! -- allocate GWE-specific arrays
1171  call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath)
1172  call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath)
1173  !
1174  ! -- populate from PACKAGEDATA
1175  call mem_setptr(ktf_ptr, 'KTF', this%input_mempath)
1176  call mem_setptr(rbthcnd_ptr, 'RBTHCND', this%input_mempath)
1177  do n = 1, size(this%pkg_ifno)
1178  ifeat = this%pkg_ifno(n)
1179  if (ifeat < 1 .or. ifeat > this%ncv) cycle
1180  this%ktf(ifeat) = ktf_ptr(n)
1181  this%rfeatthk(ifeat) = rbthcnd_ptr(n)
1182  if (this%rfeatthk(ifeat) <= dzero) then
1183  write (errmsg, '(4x,a)') &
1184  '****ERROR. Specified thickness used for thermal '// &
1185  'conduction MUST BE > 0 else divide by zero error occurs'
1186  call store_error(errmsg)
1187  end if
1188  end do
1189  if (count_errors() > 0) then
1190  call store_error_filename(this%input_fname)
1191  end if
1192  call memorystore_release('KTF', this%input_mempath)
1193  call memorystore_release('RBTHCND', this%input_mempath)
subroutine, public memorystore_release(varname, memory_path)
Release a single variable from the memory store.
Here is the call graph for this function:

◆ lke_roff_term()

subroutine gwelkemodule::lke_roff_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 898 of file gwe-lke.f90.

900  ! -- dummy
901  class(GweLkeType) :: this
902  integer(I4B), intent(in) :: ientry
903  integer(I4B), intent(inout) :: n1
904  integer(I4B), intent(inout) :: n2
905  real(DP), intent(inout), optional :: rrate
906  real(DP), intent(inout), optional :: rhsval
907  real(DP), intent(inout), optional :: hcofval
908  ! -- local
909  real(DP) :: qbnd
910  real(DP) :: ctmp
911  !
912  n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
913  n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
914  qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
915  ctmp = this%temproff(n1)
916  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
917  if (present(rhsval)) rhsval = -rrate
918  if (present(hcofval)) hcofval = dzero

◆ lke_rp_obs()

subroutine gwelkemodule::lke_rp_obs ( class(gwelketype), intent(inout)  this,
type(observetype), intent(inout)  obsrv,
logical, intent(inout)  found 
)

Method to process specific observations for this package.

Parameters
[in,out]thispackage class
[in,out]obsrvobservation object
[in,out]foundindicate whether observation was found

Definition at line 1086 of file gwe-lke.f90.

1087  ! -- dummy
1088  class(GweLkeType), intent(inout) :: this !< package class
1089  type(ObserveType), intent(inout) :: obsrv !< observation object
1090  logical, intent(inout) :: found !< indicate whether observation was found
1091  !
1092  found = .true.
1093  select case (obsrv%ObsTypeId)
1094  case ('RAINFALL')
1095  call this%rp_obs_byfeature(obsrv)
1096  case ('EVAPORATION')
1097  call this%rp_obs_byfeature(obsrv)
1098  case ('RUNOFF')
1099  call this%rp_obs_byfeature(obsrv)
1100  case ('EXT-INFLOW')
1101  call this%rp_obs_byfeature(obsrv)
1102  case ('WITHDRAWAL')
1103  call this%rp_obs_byfeature(obsrv)
1104  case ('EXT-OUTFLOW')
1105  call this%rp_obs_byfeature(obsrv)
1106  case ('TO-MVR')
1107  call this%rp_obs_budterm(obsrv, &
1108  this%flowbudptr%budterm(this%idxbudtmvr))
1109  case default
1110  found = .false.
1111  end select

◆ lke_setting_value()

real(dp) function gwelkemodule::lke_setting_value ( class(gwelketype), intent(inout)  this,
integer(i4b), intent(in)  itemno,
character(len=*), intent(in)  key 
)

Already resolved by the input context; this only supplies it for the shared apt_rp table echo.

Definition at line 296 of file gwe-lke.f90.

297  ! -- dummy
298  class(GweLkeType), intent(inout) :: this
299  integer(I4B), intent(in) :: itemno
300  character(len=*), intent(in) :: key
301  real(DP) :: val
302  !
303  val = dzero
304  select case (trim(key))
305  case ('RAINFALL')
306  val = this%temprain(itemno)
307  case ('EVAPORATION')
308  val = this%tempevap(itemno)
309  case ('RUNOFF')
310  val = this%temproff(itemno)
311  case ('EXT-INFLOW')
312  val = this%tempiflw(itemno)
313  end select

◆ lke_setup_budobj()

subroutine gwelkemodule::lke_setup_budobj ( class(gwelketype)  this,
integer(i4b), intent(inout)  idx 
)

Definition at line 520 of file gwe-lke.f90.

521  ! -- modules
522  use constantsmodule, only: lenbudtxt
523  ! -- dummy
524  class(GweLkeType) :: this
525  integer(I4B), intent(inout) :: idx
526  ! -- local
527  integer(I4B) :: n, n1, n2
528  integer(I4B) :: maxlist, naux
529  real(DP) :: q
530  character(len=LENBUDTXT) :: text
531  !
532  ! -- Addition of heat associated with rainfall directly on the lake surface
533  text = ' RAINFALL'
534  idx = idx + 1
535  maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
536  naux = 0
537  call this%budobj%budterm(idx)%initialize(text, &
538  this%name_model, &
539  this%packName, &
540  this%name_model, &
541  this%packName, &
542  maxlist, .false., .false., &
543  naux)
544  !
545  ! -- Evaporative cooling from lake surface
546  text = ' EVAPORATION'
547  idx = idx + 1
548  maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
549  naux = 0
550  call this%budobj%budterm(idx)%initialize(text, &
551  this%name_model, &
552  this%packName, &
553  this%name_model, &
554  this%packName, &
555  maxlist, .false., .false., &
556  naux)
557  !
558  ! -- Addition of heat associated with runoff that flows to the lake
559  text = ' RUNOFF'
560  idx = idx + 1
561  maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
562  naux = 0
563  call this%budobj%budterm(idx)%initialize(text, &
564  this%name_model, &
565  this%packName, &
566  this%name_model, &
567  this%packName, &
568  maxlist, .false., .false., &
569  naux)
570  !
571  ! -- Addition of heat associated with user-specified inflow to the lake
572  text = ' EXT-INFLOW'
573  idx = idx + 1
574  maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
575  naux = 0
576  call this%budobj%budterm(idx)%initialize(text, &
577  this%name_model, &
578  this%packName, &
579  this%name_model, &
580  this%packName, &
581  maxlist, .false., .false., &
582  naux)
583  !
584  ! -- Removal of heat associated with user-specified withdrawal from lake
585  text = ' WITHDRAWAL'
586  idx = idx + 1
587  maxlist = this%flowbudptr%budterm(this%idxbudwdrl)%maxlist
588  naux = 0
589  call this%budobj%budterm(idx)%initialize(text, &
590  this%name_model, &
591  this%packName, &
592  this%name_model, &
593  this%packName, &
594  maxlist, .false., .false., &
595  naux)
596  !
597  ! -- Removal of heat associated with outflow from lake that leaves
598  ! model domain
599  text = ' EXT-OUTFLOW'
600  idx = idx + 1
601  maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
602  naux = 0
603  call this%budobj%budterm(idx)%initialize(text, &
604  this%name_model, &
605  this%packName, &
606  this%name_model, &
607  this%packName, &
608  maxlist, .false., .false., &
609  naux)
610  !
611  ! -- Conductive exchange of heat through the wetted lakebed
612  text = ' LAKEBED-COND'
613  idx = idx + 1
614  maxlist = this%flowbudptr%budterm(this%idxbudlbcd)%maxlist
615  naux = 0
616  call this%budobj%budterm(idx)%initialize(text, &
617  this%name_model, &
618  this%packName, &
619  this%name_model, &
620  this%packName, &
621  maxlist, .false., .false., &
622  naux)
623  call this%budobj%budterm(idx)%reset(maxlist)
624  q = dzero
625  do n = 1, maxlist
626  n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
627  n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
628  call this%budobj%budterm(idx)%update_term(n1, n2, q)
629  end do
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37

◆ lke_solve()

subroutine gwelkemodule::lke_solve ( class(gwelketype)  this)

Definition at line 439 of file gwe-lke.f90.

440  ! -- dummy
441  class(GweLkeType) :: this
442  ! -- local
443  integer(I4B) :: j
444  integer(I4B) :: n1, n2
445  real(DP) :: rrate
446  !
447  ! -- Add rainfall contribution
448  if (this%idxbudrain /= 0) then
449  do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
450  call this%lke_rain_term(j, n1, n2, rrate)
451  this%dbuff(n1) = this%dbuff(n1) + rrate
452  end do
453  end if
454  !
455  ! -- Add evaporation contribution
456  if (this%idxbudevap /= 0) then
457  do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
458  call this%lke_evap_term(j, n1, n2, rrate)
459  this%dbuff(n1) = this%dbuff(n1) + rrate
460  end do
461  end if
462  !
463  ! -- Add runoff contribution
464  if (this%idxbudroff /= 0) then
465  do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
466  call this%lke_roff_term(j, n1, n2, rrate)
467  this%dbuff(n1) = this%dbuff(n1) + rrate
468  end do
469  end if
470  !
471  ! -- Add inflow contribution
472  if (this%idxbudiflw /= 0) then
473  do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
474  call this%lke_iflw_term(j, n1, n2, rrate)
475  this%dbuff(n1) = this%dbuff(n1) + rrate
476  end do
477  end if
478  !
479  ! -- Add withdrawal contribution
480  if (this%idxbudwdrl /= 0) then
481  do j = 1, this%flowbudptr%budterm(this%idxbudwdrl)%nlist
482  call this%lke_wdrl_term(j, n1, n2, rrate)
483  this%dbuff(n1) = this%dbuff(n1) + rrate
484  end do
485  end if
486  !
487  ! -- Add outflow contribution
488  if (this%idxbudoutf /= 0) then
489  do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
490  call this%lke_outf_term(j, n1, n2, rrate)
491  this%dbuff(n1) = this%dbuff(n1) + rrate
492  end do
493  end if

◆ lke_wdrl_term()

subroutine gwelkemodule::lke_wdrl_term ( class(gwelketype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Accounts for energy associated with a withdrawal of water from a lake or group of lakes.

Definition at line 954 of file gwe-lke.f90.

956  ! -- dummy
957  class(GweLkeType) :: this
958  integer(I4B), intent(in) :: ientry
959  integer(I4B), intent(inout) :: n1
960  integer(I4B), intent(inout) :: n2
961  real(DP), intent(inout), optional :: rrate
962  real(DP), intent(inout), optional :: rhsval
963  real(DP), intent(inout), optional :: hcofval
964  ! -- local
965  real(DP) :: qbnd
966  real(DP) :: ctmp
967  !
968  n1 = this%flowbudptr%budterm(this%idxbudwdrl)%id1(ientry)
969  n2 = this%flowbudptr%budterm(this%idxbudwdrl)%id2(ientry)
970  qbnd = this%flowbudptr%budterm(this%idxbudwdrl)%flow(ientry)
971  ctmp = this%xnewpak(n1)
972  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
973  if (present(rhsval)) rhsval = dzero
974  if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

Variable Documentation

◆ flowtype

character(len=*), parameter gwelkemodule::flowtype = 'LAK'

Definition at line 58 of file gwe-lke.f90.

58  character(len=*), parameter :: flowtype = 'LAK'

◆ ftype

character(len=*), parameter gwelkemodule::ftype = 'LKE'

Definition at line 57 of file gwe-lke.f90.

57  character(len=*), parameter :: ftype = 'LKE'

◆ text

character(len=16) gwelkemodule::text = ' LKE'

Definition at line 59 of file gwe-lke.f90.

59  character(len=16) :: text = ' LKE'