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_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 742 of file gwe-lke.f90.

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

◆ find_lke_package()

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

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

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

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

◆ 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 1093 of file gwe-lke.f90.

1094  ! -- dummy
1095  class(GweLkeType), intent(inout) :: this
1096  character(len=*), intent(in) :: obstypeid
1097  real(DP), intent(inout) :: v
1098  integer(I4B), intent(in) :: jj
1099  logical, intent(inout) :: found
1100  ! -- local
1101  integer(I4B) :: n1, n2
1102  !
1103  found = .true.
1104  select case (obstypeid)
1105  case ('RAINFALL')
1106  if (this%iboundpak(jj) /= 0) then
1107  call this%lke_rain_term(jj, n1, n2, v)
1108  end if
1109  case ('EVAPORATION')
1110  if (this%iboundpak(jj) /= 0) then
1111  call this%lke_evap_term(jj, n1, n2, v)
1112  end if
1113  case ('RUNOFF')
1114  if (this%iboundpak(jj) /= 0) then
1115  call this%lke_roff_term(jj, n1, n2, v)
1116  end if
1117  case ('EXT-INFLOW')
1118  if (this%iboundpak(jj) /= 0) then
1119  call this%lke_iflw_term(jj, n1, n2, v)
1120  end if
1121  case ('WITHDRAWAL')
1122  if (this%iboundpak(jj) /= 0) then
1123  call this%lke_wdrl_term(jj, n1, n2, v)
1124  end if
1125  case ('EXT-OUTFLOW')
1126  if (this%iboundpak(jj) /= 0) then
1127  call this%lke_outf_term(jj, n1, n2, v)
1128  end if
1129  case default
1130  found = .false.
1131  end select

◆ 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 109 of file gwe-lke.f90.

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

◆ lke_da()

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

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

794  ! -- modules
796  ! -- dummy
797  class(GweLkeType) :: this
798  !
799  ! -- Deallocate scalars
800  call mem_deallocate(this%idxbudrain)
801  call mem_deallocate(this%idxbudevap)
802  call mem_deallocate(this%idxbudroff)
803  call mem_deallocate(this%idxbudiflw)
804  call mem_deallocate(this%idxbudwdrl)
805  call mem_deallocate(this%idxbudoutf)
806  call mem_deallocate(this%idxbudlbcd)
807  !
808  ! -- input-context-owned aliases, not package-allocated
809  nullify (this%temprain)
810  nullify (this%tempevap)
811  nullify (this%temproff)
812  nullify (this%tempiflw)
813  !
814  ! -- Deallocate arrays
815  call mem_deallocate(this%ktf)
816  call mem_deallocate(this%rfeatthk)
817  !
818  ! -- Deallocate scalars in TspAptType
819  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 987 of file gwe-lke.f90.

988  ! -- dummy
989  class(GweLkeType) :: this
990  ! -- local
991  integer(I4B) :: indx
992  !
993  ! -- Store obs type and assign procedure pointer
994  ! for temperature observation type.
995  call this%obs%StoreObsType('temperature', .false., indx)
996  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
997  !
998  ! -- Store obs type and assign procedure pointer
999  ! for flow between features, such as lake to lake.
1000  call this%obs%StoreObsType('flow-ja-face', .true., indx)
1001  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
1002  !
1003  ! -- Store obs type and assign procedure pointer
1004  ! for from-mvr observation type.
1005  call this%obs%StoreObsType('from-mvr', .true., indx)
1006  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1007  !
1008  ! -- Store obs type and assign procedure pointer
1009  ! for to-mvr observation type.
1010  call this%obs%StoreObsType('to-mvr', .true., indx)
1011  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1012  !
1013  ! -- Store obs type and assign procedure pointer
1014  ! for storage observation type.
1015  call this%obs%StoreObsType('storage', .true., indx)
1016  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1017  !
1018  ! -- Store obs type and assign procedure pointer
1019  ! for constant observation type.
1020  call this%obs%StoreObsType('constant', .true., indx)
1021  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1022  !
1023  ! -- Store obs type and assign procedure pointer
1024  ! for observation type: lke
1025  call this%obs%StoreObsType('lke', .true., indx)
1026  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1027  !
1028  ! -- Store obs type and assign procedure pointer
1029  ! for rainfall observation type.
1030  call this%obs%StoreObsType('rainfall', .true., indx)
1031  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1032  !
1033  ! -- Store obs type and assign procedure pointer
1034  ! for evaporation observation type.
1035  call this%obs%StoreObsType('evaporation', .true., indx)
1036  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1037  !
1038  ! -- Store obs type and assign procedure pointer
1039  ! for runoff observation type.
1040  call this%obs%StoreObsType('runoff', .true., indx)
1041  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1042  !
1043  ! -- Store obs type and assign procedure pointer
1044  ! for inflow observation type.
1045  call this%obs%StoreObsType('ext-inflow', .true., indx)
1046  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1047  !
1048  ! -- Store obs type and assign procedure pointer
1049  ! for withdrawal observation type.
1050  call this%obs%StoreObsType('withdrawal', .true., indx)
1051  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
1052  !
1053  ! -- Store obs type and assign procedure pointer
1054  ! for ext-outflow observation type.
1055  call this%obs%StoreObsType('ext-outflow', .true., indx)
1056  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 849 of file gwe-lke.f90.

