MODFLOW 6  version 6.7.0.dev2
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 :: source_options
92  procedure, private :: source_data
93  procedure, private :: log_options
94 
95  end type gweesttype
96 
97 contains
98 
99  !> @ brief Create a new EST package object
100  !!
101  !! Create a new EST package
102  !<
103  subroutine est_cr(estobj, name_model, input_mempath, inunit, iout, fmi, &
104  eqnsclfac, gwecommon)
105  ! -- dummy
106  type(gweesttype), pointer :: estobj !< unallocated new est object to create
107  character(len=*), intent(in) :: name_model !< name of the model
108  character(len=*), intent(in) :: input_mempath !< input mempath of package
109  integer(I4B), intent(in) :: inunit !< unit number of WEL package input file
110  integer(I4B), intent(in) :: iout !< unit number of model listing file
111  type(tspfmitype), intent(in), target :: fmi !< fmi package for this GWE model
112  real(dp), intent(in), pointer :: eqnsclfac !< governing equation scale factor
113  type(gweinputdatatype), intent(in), target :: gwecommon !< shared data container for use by multiple GWE packages
114  !
115  ! -- Create the object
116  allocate (estobj)
117  !
118  ! -- create name and memory path
119  call estobj%set_names(1, name_model, 'EST', 'EST', input_mempath)
120  !
121  ! -- Allocate scalars
122  call estobj%allocate_scalars()
123  !
124  ! -- Set variables
125  estobj%inunit = inunit
126  estobj%iout = iout
127  estobj%fmi => fmi
128  estobj%eqnsclfac => eqnsclfac
129  estobj%gwecommon => gwecommon
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 MEMPATH: ', a, /)"
147  !
148  ! --print a message identifying the energy storage and transfer package.
149  write (this%iout, fmtest) this%input_mempath
150  !
151  ! -- Read options
152  call this%source_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%source_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  end do
519  end subroutine est_cq_dcy_solid
520 
521  !> @ brief Calculate budget terms for package
522  !!
523  !! Method to calculate budget terms for the package.
524  !<
525  subroutine est_bd(this, isuppress_output, model_budget)
526  ! -- modules
527  use tdismodule, only: delt
529  ! -- dummy
530  class(gweesttype) :: this !< GweEstType object
531  integer(I4B), intent(in) :: isuppress_output !< flag to suppress output
532  type(budgettype), intent(inout) :: model_budget !< model budget object
533  ! -- local
534  real(DP) :: rin
535  real(DP) :: rout
536  !
537  ! -- sto
538  call rate_accumulator(this%ratesto, rin, rout)
539  call model_budget%addentry(rin, rout, delt, budtxt(1), &
540  isuppress_output, rowlabel=this%packName)
541  !
542  ! -- dcy
543  if (this%idcy == decay_zero_order) then
544  if (this%idcysrc == decay_water .or. this%idcysrc == decay_both) then
545  ! -- aqueous phase
546  call rate_accumulator(this%ratedcyw, rin, rout)
547  call model_budget%addentry(rin, rout, delt, budtxt(2), &
548  isuppress_output, rowlabel=this%packName)
549  end if
550  if (this%idcysrc == decay_solid .or. this%idcysrc == decay_both) then
551  ! -- solid phase
552  call rate_accumulator(this%ratedcys, rin, rout)
553  call model_budget%addentry(rin, rout, delt, budtxt(3), &
554  isuppress_output, rowlabel=this%packName)
555  end if
556  end if
557  end subroutine est_bd
558 
559  !> @ brief Output flow terms for package
560  !!
561  !! Method to output terms for the package.
562  !<
563  subroutine est_ot_flow(this, icbcfl, icbcun)
564  ! -- dummy
565  class(gweesttype) :: this !< GweEstType object
566  integer(I4B), intent(in) :: icbcfl !< flag and unit number for cell-by-cell output
567  integer(I4B), intent(in) :: icbcun !< flag indication if cell-by-cell data should be saved
568  ! -- local
569  integer(I4B) :: ibinun
570  integer(I4B) :: iprint, nvaluesp, nwidthp
571  character(len=1) :: cdatafmp = ' ', editdesc = ' '
572  real(DP) :: dinact
573  !
574  ! -- Set unit number for binary output
575  if (this%ipakcb < 0) then
576  ibinun = icbcun
577  elseif (this%ipakcb == 0) then
578  ibinun = 0
579  else
580  ibinun = this%ipakcb
581  end if
582  if (icbcfl == 0) ibinun = 0
583  !
584  ! -- Record the storage rate if requested
585  if (ibinun /= 0) then
586  iprint = 0
587  dinact = dzero
588  !
589  ! -- sto
590  call this%dis%record_array(this%ratesto, this%iout, iprint, -ibinun, &
591  budtxt(1), cdatafmp, nvaluesp, &
592  nwidthp, editdesc, dinact)
593  !
594  ! -- dcy
595  if (this%idcy == decay_zero_order) then
596  if (this%idcysrc == decay_water .or. this%idcysrc == decay_both) then
597  ! -- aqueous phase
598  call this%dis%record_array(this%ratedcyw, this%iout, iprint, &
599  -ibinun, budtxt(2), cdatafmp, nvaluesp, &
600  nwidthp, editdesc, dinact)
601  end if
602  if (this%idcysrc == decay_solid .or. this%idcysrc == decay_both) then
603  ! -- solid phase
604  call this%dis%record_array(this%ratedcys, this%iout, iprint, &
605  -ibinun, budtxt(3), cdatafmp, nvaluesp, &
606  nwidthp, editdesc, dinact)
607  end if
608  end if
609  end if
610  end subroutine est_ot_flow
611 
612  !> @brief Deallocate memory
613  !!
614  !! Method to deallocate memory for the package.
615  !<
616  subroutine est_da(this)
617  ! -- modules
619  ! -- dummy
620  class(gweesttype) :: this !< GweEstType object
621  !
622  ! -- Deallocate arrays if package was active
623  if (this%inunit > 0) then
624  call mem_deallocate(this%porosity)
625  call mem_deallocate(this%ratesto)
626  call mem_deallocate(this%idcy)
627  call mem_deallocate(this%idcysrc)
628  call mem_deallocate(this%decay_water)
629  call mem_deallocate(this%decay_solid)
630  call mem_deallocate(this%ratedcyw)
631  call mem_deallocate(this%ratedcys)
632  call mem_deallocate(this%decaylastw)
633  call mem_deallocate(this%decaylasts)
634  call mem_deallocate(this%cpw)
635  call mem_deallocate(this%cps)
636  call mem_deallocate(this%rhow)
637  call mem_deallocate(this%rhos)
638  call mem_deallocate(this%latheatvap)
639  this%ibound => null()
640  this%fmi => null()
641  end if
642  !
643  ! -- deallocate parent
644  call this%NumericalPackageType%da()
645  end subroutine est_da
646 
647  !> @ brief Allocate scalar variables for package
648  !!
649  !! Method to allocate scalar variables for the package.
650  !<
651  subroutine allocate_scalars(this)
652  ! -- modules
654  ! -- dummy
655  class(gweesttype) :: this !< GweEstType object
656  !
657  ! -- Allocate scalars in NumericalPackageType
658  call this%NumericalPackageType%allocate_scalars()
659  !
660  ! -- Allocate
661  call mem_allocate(this%cpw, 'CPW', this%memoryPath)
662  call mem_allocate(this%rhow, 'RHOW', this%memoryPath)
663  call mem_allocate(this%latheatvap, 'LATHEATVAP', this%memoryPath)
664  call mem_allocate(this%idcy, 'IDCY', this%memoryPath)
665  call mem_allocate(this%idcysrc, 'IDCYSRC', this%memoryPath)
666  !
667  ! -- Initialize
668  this%cpw = dzero
669  this%rhow = dzero
670  this%latheatvap = dzero
671  this%idcy = izero
672  this%idcysrc = izero
673  end subroutine allocate_scalars
674 
675  !> @ brief Allocate arrays for package
676  !!
677  !! Method to allocate arrays for the package.
678  !<
679  subroutine allocate_arrays(this, nodes)
680  ! -- modules
682  use constantsmodule, only: dzero
683  ! -- dummy
684  class(gweesttype) :: this !< GweEstType object
685  integer(I4B), intent(in) :: nodes !< number of nodes
686  ! -- local
687  integer(I4B) :: n
688  !
689  ! -- Allocate
690  ! -- sto
691  call mem_allocate(this%porosity, nodes, 'POROSITY', this%memoryPath)
692  call mem_allocate(this%ratesto, nodes, 'RATESTO', this%memoryPath)
693  call mem_allocate(this%cps, nodes, 'CPS', this%memoryPath)
694  call mem_allocate(this%rhos, nodes, 'RHOS', this%memoryPath)
695  !
696  ! -- dcy
697  if (this%idcy == decay_off) then
698  call mem_allocate(this%ratedcyw, 1, 'RATEDCYW', this%memoryPath)
699  call mem_allocate(this%ratedcys, 1, 'RATEDCYS', this%memoryPath)
700  call mem_allocate(this%decay_water, 1, 'DECAY_WATER', this%memoryPath)
701  call mem_allocate(this%decay_solid, 1, 'DECAY_SOLID', this%memoryPath)
702  call mem_allocate(this%decaylastw, 1, 'DECAYLASTW', this%memoryPath)
703  call mem_allocate(this%decaylasts, 1, 'DECAYLAST', this%memoryPath)
704  else
705  call mem_allocate(this%ratedcyw, this%dis%nodes, 'RATEDCYW', &
706  this%memoryPath)
707  call mem_allocate(this%ratedcys, this%dis%nodes, 'RATEDCYS', &
708  this%memoryPath)
709  call mem_allocate(this%decay_water, nodes, 'DECAY_WATER', this%memoryPath)
710  call mem_allocate(this%decay_solid, nodes, 'DECAY_SOLID', this%memoryPath)
711  call mem_allocate(this%decaylastw, nodes, 'DECAYLASTW', this%memoryPath)
712  call mem_allocate(this%decaylasts, nodes, 'DECAYLASTS', this%memoryPath)
713  end if
714  !
715  ! -- Initialize
716  do n = 1, nodes
717  this%porosity(n) = dzero
718  this%ratesto(n) = dzero
719  this%cps(n) = dzero
720  this%rhos(n) = dzero
721  end do
722  do n = 1, size(this%decay_water)
723  this%decay_water(n) = dzero
724  this%decay_solid(n) = dzero
725  this%ratedcyw(n) = dzero
726  this%ratedcys(n) = dzero
727  this%decaylastw(n) = dzero
728  this%decaylasts(n) = dzero
729  end do
730  end subroutine allocate_arrays
731 
732  !> @brief Update simulation mempath options
733  !<
734  subroutine source_options(this)
735  ! -- modules
738  ! -- dummy
739  class(gweesttype) :: this
740  ! -- locals
741  type(gweestparamfoundtype) :: found
742  !
743  ! -- update defaults with idm sourced values
744  call mem_set_value(this%ipakcb, 'SAVE_FLOWS', this%input_mempath, &
745  found%save_flows)
746  call mem_set_value(this%idcy, 'ORD0_DECAY_WATER', this%input_mempath, &
747  found%ord0_decay_water)
748  call mem_set_value(this%idcy, 'ORD0_DECAY_SOLID', this%input_mempath, &
749  found%ord0_decay_solid)
750  call mem_set_value(this%cpw, 'CPW', this%input_mempath, &
751  found%cpw)
752  call mem_set_value(this%rhow, 'RHOW', this%input_mempath, &
753  found%rhow)
754  call mem_set_value(this%latheatvap, 'LATHEATVAP', this%input_mempath, &
755  found%latheatvap)
756 
757  ! -- update internal state
758  if (found%save_flows) this%ipakcb = -1
759  if (found%ord0_decay_water .and. &
760  found%ord0_decay_solid) then
761  this%idcy = decay_zero_order
762  this%idcysrc = decay_both
763  else if (found%ord0_decay_water) then
764  this%idcy = decay_zero_order
765  this%idcysrc = decay_water
766  else if (found%ord0_decay_solid) then
767  this%idcy = decay_zero_order
768  this%idcysrc = decay_solid
769  end if
770  if (found%cpw) then
771  if (this%cpw <= 0.0) then
772  write (errmsg, '(a)') 'Specified value for the heat capacity of &
773  &water must be greater than 0.0.'
774  call store_error(errmsg)
775  call store_error_filename(this%input_fname)
776  end if
777  end if
778  if (found%rhow) then
779  if (this%rhow <= 0.0) then
780  write (errmsg, '(a)') 'Specified value for the density of &
781  &water must be greater than 0.0.'
782  call store_error(errmsg)
783  call store_error_filename(this%input_fname)
784  end if
785  end if
786 
787  ! -- log options
788  call this%log_options(found)
789  end subroutine source_options
790 
791  !> @brief Write user options to list file
792  !<
793  subroutine log_options(this, found)
794  ! -- modules
796  ! -- dummy
797  class(gweesttype) :: this
798  ! -- local
799  type(gweestparamfoundtype), intent(in) :: found
800  ! -- formats
801  character(len=*), parameter :: fmtisvflow = &
802  &"(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY "// &
803  &"FILE WHENEVER ICBCFL IS NOT ZERO.')"
804  character(len=*), parameter :: fmtidcy2 = &
805  "(4x,'ZERO-ORDER DECAY IN THE AQUEOUS "// &
806  &"PHASE IS ACTIVE. ')"
807  character(len=*), parameter :: fmtidcy3 = &
808  "(4x,'ZERO-ORDER DECAY IN THE SOLID "// &
809  &"PHASE IS ACTIVE. ')"
810 
811  write (this%iout, '(1x,a)') 'PROCESSING ENERGY STORAGE AND TRANSFER OPTIONS'
812  if (found%save_flows) write (this%iout, fmtisvflow)
813  if (found%ord0_decay_water) then
814  write (this%iout, fmtidcy2)
815  else if (found%ord0_decay_solid) then
816  write (this%iout, fmtidcy3)
817  end if
818  if (found%cpw) then
819  write (this%iout, '(4x,a,1pg15.6)') &
820  'Heat capacity of the water has been set to: ', &
821  this%cpw
822  end if
823  if (found%rhow) then
824  write (this%iout, '(4x,a,1pg15.6)') &
825  'Density of the water has been set to: ', &
826  this%rhow
827  end if
828  if (found%latheatvap) then
829  write (this%iout, '(4x,a,1pg15.6)') &
830  'Latent heat of vaporization of the water has been set to: ', &
831  this%latheatvap
832  end if
833  write (this%iout, '(1x,a,/)') &
834  'END PROCESSING ENERGY STORAGE AND TRANSFER OPTIONS'
835  end subroutine log_options
836 
837  !> @brief Source EST griddata from input mempath
838  !<
839  subroutine source_data(this)
840  ! -- modules
846  ! -- dummy
847  class(gweesttype) :: this
848  ! -- locals
849  character(len=LINELENGTH) :: errmsg
850  type(gweestparamfoundtype) :: found
851  integer(I4B), dimension(:), pointer, contiguous :: map
852  integer(I4B) :: asize
853  ! -- formats
854 
855  ! -- set map
856  map => null()
857  if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
858 
859  ! -- reallocate
860  if (this%idcy == decay_off) then
861  call get_isize('DECAY_WATER', this%input_mempath, asize)
862  if (asize > 0) &
863  call mem_reallocate(this%decay_water, this%dis%nodes, 'DECAY_WATER', &
864  trim(this%memoryPath))
865  call get_isize('DECAY_SOLID', this%input_mempath, asize)
866  if (asize > 0) &
867  call mem_reallocate(this%decay_solid, this%dis%nodes, 'DECAY_SOLID', &
868  trim(this%memoryPath))
869  end if
870 
871  ! -- update defaults with idm sourced values
872  call mem_set_value(this%porosity, 'POROSITY', this%input_mempath, map, &
873  found%porosity)
874  call mem_set_value(this%decay_water, 'DECAY_WATER', this%input_mempath, map, &
875  found%decay_water)
876  call mem_set_value(this%decay_solid, 'DECAY_SOLID', this%input_mempath, map, &
877  found%decay_solid)
878  call mem_set_value(this%cps, 'CPS', this%input_mempath, map, found%cps)
879  call mem_set_value(this%rhos, 'RHOS', this%input_mempath, map, found%rhos)
880 
881  ! -- Check for required params
882  if (.not. found%porosity) then
883  write (errmsg, '(a)') 'Porosity not specified in griddata block.'
884  call store_error(errmsg)
885  end if
886  if (.not. found%cps) then
887  write (errmsg, '(a)') 'HEAT_CAPACITY_SOLID not specified in griddata block.'
888  call store_error(errmsg)
889  end if
890  if (.not. found%rhos) then
891  write (errmsg, '(a)') 'DENSITY_SOLID not specified in griddata block.'
892  call store_error(errmsg)
893  end if
894 
895  ! -- log griddata
896  write (this%iout, '(1x,a)') 'PROCESSING ENERGY STORAGE AND TRANSFER GRIDDATA'
897  if (found%porosity) &
898  write (this%iout, '(4x,a)') 'POROSITY set from input file'
899  if (found%decay_water) &
900  write (this%iout, '(4x,a)') 'DECAY_WATER set from input file'
901  if (found%decay_solid) &
902  write (this%iout, '(4x,a)') 'DECAY_SOLID set from input file'
903  if (found%cps) &
904  write (this%iout, '(4x,a)') 'HEAT_CAPACITY_SOLID set from input file'
905  if (found%rhos) &
906  write (this%iout, '(4x,a)') 'DENSITY_SOLID set from input file'
907  write (this%iout, '(1x,a)') &
908  'END PROCESSING ENERGY STORAGE AND TRANSFER GRIDDATA'
909 
910  ! -- Check for required decay/production rate coefficients
911  if (this%idcy == decay_zero_order) then
912  if (.not. (found%decay_water .or. found%decay_solid)) then
913  write (errmsg, '(a)') 'Zero order decay in either the aqueous &
914  &or solid phase is active but the corresponding zero-order &
915  &rate coefficient is not specified. Either DECAY_WATER or &
916  &DECAY_SOLID must be specified in the griddata block.'
917  call store_error(errmsg)
918  end if
919  else
920  if (found%decay_water) then
921  write (warnmsg, '(a)') 'Zero order decay in the aqueous phase has &
922  &not been activated but DECAY_WATER has been specified. Zero &
923  &order decay in the aqueous phase will have no affect on &
924  &simulation results.'
925  call store_warning(warnmsg)
926  write (this%iout, '(/1x,a)') 'WARNING: '//trim(warnmsg)
927  else if (found%decay_solid) then
928  write (warnmsg, '(a)') 'Zero order decay in the solid phase has not &
929  &been activated but DECAY_SOLID has been specified. Zero order &
930  &decay in the solid phase will have no affect on simulation &
931  &results.'
932  call store_warning(warnmsg)
933  write (this%iout, '(/1x,a)') 'WARNING: '//trim(warnmsg)
934  end if
935  end if
936 
937  ! -- terminate if errors
938  if (count_errors() > 0) then
939  call store_error_filename(this%input_fname)
940  end if
941  end subroutine source_data
942 
943 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
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
@ brief Energy Storage and Transfer (EST) Module
Definition: gwe-est.f90:13
subroutine source_options(this)
Update simulation mempath options.
Definition: gwe-est.f90:735
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:652
subroutine log_options(this, found)
Write user options to list file.
Definition: gwe-est.f90:794
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:680
subroutine, public est_cr(estobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac, gwecommon)
@ brief Create a new EST package object
Definition: gwe-est.f90:105
subroutine est_cq(this, nodes, cnew, cold, flowja)
@ brief Calculate flows for package
Definition: gwe-est.f90:348
subroutine source_data(this)
Source EST griddata from input mempath.
Definition: gwe-est.f90:840
subroutine est_bd(this, isuppress_output, model_budget)
@ brief Calculate budget terms for package
Definition: gwe-est.f90:526
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:617
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:564
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
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
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
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
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.