31 character(len=LENBUDTXT),
dimension(NBDITEMS) ::
budtxt
32 data budtxt/
' STORAGE-CELLBLK',
' DECAY-AQUEOUS',
' DECAY-SOLID'/
51 real(dp),
pointer :: cpw => null()
52 real(dp),
pointer :: rhow => null()
53 real(dp),
pointer :: latheatvap => null()
54 real(dp),
dimension(:),
pointer,
contiguous :: cps => null()
55 real(dp),
dimension(:),
pointer,
contiguous :: rhos => null()
56 real(dp),
dimension(:),
pointer,
contiguous :: porosity => null()
57 real(dp),
dimension(:),
pointer,
contiguous :: ratesto => null()
60 integer(I4B),
pointer :: idcy => null()
61 integer(I4B),
pointer :: idcysrc => null()
62 real(dp),
dimension(:),
pointer,
contiguous ::
decay_water => null()
63 real(dp),
dimension(:),
pointer,
contiguous ::
decay_solid => null()
64 real(dp),
dimension(:),
pointer,
contiguous :: ratedcyw => null()
65 real(dp),
dimension(:),
pointer,
contiguous :: ratedcys => null()
66 real(dp),
dimension(:),
pointer,
contiguous :: decaylastw => null()
67 real(dp),
dimension(:),
pointer,
contiguous :: decaylasts => null()
70 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
73 real(dp),
pointer :: eqnsclfac => null()
102 subroutine est_cr(estobj, name_model, inunit, iout, fmi, eqnsclfac, gwecommon)
105 character(len=*),
intent(in) :: name_model
106 integer(I4B),
intent(in) :: inunit
107 integer(I4B),
intent(in) :: iout
109 real(dp),
intent(in),
pointer :: eqnsclfac
116 call estobj%set_names(1, name_model,
'EST',
'EST')
119 call estobj%allocate_scalars()
122 estobj%inunit = inunit
125 estobj%eqnsclfac => eqnsclfac
126 estobj%gwecommon => gwecommon
129 call estobj%parser%Initialize(estobj%inunit, estobj%iout)
142 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
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, //)"
149 write (this%iout, fmtest) this%inunit
152 call this%read_options()
156 this%ibound => ibound
159 call this%allocate_arrays(dis%nodes)
162 call this%read_data()
165 call this%gwecommon%set_gwe_dat_ptrs(this%rhow, this%cpw, this%latheatvap, &
173 subroutine est_fc(this, nodes, cold, nja, matrix_sln, idxglo, cnew, &
177 integer,
intent(in) :: nodes
178 real(DP),
intent(in),
dimension(nodes) :: cold
179 integer(I4B),
intent(in) :: nja
181 integer(I4B),
intent(in),
dimension(nja) :: idxglo
182 real(DP),
intent(inout),
dimension(nodes) :: rhs
183 real(DP),
intent(in),
dimension(nodes) :: cnew
184 integer(I4B),
intent(in) :: kiter
187 call this%est_fc_sto(nodes, cold, nja, matrix_sln, idxglo, rhs)
191 call this%est_fc_dcy_water(nodes, cold, cnew, nja, matrix_sln, idxglo, &
193 call this%est_fc_dcy_solid(nodes, cold, nja, matrix_sln, idxglo, rhs, &
202 subroutine est_fc_sto(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
207 integer,
intent(in) :: nodes
208 real(DP),
intent(in),
dimension(nodes) :: cold
209 integer(I4B),
intent(in) :: nja
211 integer(I4B),
intent(in),
dimension(nja) :: idxglo
212 real(DP),
intent(inout),
dimension(nodes) :: rhs
214 integer(I4B) :: n, idiag
216 real(DP) :: hhcof, rrhs
217 real(DP) :: vnew, vold, vcell, vsolid, term
223 do n = 1, this%dis%nodes
226 if (this%ibound(n) <= 0) cycle
229 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
230 vnew = vcell * this%fmi%gwfsat(n) * this%porosity(n)
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))
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
254 integer,
intent(in) :: nodes
255 real(DP),
intent(in),
dimension(nodes) :: cold
256 real(DP),
intent(in),
dimension(nodes) :: cnew
257 integer(I4B),
intent(in) :: nja
259 integer(I4B),
intent(in),
dimension(nja) :: idxglo
260 real(DP),
intent(inout),
dimension(nodes) :: rhs
261 integer(I4B),
intent(in) :: kiter
267 real(DP) :: decay_rate
270 do n = 1, this%dis%nodes
273 if (this%ibound(n) <= 0) cycle
276 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
277 swtpdt = this%fmi%gwfsat(n)
283 decay_rate = this%decay_water(n)
286 this%decaylastw(n) = decay_rate
287 rrhs = decay_rate * vcell * swtpdt * this%porosity(n)
288 rhs(n) = rhs(n) + rrhs
302 integer,
intent(in) :: nodes
303 real(DP),
intent(in),
dimension(nodes) :: cold
304 integer(I4B),
intent(in) :: nja
306 integer(I4B),
intent(in),
dimension(nja) :: idxglo
307 real(DP),
intent(inout),
dimension(nodes) :: rhs
308 real(DP),
intent(in),
dimension(nodes) :: cnew
309 integer(I4B),
intent(in) :: kiter
314 real(DP) :: decay_rate
317 do n = 1, this%dis%nodes
320 if (this%ibound(n) <= 0) cycle
324 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
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
347 subroutine est_cq(this, nodes, cnew, cold, flowja)
350 integer(I4B),
intent(in) :: nodes
351 real(DP),
intent(in),
dimension(nodes) :: cnew
352 real(DP),
intent(in),
dimension(nodes) :: cold
353 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
357 call this%est_cq_sto(nodes, cnew, cold, flowja)
362 call this%est_cq_dcy(nodes, cnew, cold, flowja)
365 call this%est_cq_dcy_solid(nodes, cnew, cold, flowja)
379 integer(I4B),
intent(in) :: nodes
380 real(DP),
intent(in),
dimension(nodes) :: cnew
381 real(DP),
intent(in),
dimension(nodes) :: cold
382 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
385 integer(I4B) :: idiag
388 real(DP) :: vwatnew, vwatold, vcell, vsolid, term
389 real(DP) :: hhcof, rrhs
396 this%ratesto(n) =
dzero
399 if (this%ibound(n) <= 0) cycle
402 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
403 vwatnew = vcell * this%fmi%gwfsat(n) * this%porosity(n)
405 if (this%fmi%igwfstrgss /= 0) vwatold = vwatold + this%fmi%gwfstrgss(n) &
407 if (this%fmi%igwfstrgsy /= 0) vwatold = vwatold + this%fmi%gwfstrgsy(n) &
409 vsolid = vcell * (
done - this%porosity(n))
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
429 integer(I4B),
intent(in) :: nodes
430 real(DP),
intent(in),
dimension(nodes) :: cnew
431 real(DP),
intent(in),
dimension(nodes) :: cold
432 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
435 integer(I4B) :: idiag
438 real(DP) :: hhcof, rrhs
440 real(DP) :: decay_rate
446 this%ratedcyw(n) =
dzero
447 if (this%ibound(n) <= 0) cycle
450 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
451 swtpdt = this%fmi%gwfsat(n)
460 decay_rate = this%decay_water(n)
463 rrhs = decay_rate * vcell * swtpdt * this%porosity(n)
465 rate = hhcof * cnew(n) - rrhs
466 this%ratedcyw(n) = rate
467 idiag = this%dis%con%ia(n)
468 flowja(idiag) = flowja(idiag) + rate
480 integer(I4B),
intent(in) :: nodes
481 real(DP),
intent(in),
dimension(nodes) :: cnew
482 real(DP),
intent(in),
dimension(nodes) :: cold
483 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
486 integer(I4B) :: idiag
488 real(DP) :: hhcof, rrhs
490 real(DP) :: decay_rate
496 this%ratedcys(n) =
dzero
497 if (this%ibound(n) <= 0) cycle
500 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
509 decay_rate = this%decay_solid(n)
512 rrhs = decay_rate * vcell * (1 - this%porosity(n)) * this%rhos(n)
514 rate = hhcof * cnew(n) - rrhs
515 this%ratedcys(n) = rate
516 idiag = this%dis%con%ia(n)
517 flowja(idiag) = flowja(idiag) + rate
526 subroutine est_bd(this, isuppress_output, model_budget)
532 integer(I4B),
intent(in) :: isuppress_output
533 type(
budgettype),
intent(inout) :: model_budget
540 call model_budget%addentry(rin, rout,
delt,
budtxt(1), &
541 isuppress_output, rowlabel=this%packName)
548 call model_budget%addentry(rin, rout,
delt,
budtxt(2), &
549 isuppress_output, rowlabel=this%packName)
554 call model_budget%addentry(rin, rout,
delt,
budtxt(3), &
555 isuppress_output, rowlabel=this%packName)
567 integer(I4B),
intent(in) :: icbcfl
568 integer(I4B),
intent(in) :: icbcun
570 integer(I4B) :: ibinun
571 integer(I4B) :: iprint, nvaluesp, nwidthp
572 character(len=1) :: cdatafmp =
' ', editdesc =
' '
576 if (this%ipakcb < 0)
then
578 elseif (this%ipakcb == 0)
then
583 if (icbcfl == 0) ibinun = 0
586 if (ibinun /= 0)
then
591 call this%dis%record_array(this%ratesto, this%iout, iprint, -ibinun, &
592 budtxt(1), cdatafmp, nvaluesp, &
593 nwidthp, editdesc, dinact)
599 call this%dis%record_array(this%ratedcyw, this%iout, iprint, &
600 -ibinun,
budtxt(2), cdatafmp, nvaluesp, &
601 nwidthp, editdesc, dinact)
605 call this%dis%record_array(this%ratedcys, this%iout, iprint, &
606 -ibinun,
budtxt(3), cdatafmp, nvaluesp, &
607 nwidthp, editdesc, dinact)
624 if (this%inunit > 0)
then
640 this%ibound => null()
647 call this%NumericalPackageType%da()
661 call this%NumericalPackageType%allocate_scalars()
666 call mem_allocate(this%latheatvap,
'LATHEATVAP', this%memoryPath)
668 call mem_allocate(this%idcysrc,
'IDCYSRC', this%memoryPath)
673 this%latheatvap =
dzero
688 integer(I4B),
intent(in) :: nodes
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)
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)
708 call mem_allocate(this%ratedcyw, this%dis%nodes,
'RATEDCYW', &
710 call mem_allocate(this%ratedcys, this%dis%nodes,
'RATEDCYS', &
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)
720 this%porosity(n) =
dzero
721 this%ratesto(n) =
dzero
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
745 character(len=LINELENGTH) :: keyword
747 logical :: isfound, endOfBlock
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. ')"
762 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
763 supportopenclose=.true.)
767 write (this%iout,
'(1x,a)')
'PROCESSING ENERGY STORAGE AND TRANSFER OPTIONS'
769 call this%parser%GetNextLine(endofblock)
771 call this%parser%GetStringCaps(keyword)
772 select case (keyword)
775 write (this%iout, fmtisvflow)
776 case (
'ZERO_ORDER_DECAY_WATER')
780 if (this%idcysrc > izero)
then
785 write (this%iout, fmtidcy2)
786 case (
'ZERO_ORDER_DECAY_SOLID')
790 if (this%idcysrc > izero)
then
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.'
802 call this%parser%StoreErrorUnit()
804 write (this%iout,
'(4x,a,1pg15.6)') &
805 'Heat capacity of the water has been set to: ', &
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.'
814 call this%parser%StoreErrorUnit()
816 write (this%iout,
'(4x,a,1pg15.6)') &
817 'Density of the water has been set to: ', &
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: ', &
826 write (
errmsg,
'(a,a)')
'Unknown EST option: ', trim(keyword)
828 call this%parser%StoreErrorUnit()
831 write (this%iout,
'(1x,a)')
'END OF ENERGY STORAGE AND TRANSFER OPTIONS'
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
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'/
865 call this%parser%GetBlock(
'GRIDDATA', isfound, ierr)
867 write (this%iout,
'(1x,a)')
'PROCESSING GRIDDATA'
869 call this%parser%GetNextLine(endofblock)
871 call this%parser%GetStringCaps(keyword)
872 call this%parser%GetRemainingLine(line)
874 select case (keyword)
876 call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
877 this%parser%iuactive, this%porosity, &
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, &
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, &
896 case (
'HEAT_CAPACITY_SOLID')
897 call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
898 this%parser%iuactive, this%cps, &
901 case (
'DENSITY_SOLID')
902 call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
903 this%parser%iuactive, this%rhos, &
907 write (
errmsg,
'(a,a)')
'Unknown griddata tag: ', trim(keyword)
909 call this%parser%StoreErrorUnit()
912 write (this%iout,
'(1x,a)')
'END PROCESSING GRIDDATA'
914 write (
errmsg,
'(a)')
'Required griddata block not found.'
916 call this%parser%StoreErrorUnit()
920 if (.not. lname(1))
then
921 write (
errmsg,
'(a)')
'Porosity not specified in griddata block.'
924 if (.not. lname(4))
then
925 write (
errmsg,
'(a)')
'HEAT_CAPACITY_SOLID not specified in griddata block.'
928 if (.not. lname(5))
then
929 write (
errmsg,
'(a)')
'DENSITY_SOLID not specified in griddata block.'
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.'
944 write (
warnmsg,
'(a)')
'Zero order decay in the aqueous phase has &
945 ¬ been activated but DECAY_WATER has been specified. Zero &
946 &order decay in the aqueous phase will have no affect on &
947 &simulation results.'
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 &
956 write (this%iout,
'(1x,a)')
'WARNING. '//
warnmsg
962 call this%parser%StoreErrorUnit()
This module contains the BudgetModule.
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dep3
real constant 1000
real(dp), parameter dhalf
real constant 1/2
integer(i4b), parameter izero
integer constant zero
real(dp), parameter dzero
real constant zero
real(dp), parameter dtwo
real constant 2
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
real(dp), parameter done
real constant 1
– @ brief Energy Storage and Transfer (EST) Module
subroutine est_cq_dcy_solid(this, nodes, cnew, cold, flowja)
@ brief Calculate decay terms for solid phase
subroutine est_cq_sto(this, nodes, cnew, cold, flowja)
@ brief Calculate storage terms for package
@ decay_off
Decay (or production) of thermal energy inactive (default)
@ decay_zero_order
Zeroth-order decay.
@ decay_water
Zeroth-order decay in water only.
@ decay_solid
Zeroth-order decay in solid only.
@ decay_both
Zeroth-order decay in water and solid.
integer(i4b), parameter nbditems
subroutine est_cq_dcy(this, nodes, cnew, cold, flowja)
@ brief Calculate decay terms for aqueous phase
character(len=lenbudtxt), dimension(nbditems) budtxt
subroutine est_fc_sto(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
@ brief Fill storage coefficient method for package
subroutine allocate_scalars(this)
@ brief Allocate scalar variables for package
subroutine est_ar(this, dis, ibound)
@ brief Allocate and read method for package
subroutine est_fc(this, nodes, cold, nja, matrix_sln, idxglo, cnew, rhs, kiter)
@ brief Fill coefficient method for package
subroutine allocate_arrays(this, nodes)
@ brief Allocate arrays for package
subroutine, public est_cr(estobj, name_model, inunit, iout, fmi, eqnsclfac, gwecommon)
@ brief Create a new EST package object
subroutine est_cq(this, nodes, cnew, cold, flowja)
@ brief Calculate flows for package
subroutine est_bd(this, isuppress_output, model_budget)
@ brief Calculate budget terms for package
subroutine read_data(this)
@ brief Read data for package
subroutine est_fc_dcy_solid(this, nodes, cold, nja, matrix_sln, idxglo, rhs, cnew, kiter)
@ brief Fill solid decay coefficient method for package
subroutine est_da(this)
Deallocate memory.
subroutine read_options(this)
@ brief Read options for package
subroutine est_fc_dcy_water(this, nodes, cold, cnew, nja, matrix_sln, idxglo, rhs, kiter)
@ brief Fill decay coefficient method for package
subroutine est_ot_flow(this, icbcfl, icbcun)
@ brief Output flow terms for package
This module defines variable data types.
This module contains the base numerical package type.
This module contains simulation methods.
subroutine, public store_warning(msg, substring)
Store warning message.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
This module contains simulation variables.
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
Derived type for the Budget object.
@ brief Energy storage and transfer