851  ! -- dummy
852  class(GweLkeType) :: this
853  integer(I4B), intent(in) :: ientry
854  integer(I4B), intent(inout) :: n1
855  integer(I4B), intent(inout) :: n2
856  real(DP), intent(inout), optional :: rrate
857  real(DP), intent(inout), optional :: rhsval
858  real(DP), intent(inout), optional :: hcofval
859  ! -- local
860  real(DP) :: qbnd
861  real(DP) :: heatlat
862  !
863  n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
864  n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
865  ! -- Note that qbnd is negative for evap
866  qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
867  heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
868  if (present(rrate)) rrate = qbnd * heatlat
869  if (present(rhsval)) rhsval = -rrate
870  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 320 of file gwe-lke.f90.

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

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

500  ! -- dummy
501  class(GweLkeType) :: this
502  ! -- Return
503  integer(I4B) :: nbudterms
504  !
505  ! -- Number of budget terms is 7
506  ! 1) rainfall
507  ! 2) evap
508  ! 3) runoff
509  ! 4) ext-inflow
510  ! 5) withdrawal
511  ! 6) ext-outflow
512  ! 7) lakebed-cond
513  !
514  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 903 of file gwe-lke.f90.

905  ! -- dummy
906  class(GweLkeType) :: this
907  integer(I4B), intent(in) :: ientry
908  integer(I4B), intent(inout) :: n1
909  integer(I4B), intent(inout) :: n2
910  real(DP), intent(inout), optional :: rrate
911  real(DP), intent(inout), optional :: rhsval
912  real(DP), intent(inout), optional :: hcofval
913  ! -- local
914  real(DP) :: qbnd
915  real(DP) :: ctmp
916  !
917  n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
918  n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
919  qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
920  ctmp = this%tempiflw(n1)
921  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
922  if (present(rhsval)) rhsval = -rrate
923  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 959 of file gwe-lke.f90.

961  ! -- dummy
962  class(GweLkeType) :: this
963  integer(I4B), intent(in) :: ientry
964  integer(I4B), intent(inout) :: n1
965  integer(I4B), intent(inout) :: n2
966  real(DP), intent(inout), optional :: rrate
967  real(DP), intent(inout), optional :: rhsval
968  real(DP), intent(inout), optional :: hcofval
969  ! -- local
970  real(DP) :: qbnd
971  real(DP) :: ctmp
972  !
973  n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
974  n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
975  qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
976  ctmp = this%xnewpak(n1)
977  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
978  if (present(rhsval)) rhsval = dzero
979  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 824 of file gwe-lke.f90.

826  ! -- dummy
827  class(GweLkeType) :: this
828  integer(I4B), intent(in) :: ientry
829  integer(I4B), intent(inout) :: n1
830  integer(I4B), intent(inout) :: n2
831  real(DP), intent(inout), optional :: rrate
832  real(DP), intent(inout), optional :: rhsval
833  real(DP), intent(inout), optional :: hcofval
834  ! -- local
835  real(DP) :: qbnd
836  real(DP) :: ctmp
837  !
838  n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry)
839  n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
840  qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
841  ctmp = this%temprain(n1)
842  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
843  if (present(rhsval)) rhsval = -rrate
844  if (present(hcofval)) hcofval = dzero

◆ lke_read_cvs()

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

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

