MODFLOW 6  version 6.7.0.dev1
USGS Modular Hydrologic Model
gwe-est.f90
Go to the documentation of this file.
1 !> -- @ brief Energy Storage and Transfer (EST) Module
2 !!
3 !! The GweEstModule contains the GweEstType, which is related
4 !! to GwtEstModule; however, there are some important differences
5 !! owing to the fact that a sorbed phase is not considered.
6 !! Instead, a single temperature is simulated for each grid
7 !! cell and is representative of both the aqueous and solid
8 !! phases (i.e., instantaneous thermal equilibrium is
9 !! assumed). Also, "thermal bleeding" is accommodated, where
10 !! conductive processes can transport into, through, or
11 !! out of dry cells that are part of the active domain.
12 !<
14 
15  use kindmodule, only: dp, i4b
18  use simmodule, only: store_error, count_errors, &
22  use basedismodule, only: disbasetype
23  use tspfmimodule, only: tspfmitype
25 
26  implicit none
27  public :: gweesttype
28  public :: est_cr
29  !
30  integer(I4B), parameter :: nbditems = 3
31  character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt
32  data budtxt/' STORAGE-CELLBLK', ' DECAY-AQUEOUS', ' DECAY-SOLID'/
33 
34  !> @brief Enumerator that defines the decay options
35  !<
36  ENUM, BIND(C)
37  ENUMERATOR :: decay_off = 0 !< Decay (or production) of thermal energy inactive (default)
38  ENUMERATOR :: decay_zero_order = 2 !< Zeroth-order decay
39  ENUMERATOR :: decay_water = 1 !< Zeroth-order decay in water only
40  ENUMERATOR :: decay_solid = 2 !< Zeroth-order decay in solid only
41  ENUMERATOR :: decay_both = 3 !< Zeroth-order decay in water and solid
42  END ENUM
43 
44  !> @ brief Energy storage and transfer
45  !!
46  !! Data and methods for handling changes in temperature
47  !<
48  type, extends(numericalpackagetype) :: gweesttype
49  !
50  ! -- storage
51  real(dp), pointer :: cpw => null() !< heat capacity of water
52  real(dp), pointer :: rhow => null() !< density of water
53  real(dp), pointer :: latheatvap => null() !< latent heat of vaporization
54  real(dp), dimension(:), pointer, contiguous :: cps => null() !< heat capacity of solid
55  real(dp), dimension(:), pointer, contiguous :: rhos => null() !< density of solid
56  real(dp), dimension(:), pointer, contiguous :: porosity => null() !< porosity
57  real(dp), dimension(:), pointer, contiguous :: ratesto => null() !< rate of energy storage
58  !
59  ! -- decay
60  integer(I4B), pointer :: idcy => null() !< order of decay rate (0:none, 1:first, 2:zero (aqueous and/or solid))
61  integer(I4B), pointer :: idcysrc => null() !< decay source (or sink) (1: aqueous only, 2: solid only, 3: both phases
62  real(dp), dimension(:), pointer, contiguous :: decay_water => null() !< first or zero order decay rate (aqueous)
63  real(dp), dimension(:), pointer, contiguous :: decay_solid => null() !< first or zero order decay rate (solid)
64  real(dp), dimension(:), pointer, contiguous :: ratedcyw => null() !< rate of decay in aqueous phase
65  real(dp), dimension(:), pointer, contiguous :: ratedcys => null() !< rate of decay in solid phase
66  real(dp), dimension(:), pointer, contiguous :: decaylastw => null() !< aqueous phase decay rate used for last iteration (needed for zero order decay)
67  real(dp), dimension(:), pointer, contiguous :: decaylasts => null() !< solid phase decay rate used for last iteration (needed for zero order decay)
68  !
69  ! -- misc
70  integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< pointer to model ibound
71  type(tspfmitype), pointer :: fmi => null() !< pointer to fmi object
72  type(gweinputdatatype), pointer :: gwecommon => null() !< pointer to shared gwe data used by multiple packages but set in est
73  real(dp), pointer :: eqnsclfac => null() !< governing equation scale factor; =rhow*cpw for energy
74 
75  contains
76 
77  procedure :: est_ar
78  procedure :: est_fc
79  procedure :: est_fc_sto
80  procedure :: est_fc_dcy_water
81  procedure :: est_fc_dcy_solid
82  procedure :: est_cq
83  procedure :: est_cq_sto
84  procedure :: est_cq_dcy
85  procedure :: est_cq_dcy_solid
86  procedure :: est_bd
87  procedure :: est_ot_flow
88  procedure :: est_da
89  procedure :: allocate_scalars
90  procedure, private :: allocate_arrays
91  procedure, private :: read_options
92  procedure, private :: read_data
93 
94  end type gweesttype
95 
96 contains
97 
98  !> @ brief Create a new EST package object
99  !!
100  !! Create a new EST package
101  !<
102  subroutine est_cr(estobj, name_model, inunit, iout, fmi, eqnsclfac, gwecommon)
103  ! -- dummy
104  type(gweesttype), pointer :: estobj !< unallocated new est object to create
105  character(len=*), intent(in) :: name_model !< name of the model
106  integer(I4B), intent(in) :: inunit !< unit number of WEL package input file
107  integer(I4B), intent(in) :: iout !< unit number of model listing file
108  type(tspfmitype), intent(in), target :: fmi !< fmi package for this GWE model
109  real(dp), intent(in), pointer :: eqnsclfac !< governing equation scale factor
110  type(gweinputdatatype), intent(in), target :: gwecommon !< shared data container for use by multiple GWE packages
111  !
112  ! -- Create the object
113  allocate (estobj)
114  !
115  ! -- create name and memory path
116  call estobj%set_names(1, name_model, 'EST', 'EST')
117  !
118  ! -- Allocate scalars
119  call estobj%allocate_scalars()
120  !
121  ! -- Set variables
122  estobj%inunit = inunit
123  estobj%iout = iout
124  estobj%fmi => fmi
125  estobj%eqnsclfac => eqnsclfac
126  estobj%gwecommon => gwecommon
127  !
128  ! -- Initialize block parser
129  call estobj%parser%Initialize(estobj%inunit, estobj%iout)
130  end subroutine est_cr
131 
132  !> @ brief Allocate and read method for package
133  !!
134  !! Method to allocate and read static data for the package.
135  !<
136  subroutine est_ar(this, dis, ibound)
137  ! -- modules
139  ! -- dummy
140  class(gweesttype), intent(inout) :: this !< GweEstType object
141  class(disbasetype), pointer, intent(in) :: dis !< pointer to dis package
142  integer(I4B), dimension(:), pointer, contiguous :: ibound !< pointer to GWE ibound array
143  ! -- formats
144  character(len=*), parameter :: fmtest = &
145  "(1x,/1x,'EST -- ENERGY STORAGE AND TRANSFER PACKAGE, VERSION 1, &
146  &7/29/2020 INPUT READ FROM UNIT ', i0, //)"
147  !
148  ! --print a message identifying the energy storage and transfer package.
149  write (this%iout, fmtest) this%inunit
150  !
151  ! -- Read options
152  call this%read_options()
153  !
154  ! -- store pointers to arguments that were passed in
155  this%dis => dis
156  this%ibound => ibound
157  !
158  ! -- Allocate arrays
159  call this%allocate_arrays(dis%nodes)
160  !
161  ! -- read the gridded data
162  call this%read_data()
163  !
164  ! -- set data required by other packages
165  call this%gwecommon%set_gwe_dat_ptrs(this%rhow, this%cpw, this%latheatvap, &
166  this%rhos, this%cps)
167  end subroutine est_ar
168 
169  !> @ brief Fill coefficient method for package
170  !!
171  !! Method to calculate and fill coefficients for the package.
172  !<
173  subroutine est_fc(this, nodes, cold, nja, matrix_sln, idxglo, cnew, &
174  rhs, kiter)
175  ! -- dummy
176  class(gweesttype) :: this !< GweEstType object
177  integer, intent(in) :: nodes !< number of nodes
178  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
179  integer(I4B), intent(in) :: nja !< number of GWE connections
180  class(matrixbasetype), pointer :: matrix_sln !< solution matrix
181  integer(I4B), intent(in), dimension(nja) :: idxglo !< mapping vector for model (local) to solution (global)
182  real(DP), intent(inout), dimension(nodes) :: rhs !< right-hand side vector for model
183  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
184  integer(I4B), intent(in) :: kiter !< solution outer iteration number
185  !
186  ! -- storage contribution
187  call this%est_fc_sto(nodes, cold, nja, matrix_sln, idxglo, rhs)
188  !
189  ! -- decay contribution
190  if (this%idcy == decay_zero_order) then
191  call this%est_fc_dcy_water(nodes, cold, cnew, nja, matrix_sln, idxglo, &
192  rhs, kiter)
193  call this%est_fc_dcy_solid(nodes, cold, nja, matrix_sln, idxglo, rhs, &
194  cnew, kiter)
195  end if
196  end subroutine est_fc
197 
198  !> @ brief Fill storage coefficient method for package
199  !!
200  !! Method to calculate and fill storage coefficients for the package.
201  !<
202  subroutine est_fc_sto(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
203  ! -- modules
204  use tdismodule, only: delt
205  ! -- dummy
206  class(gweesttype) :: this !< GweEstType object
207  integer, intent(in) :: nodes !< number of nodes
208  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
209  integer(I4B), intent(in) :: nja !< number of GWE connections
210  class(matrixbasetype), pointer :: matrix_sln !< solution coefficient matrix
211  integer(I4B), intent(in), dimension(nja) :: idxglo !< mapping vector for model (local) to solution (global)
212  real(DP), intent(inout), dimension(nodes) :: rhs !< right-hand side vector for model
213  ! -- local
214  integer(I4B) :: n, idiag
215  real(DP) :: tled
216  real(DP) :: hhcof, rrhs
217  real(DP) :: vnew, vold, vcell, vsolid, term
218  !
219  ! -- set variables
220  tled = done / delt
221  !
222  ! -- loop through and calculate storage contribution to hcof and rhs
223  do n = 1, this%dis%nodes
224  !
225  ! -- skip if transport inactive
226  if (this%ibound(n) <= 0) cycle
227  !
228  ! -- calculate new and old water volumes and solid volume
229  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
230  vnew = vcell * this%fmi%gwfsat(n) * this%porosity(n)
231  vold = vnew
232  if (this%fmi%igwfstrgss /= 0) vold = vold + this%fmi%gwfstrgss(n) * delt
233  if (this%fmi%igwfstrgsy /= 0) vold = vold + this%fmi%gwfstrgsy(n) * delt
234  vsolid = vcell * (done - this%porosity(n))
235  !
236  ! -- add terms to diagonal and rhs accumulators
237  term = (this%rhos(n) * this%cps(n)) * vsolid
238  hhcof = -(this%eqnsclfac * vnew + term) * tled
239  rrhs = -(this%eqnsclfac * vold + term) * tled * cold(n)
240  idiag = this%dis%con%ia(n)
241  call matrix_sln%add_value_pos(idxglo(idiag), hhcof)
242  rhs(n) = rhs(n) + rrhs
243  end do
244  end subroutine est_fc_sto
245 
246  !> @ brief Fill decay coefficient method for package
247  !!
248  !! Method to calculate and fill decay coefficients for the package.
249  !<
250  subroutine est_fc_dcy_water(this, nodes, cold, cnew, nja, matrix_sln, &
251  idxglo, rhs, kiter)
252  ! -- dummy
253  class(gweesttype) :: this !< GweEstType object
254  integer, intent(in) :: nodes !< number of nodes
255  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
256  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
257  integer(I4B), intent(in) :: nja !< number of GWE connections
258  class(matrixbasetype), pointer :: matrix_sln !< solution coefficient matrix
259  integer(I4B), intent(in), dimension(nja) :: idxglo !< mapping vector for model (local) to solution (global)
260  real(DP), intent(inout), dimension(nodes) :: rhs !< right-hand side vector for model
261  integer(I4B), intent(in) :: kiter !< solution outer iteration number
262  ! -- local
263  integer(I4B) :: n
264  real(DP) :: rrhs
265  real(DP) :: swtpdt
266  real(DP) :: vcell
267  real(DP) :: decay_rate
268  !
269  ! -- loop through and calculate decay contribution to hcof and rhs
270  do n = 1, this%dis%nodes
271  !
272  ! -- skip if transport inactive
273  if (this%ibound(n) <= 0) cycle
274  !
275  ! -- calculate new and old water volumes
276  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
277  swtpdt = this%fmi%gwfsat(n)
278  !
279  ! -- add zero-order decay rate terms to accumulators
280  if (this%idcy == decay_zero_order .and. (this%idcysrc == decay_water .or. &
281  this%idcysrc == decay_both)) then
282  !
283  decay_rate = this%decay_water(n)
284  ! -- This term does get divided by eqnsclfac for fc purposes because it
285  ! should start out being a rate of energy
286  this%decaylastw(n) = decay_rate
287  rrhs = decay_rate * vcell * swtpdt * this%porosity(n)
288  rhs(n) = rhs(n) + rrhs
289  end if
290  !
291  end do
292  end subroutine est_fc_dcy_water
293 
294  !> @ brief Fill solid decay coefficient method for package
295  !!
296  !! Method to calculate and fill energy decay coefficients for the solid phase.
297  !<
298  subroutine est_fc_dcy_solid(this, nodes, cold, nja, matrix_sln, idxglo, &
299  rhs, cnew, kiter)
300  ! -- dummy
301  class(gweesttype) :: this !< GwtMstType object
302  integer, intent(in) :: nodes !< number of nodes
303  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
304  integer(I4B), intent(in) :: nja !< number of GWE connections
305  class(matrixbasetype), pointer :: matrix_sln !< solution coefficient matrix
306  integer(I4B), intent(in), dimension(nja) :: idxglo !< mapping vector for model (local) to solution (global)
307  real(DP), intent(inout), dimension(nodes) :: rhs !< right-hand side vector for model
308  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
309  integer(I4B), intent(in) :: kiter !< solution outer iteration number
310  ! -- local
311  integer(I4B) :: n
312  real(DP) :: rrhs
313  real(DP) :: vcell
314  real(DP) :: decay_rate
315  !
316  ! -- loop through and calculate sorption contribution to hcof and rhs
317  do n = 1, this%dis%nodes
318  !
319  ! -- skip if transport inactive
320  if (this%ibound(n) <= 0) cycle
321  !
322  ! -- set variables
323  rrhs = dzero
324  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
325  !
326  ! -- account for zero-order decay rate terms in rhs
327  if (this%idcy == decay_zero_order .and. (this%idcysrc == decay_solid .or. &
328  this%idcysrc == decay_both)) then
329  !
330  ! -- negative temps are currently not checked for or prevented since a
331  ! user can define a temperature scale of their own choosing. if
332  ! negative temps result from the specified zero-order decay value,
333  ! it is up to the user to decide if the calculated temperatures are
334  ! acceptable
335  decay_rate = this%decay_solid(n)
336  this%decaylasts(n) = decay_rate
337  rrhs = decay_rate * vcell * (1 - this%porosity(n)) * this%rhos(n)
338  rhs(n) = rhs(n) + rrhs
339  end if
340  end do
341  end subroutine est_fc_dcy_solid
342 
343  !> @ brief Calculate flows for package
344  !!
345  !! Method to calculate flows for the package.
346  !<
347  subroutine est_cq(this, nodes, cnew, cold, flowja)
348  ! -- dummy
349  class(gweesttype) :: this !< GweEstType object
350  integer(I4B), intent(in) :: nodes !< number of nodes
351  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
352  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
353  real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow between two connected control volumes
354  ! -- local
355  !
356  ! - storage
357  call this%est_cq_sto(nodes, cnew, cold, flowja)
358  !
359  ! -- decay
360  if (this%idcy == decay_zero_order) then
361  if (this%idcysrc == decay_water .or. this%idcysrc == decay_both) then
362  call this%est_cq_dcy(nodes, cnew, cold, flowja)
363  end if
364  if (this%idcysrc == decay_solid .or. this%idcysrc == decay_both) then
365  call this%est_cq_dcy_solid(nodes, cnew, cold, flowja)
366  end if
367  end if
368  end subroutine est_cq
369 
370  !> @ brief Calculate storage terms for package
371  !!
372  !! Method to calculate storage terms for the package.
373  !<
374  subroutine est_cq_sto(this, nodes, cnew, cold, flowja)
375  ! -- modules
376  use tdismodule, only: delt
377  ! -- dummy
378  class(gweesttype) :: this !< GweEstType object
379  integer(I4B), intent(in) :: nodes !< number of nodes
380  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
381  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
382  real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow between two connected control volumes
383  ! -- local
384  integer(I4B) :: n
385  integer(I4B) :: idiag
386  real(DP) :: rate
387  real(DP) :: tled
388  real(DP) :: vwatnew, vwatold, vcell, vsolid, term
389  real(DP) :: hhcof, rrhs
390  !
391  ! -- initialize
392  tled = done / delt
393  !
394  ! -- Calculate storage change
395  do n = 1, nodes
396  this%ratesto(n) = dzero
397  !
398  ! -- skip if transport inactive
399  if (this%ibound(n) <= 0) cycle
400  !
401  ! -- calculate new and old water volumes and solid volume
402  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
403  vwatnew = vcell * this%fmi%gwfsat(n) * this%porosity(n)
404  vwatold = vwatnew
405  if (this%fmi%igwfstrgss /= 0) vwatold = vwatold + this%fmi%gwfstrgss(n) &
406  * delt
407  if (this%fmi%igwfstrgsy /= 0) vwatold = vwatold + this%fmi%gwfstrgsy(n) &
408  * delt
409  vsolid = vcell * (done - this%porosity(n))
410  !
411  ! -- calculate rate
412  term = (this%rhos(n) * this%cps(n)) * vsolid
413  hhcof = -(this%eqnsclfac * vwatnew + term) * tled
414  rrhs = -(this%eqnsclfac * vwatold + term) * tled * cold(n)
415  rate = hhcof * cnew(n) - rrhs
416  this%ratesto(n) = rate
417  idiag = this%dis%con%ia(n)
418  flowja(idiag) = flowja(idiag) + rate
419  end do
420  end subroutine est_cq_sto
421 
422  !> @ brief Calculate decay terms for aqueous phase
423  !!
424  !! Method to calculate decay terms for the aqueous phase.
425  !<
426  subroutine est_cq_dcy(this, nodes, cnew, cold, flowja)
427  ! -- dummy
428  class(gweesttype) :: this !< GweEstType object
429  integer(I4B), intent(in) :: nodes !< number of nodes
430  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
431  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
432  real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow between two connected control volumes
433  ! -- local
434  integer(I4B) :: n
435  integer(I4B) :: idiag
436  real(DP) :: rate
437  real(DP) :: swtpdt
438  real(DP) :: hhcof, rrhs
439  real(DP) :: vcell
440  real(DP) :: decay_rate
441  !
442  ! -- Calculate decay change
443  do n = 1, nodes
444  !
445  ! -- skip if transport inactive
446  this%ratedcyw(n) = dzero
447  if (this%ibound(n) <= 0) cycle
448  !
449  ! -- calculate new and old water volumes
450  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
451  swtpdt = this%fmi%gwfsat(n)
452  !
453  ! -- calculate decay gains and losses
454  rate = dzero
455  hhcof = dzero
456  rrhs = dzero
457  ! -- zero order decay aqueous phase
458  if (this%idcy == decay_zero_order .and. &
459  (this%idcysrc == decay_water .or. this%idcysrc == decay_both)) then
460  decay_rate = this%decay_water(n)
461  ! -- this term does NOT get multiplied by eqnsclfac for cq purposes
462  ! because it should already be a rate of energy
463  rrhs = decay_rate * vcell * swtpdt * this%porosity(n)
464  end if
465  rate = hhcof * cnew(n) - rrhs
466  this%ratedcyw(n) = rate
467  idiag = this%dis%con%ia(n)
468  flowja(idiag) = flowja(idiag) + rate
469  !
470  end do
471  end subroutine est_cq_dcy
472 
473  !> @ brief Calculate decay terms for solid phase
474  !!
475  !! Method to calculate decay terms for the solid phase.
476  !<
477  subroutine est_cq_dcy_solid(this, nodes, cnew, cold, flowja)
478  ! -- dummy
479  class(gweesttype) :: this !< GweEstType object
480  integer(I4B), intent(in) :: nodes !< number of nodes
481  real(DP), intent(in), dimension(nodes) :: cnew !< temperature at end of this time step
482  real(DP), intent(in), dimension(nodes) :: cold !< temperature at end of last time step
483  real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow between two connected control volumes
484  ! -- local
485  integer(I4B) :: n
486  integer(I4B) :: idiag
487  real(DP) :: rate
488  real(DP) :: hhcof, rrhs
489  real(DP) :: vcell
490  real(DP) :: decay_rate
491  !
492  ! -- Calculate decay change
493  do n = 1, nodes
494  !
495  ! -- skip if transport inactive
496  this%ratedcys(n) = dzero
497  if (this%ibound(n) <= 0) cycle
498  !
499  ! -- calculate new and old water volumes
500  vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
501  !
502  ! -- calculate decay gains and losses
503  rate = dzero
504  hhcof = dzero
505  rrhs = dzero
506  ! -- first-order decay (idcy=1) is not supported for temperature modeling
507  if (this%idcy == decay_zero_order .and. &
508  (this%idcysrc == decay_solid .or. this%idcysrc == decay_both)) then ! zero order decay in the solid phase
509  decay_rate = this%decay_solid(n)
510  ! -- this term does NOT get multiplied by eqnsclfac for cq purposes
511  ! because it should already be a rate of energy
512  rrhs = decay_rate * vcell * (1 - this%porosity(n)) * this%rhos(n)
513  end if
514  rate = hhcof * cnew(n) - rrhs
515  this%ratedcys(n) = rate
516  idiag = this%dis%con%ia(n)
517  flowja(idiag) = flowja(idiag) + rate
518  !
519  end do
520  end subroutine est_cq_dcy_solid
521 
522  !> @ brief Calculate budget terms for package
523  !!
524  !! Method to calculate budget terms for the package.
525  !<
526  subroutine est_bd(this, isuppress_output, model_budget)
527  ! -- modules
528  use tdismodule, only: delt
530  ! -- dummy
531  class(gweesttype) :: this !< GweEstType object
532  integer(I4B), intent(in) :: isuppress_output !< flag to suppress output
533  type(budgettype), intent(inout) :: model_budget !< model budget object
534  ! -- local
535  real(DP) :: rin
536  real(DP) :: rout
537  !
538  ! -- sto
539  call rate_accumulator(this%ratesto, rin, rout)
540  call model_budget%addentry(rin, rout, delt, budtxt(1), &
541  isuppress_output, rowlabel=this%packName)
542  !
543  ! -- dcy
544  if (this%idcy == decay_zero_order) then
545  if (this%idcysrc == decay_water .or. this%idcysrc == decay_both) then
546  ! -- aqueous phase
547  call rate_accumulator(this%ratedcyw, rin, rout)
548  call model_budget%addentry(rin, rout, delt, budtxt(2), &
549  isuppress_output, rowlabel=this%packName)
550  end if
551  if (this%idcysrc == decay_solid .or. this%idcysrc == decay_both) then
552  ! -- solid phase
553  call rate_accumulator(this%ratedcys, rin, rout)
554  call model_budget%addentry(rin, rout, delt, budtxt(3), &
555  isuppress_output, rowlabel=this%packName)
556  end if
557  end if
558  end subroutine est_bd
559 
560  !> @ brief Output flow terms for package
561  !!
562  !! Method to output terms for the package.
563  !<
564  subroutine est_ot_flow(this, icbcfl, icbcun)
565  ! -- dummy
566  class(gweesttype) :: this !< GweEstType object
567  integer(I4B), intent(in) :: icbcfl !< flag and unit number for cell-by-cell output
568  integer(I4B), intent(in) :: icbcun !< flag indication if cell-by-cell data should be saved
569  ! -- local
570  integer(I4B) :: ibinun
571  integer(I4B) :: iprint, nvaluesp, nwidthp
572  character(len=1) :: cdatafmp = ' ', editdesc = ' '
573  real(DP) :: dinact
574  !
575  ! -- Set unit number for binary output
576  if (this%ipakcb < 0) then
577  ibinun = icbcun
578  elseif (this%ipakcb == 0) then
579  ibinun = 0
580  else
581  ibinun = this%ipakcb
582  end if
583  if (icbcfl == 0) ibinun = 0
584  !
585  ! -- Record the storage rate if requested
586  if (ibinun /= 0) then
587  iprint = 0
588  dinact = dzero
589  !
590  ! -- sto
591  call this%dis%record_array(this%ratesto, this%iout, iprint, -ibinun, &
592  budtxt(1), cdatafmp, nvaluesp, &
593  nwidthp, editdesc, dinact)
594  !
595  ! -- dcy
596  if (this%idcy == decay_zero_order) then
597  if (this%idcysrc == decay_water .or. this%idcysrc == decay_both) then
598  ! -- aqueous phase
599  call this%dis%record_array(this%ratedcyw, this%iout, iprint, &
600  -ibinun, budtxt(2), cdatafmp, nvaluesp, &
601  nwidthp, editdesc, dinact)
602  end if
603  if (this%idcysrc == decay_solid .or. this%idcysrc == decay_both) then
604  ! -- solid phase
605  call this%dis%record_array(this%ratedcys, this%iout, iprint, &
606  -ibinun, budtxt(3), cdatafmp, nvaluesp, &
607  nwidthp, editdesc, dinact)
608  end if
609  end if
610  end if
611  end subroutine est_ot_flow
612 
613  !> @brief Deallocate memory
614  !!
615  !! Method to deallocate memory for the package.
616  !<
617  subroutine est_da(this)
618  ! -- modules
620  ! -- dummy
621  class(gweesttype) :: this !< GweEstType object
622  !
623  ! -- Deallocate arrays if package was active
624  if (this%inunit > 0) then
625  call mem_deallocate(this%porosity)
626  call mem_deallocate(this%ratesto)
627  call mem_deallocate(this%idcy)
628  call mem_deallocate(this%idcysrc)
629  call mem_deallocate(this%decay_water)
630  call mem_deallocate(this%decay_solid)
631  call mem_deallocate(this%ratedcyw)
632  call mem_deallocate(this%ratedcys)
633  call mem_deallocate(this%decaylastw)
634  call mem_deallocate(this%decaylasts)
635  call mem_deallocate(this%cpw)
636  call mem_deallocate(this%cps)
637  call mem_deallocate(this%rhow)
638  call mem_deallocate(this%rhos)
639  call mem_deallocate(this%latheatvap)
640  this%ibound => null()
641  this%fmi => null()
642  end if
643  !
644  ! -- Scalars
645  !
646  ! -- deallocate parent
647  call this%NumericalPackageType%da()
648  end subroutine est_da
649 
650  !> @ brief Allocate scalar variables for package
651  !!
652  !! Method to allocate scalar variables for the package.
653  !<
654  subroutine allocate_scalars(this)
655  ! -- modules
657  ! -- dummy
658  class(gweesttype) :: this !< GweEstType object
659  !
660  ! -- Allocate scalars in NumericalPackageType
661  call this%NumericalPackageType%allocate_scalars()
662  !
663  ! -- Allocate
664  call mem_allocate(this%cpw, 'CPW', this%memoryPath)
665  call mem_allocate(this%rhow, 'RHOW', this%memoryPath)
666  call mem_allocate(this%latheatvap, 'LATHEATVAP', this%memoryPath)
667  call mem_allocate(this%idcy, 'IDCY', this%memoryPath)
668  call mem_allocate(this%idcysrc, 'IDCYSRC', this%memoryPath)
669  !
670  ! -- Initialize
671  this%cpw = dzero
672  this%rhow = dzero
673  this%latheatvap = dzero
674  this%idcy = izero
675  this%idcysrc = izero
676  end subroutine allocate_scalars
677 
678  !> @ brief Allocate arrays for package
679  !!
680  !! Method to allocate arrays for the package.
681  !<
682  subroutine allocate_arrays(this, nodes)
683  ! -- modules
685  use constantsmodule, only: dzero
686  ! -- dummy
687  class(gweesttype) :: this !< GweEstType object
688  integer(I4B), intent(in) :: nodes !< number of nodes
689  ! -- local
690  integer(I4B) :: n
691  !
692  ! -- Allocate
693  ! -- sto
694  call mem_allocate(this%porosity, nodes, 'POROSITY', this%memoryPath)
695  call mem_allocate(this%ratesto, nodes, 'RATESTO', this%memoryPath)
696  call mem_allocate(this%cps, nodes, 'CPS', this%memoryPath)
697  call mem_allocate(this%rhos, nodes, 'RHOS', this%memoryPath)
698  !
699  ! -- dcy
700  if (this%idcy == decay_off) then
701  call mem_allocate(this%ratedcyw, 1, 'RATEDCYW', this%memoryPath)
702  call mem_allocate(this%ratedcys, 1, 'RATEDCYS', this%memoryPath)
703  call mem_allocate(this%decay_water, 1, 'DECAY_WATER', this%memoryPath)
704  call mem_allocate(this%decay_solid, 1, 'DECAY_SOLID', this%memoryPath)
705  call mem_allocate(this%decaylastw, 1, 'DECAYLASTW', this%memoryPath)
706  call mem_allocate(this%decaylasts, 1, 'DECAYLAST', this%memoryPath)
707  else
708  call mem_allocate(this%ratedcyw, this%dis%nodes, 'RATEDCYW', &
709  this%memoryPath)
710  call mem_allocate(this%ratedcys, this%dis%nodes, 'RATEDCYS', &
711  this%memoryPath)
712  call mem_allocate(this%decay_water, nodes, 'DECAY_WATER', this%memoryPath)
713  call mem_allocate(this%decay_solid, nodes, 'DECAY_SOLID', this%memoryPath)
714  call mem_allocate(this%decaylastw, nodes, 'DECAYLASTW', this%memoryPath)
715  call mem_allocate(this%decaylasts, nodes, 'DECAYLASTS', this%memoryPath)
716  end if
717  !
718  ! -- Initialize
719  do n = 1, nodes
720  this%porosity(n) = dzero
721  this%ratesto(n) = dzero
722  this%cps(n) = dzero
723  this%rhos(n) = dzero
724  end do
725  do n = 1, size(this%decay_water)
726  this%decay_water(n) = dzero
727  this%decay_solid(n) = dzero
728  this%ratedcyw(n) = dzero
729  this%ratedcys(n) = dzero
730  this%decaylastw(n) = dzero
731  this%decaylasts(n) = dzero
732  end do
733  end subroutine allocate_arrays
734 
735  !> @ brief Read options for package
736  !!
737  !! Method to read options for the package.
738  !<
739  subroutine read_options(this)
740  ! -- modules
741  use constantsmodule, only: linelength
742  ! -- dummy
743  class(gweesttype) :: this !< GweEstType object
744  ! -- local
745  character(len=LINELENGTH) :: keyword
746  integer(I4B) :: ierr
747  logical :: isfound, endOfBlock
748  ! -- formats
749  character(len=*), parameter :: fmtisvflow = &
750  &"(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY "// &
751  &"FILE WHENEVER ICBCFL IS NOT ZERO.')"
752  character(len=*), parameter :: fmtidcy1 = &
753  "(4x,'FIRST-ORDER DECAY IS ACTIVE. ')"
754  character(len=*), parameter :: fmtidcy2 = &
755  "(4x,'ZERO-ORDER DECAY IN THE AQUEOUS "// &
756  &"PHASE IS ACTIVE. ')"
757  character(len=*), parameter :: fmtidcy3 = &
758  "(4x,'ZERO-ORDER DECAY IN THE SOLID "// &
759  &"PHASE IS ACTIVE. ')"
760  !
761  ! -- get options block
762  call this%parser%GetBlock('OPTIONS', isfound, ierr, blockrequired=.false., &
763  supportopenclose=.true.)
764  !
765  ! -- parse options block if detected
766  if (isfound) then
767  write (this%iout, '(1x,a)') 'PROCESSING ENERGY STORAGE AND TRANSFER OPTIONS'
768  do
769  call this%parser%GetNextLine(endofblock)
770  if (endofblock) exit
771  call this%parser%GetStringCaps(keyword)
772  select case (keyword)
773  case ('SAVE_FLOWS')
774  this%ipakcb = -1
775  write (this%iout, fmtisvflow)
776  case ('ZERO_ORDER_DECAY_WATER')
777  this%idcy = decay_zero_order
778  ! -- idcysrc > 0 indicates decay in the solid phase is active
779  ! in which case the idcysrc should now be upgraded to both phases
780  if (this%idcysrc > izero) then
781  this%idcysrc = decay_both
782  else
783  this%idcysrc = decay_water
784  end if
785  write (this%iout, fmtidcy2)
786  case ('ZERO_ORDER_DECAY_SOLID')
787  this%idcy = decay_zero_order
788  ! -- idcysrc > 0 indicates decay in active in water in which case
789  ! the idcysrc should now be upgraded to both phases
790  if (this%idcysrc > izero) then
791  this%idcysrc = decay_both
792  else
793  this%idcysrc = decay_solid
794  end if
795  write (this%iout, fmtidcy3)
796  case ('HEAT_CAPACITY_WATER')
797  this%cpw = this%parser%GetDouble()
798  if (this%cpw <= 0.0) then
799  write (errmsg, '(a)') 'Specified value for the heat capacity of &
800  &water must be greater than 0.0.'
801  call store_error(errmsg)
802  call this%parser%StoreErrorUnit()
803  else
804  write (this%iout, '(4x,a,1pg15.6)') &
805  'Heat capacity of the water has been set to: ', &
806  this%cpw
807  end if
808  case ('DENSITY_WATER')
809  this%rhow = this%parser%GetDouble()
810  if (this%rhow <= 0.0) then
811  write (errmsg, '(a)') 'Specified value for the density of &
812  &water must be greater than 0.0.'
813  call store_error(errmsg)
814  call this%parser%StoreErrorUnit()
815  else
816  write (this%iout, '(4x,a,1pg15.6)') &
817  'Density of the water has been set to: ', &
818  this%rhow
819  end if
820  case ('LATENT_HEAT_VAPORIZATION')
821  this%latheatvap = this%parser%GetDouble()
822  write (this%iout, '(4x,a,1pg15.6)') &
823  'Latent heat of vaporization of the water has been set to: ', &
824  this%latheatvap
825  case default
826  write (errmsg, '(a,a)') 'Unknown EST option: ', trim(keyword)
827  call store_error(errmsg)
828  call this%parser%StoreErrorUnit()
829  end select
830  end do
831  write (this%iout, '(1x,a)') 'END OF ENERGY STORAGE AND TRANSFER OPTIONS'
832  end if
833  end subroutine read_options
834 
835  !> @ brief Read data for package
836  !!
837  !! Method to read data for the package.
838  !<
839  subroutine read_data(this)
840  ! -- modules
841  use constantsmodule, only: linelength
843  ! -- dummy
844  class(gweesttype) :: this !< GweEstType object
845  ! -- local
846  character(len=LINELENGTH) :: keyword
847  character(len=:), allocatable :: line
848  integer(I4B) :: istart, istop, lloc, ierr
849  logical :: isfound, endOfBlock
850  logical, dimension(5) :: lname
851  character(len=24), dimension(5) :: aname
852  ! -- formats
853  ! -- data
854  data aname(1)/' MOBILE DOMAIN POROSITY'/
855  data aname(2)/'DECAY RATE AQUEOUS PHASE'/
856  data aname(3)/' DECAY RATE SOLID PHASE'/
857  data aname(4)/' HEAT CAPACITY OF SOLIDS'/
858  data aname(5)/' DENSITY OF SOLIDS'/
859  !
860  ! -- initialize
861  isfound = .false.
862  lname(:) = .false.
863  !
864  ! -- get griddata block
865  call this%parser%GetBlock('GRIDDATA', isfound, ierr)
866  if (isfound) then
867  write (this%iout, '(1x,a)') 'PROCESSING GRIDDATA'
868  do
869  call this%parser%GetNextLine(endofblock)
870  if (endofblock) exit
871  call this%parser%GetStringCaps(keyword)
872  call this%parser%GetRemainingLine(line)
873  lloc = 1
874  select case (keyword)
875  case ('POROSITY')
876  call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
877  this%parser%iuactive, this%porosity, &
878  aname(1))
879  lname(1) = .true.
880  case ('DECAY_WATER')
881  if (this%idcy == decay_off) &
882  call mem_reallocate(this%decay_water, this%dis%nodes, 'DECAY_WATER', &
883  trim(this%memoryPath))
884  call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
885  this%parser%iuactive, this%decay_water, &
886  aname(2))
887  lname(2) = .true.
888  case ('DECAY_SOLID')
889  if (this%idcy == decay_off) &
890  call mem_reallocate(this%decay_solid, this%dis%nodes, 'DECAY_SOLID', &
891  trim(this%memoryPath))
892  call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
893  this%parser%iuactive, this%decay_solid, &
894  aname(3))
895  lname(3) = .true.
896  case ('HEAT_CAPACITY_SOLID')
897  call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
898  this%parser%iuactive, this%cps, &
899  aname(4))
900  lname(4) = .true.
901  case ('DENSITY_SOLID')
902  call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
903  this%parser%iuactive, this%rhos, &
904  aname(5))
905  lname(5) = .true.
906  case default
907  write (errmsg, '(a,a)') 'Unknown griddata tag: ', trim(keyword)
908  call store_error(errmsg)
909  call this%parser%StoreErrorUnit()
910  end select
911  end do
912  write (this%iout, '(1x,a)') 'END PROCESSING GRIDDATA'
913  else
914  write (errmsg, '(a)') 'Required griddata block not found.'
915  call store_error(errmsg)
916  call this%parser%StoreErrorUnit()
917  end if
918  !
919  ! -- Check for required porosity
920  if (.not. lname(1)) then
921  write (errmsg, '(a)') 'Porosity not specified in griddata block.'
922  call store_error(errmsg)
923  end if
924  if (.not. lname(4)) then
925  write (errmsg, '(a)') 'HEAT_CAPACITY_SOLID not specified in griddata block.'
926  call store_error(errmsg)
927  end if
928  if (.not. lname(5)) then
929  write (errmsg, '(a)') 'DENSITY_SOLID not specified in griddata block.'
930  call store_error(errmsg)
931  end if
932  !
933  ! -- Check for required decay/production rate coefficients
934  if (this%idcy == decay_zero_order) then
935  if (.not. lname(2) .and. .not. lname(3)) then
936  write (errmsg, '(a)') 'Zero order decay in either the aqueous &
937  &or solid phase is active but the corresponding zero-order &
938  &rate coefficient is not specified. Either DECAY_WATER or &
939  &DECAY_SOLID must be specified in the griddata block.'
940  call store_error(errmsg)
941  end if
942  else
943  if (lname(2)) then
944  write (warnmsg, '(a)') 'Zero order decay in the aqueous phase has &
945  &not been activated but DECAY_WATER has been specified. Zero &
946  &order decay in the aqueous phase will have no affect on &
947  &simulation results.'
948  call store_warning(warnmsg)
949  write (this%iout, '(1x,a)') 'WARNING. '//warnmsg
950  else if (lname(3)) then
951  write (warnmsg, '(a)') 'Zero order decay in the solid phase has not &
952  &been activated but DECAY_SOLID has been specified. Zero order &
953  &decay in the solid phase will have no affect on simulation &
954  &results.'
955  call store_warning(warnmsg)
956  write (this%iout, '(1x,a)') 'WARNING. '//warnmsg
957  end if
958  end if
959  !
960  ! -- terminate if errors
961  if (count_errors() > 0) then
962  call this%parser%StoreErrorUnit()
963  end if
964  end subroutine read_data
965 
966 end module gweestmodule
This module contains the BudgetModule.
Definition: Budget.f90:20
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
Definition: Budget.f90:632
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dep3
real constant 1000
Definition: Constants.f90:88
real(dp), parameter dhalf
real constant 1/2
Definition: Constants.f90:68
integer(i4b), parameter izero
integer constant zero
Definition: Constants.f90:51
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
real(dp), parameter dtwo
real constant 2
Definition: Constants.f90:79
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
– @ brief Energy Storage and Transfer (EST) Module
Definition: gwe-est.f90:13
subroutine est_cq_dcy_solid(this, nodes, cnew, cold, flowja)
@ brief Calculate decay terms for solid phase
Definition: gwe-est.f90:478
subroutine est_cq_sto(this, nodes, cnew, cold, flowja)
@ brief Calculate storage terms for package
Definition: gwe-est.f90:375
@ decay_off
Decay (or production) of thermal energy inactive (default)
Definition: gwe-est.f90:37
@ decay_zero_order
Zeroth-order decay.
Definition: gwe-est.f90:38
@ decay_water
Zeroth-order decay in water only.
Definition: gwe-est.f90:39
@ decay_solid
Zeroth-order decay in solid only.
Definition: gwe-est.f90:40
@ decay_both
Zeroth-order decay in water and solid.
Definition: gwe-est.f90:41
integer(i4b), parameter nbditems
Definition: gwe-est.f90:30
subroutine est_cq_dcy(this, nodes, cnew, cold, flowja)
@ brief Calculate decay terms for aqueous phase
Definition: gwe-est.f90:427
character(len=lenbudtxt), dimension(nbditems) budtxt
Definition: gwe-est.f90:31
subroutine est_fc_sto(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
@ brief Fill storage coefficient method for package
Definition: gwe-est.f90:203
subroutine allocate_scalars(this)
@ brief Allocate scalar variables for package
Definition: gwe-est.f90:655
subroutine est_ar(this, dis, ibound)
@ brief Allocate and read method for package
Definition: gwe-est.f90:137
subroutine est_fc(this, nodes, cold, nja, matrix_sln, idxglo, cnew, rhs, kiter)
@ brief Fill coefficient method for package
Definition: gwe-est.f90:175
subroutine allocate_arrays(this, nodes)
@ brief Allocate arrays for package
Definition: gwe-est.f90:683
subroutine, public est_cr(estobj, name_model, inunit, iout, fmi, eqnsclfac, gwecommon)
@ brief Create a new EST package object
Definition: gwe-est.f90:103
subroutine est_cq(this, nodes, cnew, cold, flowja)
@ brief Calculate flows for package
Definition: gwe-est.f90:348
subroutine est_bd(this, isuppress_output, model_budget)
@ brief Calculate budget terms for package
Definition: gwe-est.f90:527
subroutine read_data(this)
@ brief Read data for package
Definition: gwe-est.f90:840
subroutine est_fc_dcy_solid(this, nodes, cold, nja, matrix_sln, idxglo, rhs, cnew, kiter)
@ brief Fill solid decay coefficient method for package
Definition: gwe-est.f90:300
subroutine est_da(this)
Deallocate memory.
Definition: gwe-est.f90:618
subroutine read_options(this)
@ brief Read options for package
Definition: gwe-est.f90:740
subroutine est_fc_dcy_water(this, nodes, cold, cnew, nja, matrix_sln, idxglo, rhs, kiter)
@ brief Fill decay coefficient method for package
Definition: gwe-est.f90:252
subroutine est_ot_flow(this, icbcfl, icbcun)
@ brief Output flow terms for package
Definition: gwe-est.f90:565
subroutine, public set_gwe_dat_ptrs(this, gwerhow, gwecpw, gwelatheatvap, gwerhos, gwecps)
Allocate and read data from EST.
This module defines variable data types.
Definition: kind.f90:8
This module contains the base numerical package type.
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_warning(msg, substring)
Store warning message.
Definition: Sim.f90:236
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
character(len=maxcharlen) warnmsg
warning message string
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
Derived type for the Budget object.
Definition: Budget.f90:39
@ brief Energy storage and transfer
Definition: gwe-est.f90:48
Data for sharing among multiple packages. Originally read in from.