1139  class(GweLkeType), intent(inout) :: this
1140  integer(I4B) :: n, ifeat
1141  real(DP), dimension(:), pointer, contiguous :: ktf_ptr => null()
1142  real(DP), dimension(:), pointer, contiguous :: rbthcnd_ptr => null()
1143  !
1144  ! -- base class reads STRT, AUX, BOUNDNAME and sets pkg_ifno
1145  call this%TspAptType%apt_source_cvs()
1146  !
1147  ! -- allocate GWE-specific arrays
1148  call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath)
1149  call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath)
1150  !
1151  ! -- populate from PACKAGEDATA
1152  call mem_setptr(ktf_ptr, 'KTF', this%input_mempath)
1153  call mem_setptr(rbthcnd_ptr, 'RBTHCND', this%input_mempath)
1154  do n = 1, size(this%pkg_ifno)
1155  ifeat = this%pkg_ifno(n)
1156  if (ifeat < 1 .or. ifeat > this%ncv) cycle
1157  this%ktf(ifeat) = ktf_ptr(n)
1158  this%rfeatthk(ifeat) = rbthcnd_ptr(n)
1159  if (this%rfeatthk(ifeat) <= dzero) then
1160  write (errmsg, '(4x,a)') &
1161  '****ERROR. Specified thickness used for thermal '// &
1162  'conduction MUST BE > 0 else divide by zero error occurs'
1163  call store_error(errmsg)
1164  end if
1165  end do
1166  if (count_errors() > 0) then
1167  call store_error_filename(this%input_fname)
1168  end if
1169  call memorystore_release('KTF', this%input_mempath)
1170  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 875 of file gwe-lke.f90.

877  ! -- dummy
878  class(GweLkeType) :: this
879  integer(I4B), intent(in) :: ientry
880  integer(I4B), intent(inout) :: n1
881  integer(I4B), intent(inout) :: n2
882  real(DP), intent(inout), optional :: rrate
883  real(DP), intent(inout), optional :: rhsval
884  real(DP), intent(inout), optional :: hcofval
885  ! -- local
886  real(DP) :: qbnd
887  real(DP) :: ctmp
888  !
889  n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
890  n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
891  qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
892  ctmp = this%temproff(n1)
893  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
894  if (present(rhsval)) rhsval = -rrate
895  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 1063 of file gwe-lke.f90.

1064  ! -- dummy
1065  class(GweLkeType), intent(inout) :: this !< package class
1066  type(ObserveType), intent(inout) :: obsrv !< observation object
1067  logical, intent(inout) :: found !< indicate whether observation was found
1068  !
1069  found = .true.
1070  select case (obsrv%ObsTypeId)
1071  case ('RAINFALL')
1072  call this%rp_obs_byfeature(obsrv)
1073  case ('EVAPORATION')
1074  call this%rp_obs_byfeature(obsrv)
1075  case ('RUNOFF')
1076  call this%rp_obs_byfeature(obsrv)
1077  case ('EXT-INFLOW')
1078  call this%rp_obs_byfeature(obsrv)
1079  case ('WITHDRAWAL')
1080  call this%rp_obs_byfeature(obsrv)
1081  case ('EXT-OUTFLOW')
1082  call this%rp_obs_byfeature(obsrv)
1083  case ('TO-MVR')
1084  call this%rp_obs_budterm(obsrv, &
1085  this%flowbudptr%budterm(this%idxbudtmvr))
1086  case default
1087  found = .false.
1088  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 295 of file gwe-lke.f90.

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

◆ lke_setup_budobj()

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

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

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

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

933  ! -- dummy
934  class(GweLkeType) :: this
935  integer(I4B), intent(in) :: ientry
936  integer(I4B), intent(inout) :: n1
937  integer(I4B), intent(inout) :: n2
938  real(DP), intent(inout), optional :: rrate
939  real(DP), intent(inout), optional :: rhsval
940  real(DP), intent(inout), optional :: hcofval
941  ! -- local
942  real(DP) :: qbnd
943  real(DP) :: ctmp
944  !
945  n1 = this%flowbudptr%budterm(this%idxbudwdrl)%id1(ientry)
946  n2 = this%flowbudptr%budterm(this%idxbudwdrl)%id2(ientry)
947  qbnd = this%flowbudptr%budterm(this%idxbudwdrl)%flow(ientry)
948  ctmp = this%xnewpak(n1)
949  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
950  if (present(rhsval)) rhsval = dzero
951  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'