40 integer(I4B),
pointer :: msum => null()
41 integer(I4B),
pointer :: maxsize => null()
42 real(dp),
pointer :: budperc => null()
43 logical,
pointer :: written_once => null()
44 real(dp),
dimension(:, :),
pointer :: vbvl => null()
45 character(len=LENBUDTXT),
dimension(:),
pointer,
contiguous :: vbnm => null()
46 character(len=20),
pointer :: bdtype => null()
47 character(len=5),
pointer :: bddim => null()
48 character(len=LENBUDROWLABEL), &
49 dimension(:),
pointer,
contiguous :: rowlabel => null()
50 character(len=16),
pointer :: labeltitle => null()
51 character(len=20),
pointer :: bdzone => null()
52 logical,
pointer :: labeled => null()
55 integer(I4B),
pointer :: ibudcsv => null()
56 integer(I4B),
pointer :: icsvheader => null()
87 character(len=*),
intent(in) :: name_model
93 call this%allocate_scalars(name_model)
104 subroutine budget_df(this, maxsize, bdtype, bddim, labeltitle, bdzone)
106 integer(I4B),
intent(in) :: maxsize
107 character(len=*),
optional :: bdtype
108 character(len=*),
optional :: bddim
109 character(len=*),
optional :: labeltitle
110 character(len=*),
optional :: bdzone
113 this%maxsize = maxsize
116 call this%allocate_arrays()
119 if (
present(bdtype))
then
122 this%bdtype =
'VOLUME'
126 if (
present(bddim))
then
133 if (
present(bdzone))
then
136 this%bdzone =
'ENTIRE MODEL'
140 if (
present(labeltitle))
then
141 this%labeltitle = labeltitle
143 this%labeltitle =
'PACKAGE NAME'
157 real(DP),
intent(in) :: val
158 character(len=*),
intent(out) :: string
159 real(DP),
intent(in) :: big
160 real(DP),
intent(in) :: small
164 if (val /=
dzero .and. (absval >= big .or. absval < small))
then
165 if (absval >= 1.d100 .or. absval <= 1.d-100)
then
168 write (string,
'(es17.4E3)') val
170 write (string,
'(1pe17.4)') val
174 write (string,
'(f17.4)') val
187 integer(I4B),
intent(in) :: kstp
188 integer(I4B),
intent(in) :: kper
189 integer(I4B),
intent(in) :: iout
190 character(len=17) :: val1, val2
191 integer(I4B) :: msum1, l
192 real(DP) :: two, hund, bigvl1, bigvl2, small, &
193 totrin, totrot, totvin, totvot, diffr, adiffr, &
194 pdiffr, pdiffv, avgrat, diffv, adiffv, avgvol
205 msum1 = this%msum - 1
206 if (msum1 <= 0)
return
216 totrin = totrin + this%vbvl(3, l)
217 totrot = totrot + this%vbvl(4, l)
218 totvin = totvin + this%vbvl(1, l)
219 totvot = totvot + this%vbvl(2, l)
223 if (this%labeled)
then
224 write (iout, 261) trim(adjustl(this%bdtype)), trim(adjustl(this%bdzone)), &
226 write (iout, 266) trim(adjustl(this%bdtype)), trim(adjustl(this%bddim)), &
227 trim(adjustl(this%bddim)), this%labeltitle
229 write (iout, 260) trim(adjustl(this%bdtype)), trim(adjustl(this%bdzone)), &
231 write (iout, 265) trim(adjustl(this%bdtype)), trim(adjustl(this%bddim)), &
232 trim(adjustl(this%bddim))
239 if (this%labeled)
then
240 write (iout, 276) this%vbnm(l), val1, this%vbnm(l), val2, this%rowlabel(l)
242 write (iout, 275) this%vbnm(l), val1, this%vbnm(l), val2
247 write (iout, 286) val1, val2
254 if (this%labeled)
then
255 write (iout, 276) this%vbnm(l), val1, this%vbnm(l), val2, this%rowlabel(l)
257 write (iout, 275) this%vbnm(l), val1, this%vbnm(l), val2
262 write (iout, 298) val1, val2
267 diffr = totrin - totrot
272 avgrat = (totrin + totrot) / two
273 if (avgrat /=
dzero) pdiffr = hund * diffr / avgrat
274 this%budperc = pdiffr
277 diffv = totvin - totvot
282 avgvol = (totvin + totvot) / two
283 if (avgvol /=
dzero) pdiffv = hund * diffv / avgvol
289 write (iout, 299) val1, val2
290 write (iout, 300) pdiffv, pdiffr
296 this%written_once = .true.
299 260
FORMAT(//2x, a,
' BUDGET FOR ', a,
' AT END OF' &
300 ,
' TIME STEP', i5,
', STRESS PERIOD', i4 / 2x, 78(
'-'))
301 261
FORMAT(//2x, a,
' BUDGET FOR ', a,
' AT END OF' &
302 ,
' TIME STEP', i5,
', STRESS PERIOD', i4 / 2x, 99(
'-'))
303 265
FORMAT(1x, /5x,
'CUMULATIVE ', a, 6x, a, 7x &
304 ,
'RATES FOR THIS TIME STEP', 6x, a,
'/T'/5x, 18(
'-'), 17x, 24(
'-') &
305 //11x,
'IN:', 38x,
'IN:'/11x,
'---', 38x,
'---')
306 266
FORMAT(1x, /5x,
'CUMULATIVE ', a, 6x, a, 7x &
307 ,
'RATES FOR THIS TIME STEP', 6x, a,
'/T', 10x, a16, &
308 /5x, 18(
'-'), 17x, 24(
'-'), 21x, 16(
'-') &
309 //11x,
'IN:', 38x,
'IN:'/11x,
'---', 38x,
'---')
310 275
FORMAT(1x, 3x, a16,
' =', a17, 6x, a16,
' =', a17)
311 276
FORMAT(1x, 3x, a16,
' =', a17, 6x, a16,
' =', a17, 5x, a)
312 286
FORMAT(1x, /12x,
'TOTAL IN =', a, 14x,
'TOTAL IN =', a)
313 287
FORMAT(1x, /10x,
'OUT:', 37x,
'OUT:'/10x, 4(
'-'), 37x, 4(
'-'))
314 298
FORMAT(1x, /11x,
'TOTAL OUT =', a, 13x,
'TOTAL OUT =', a)
315 299
FORMAT(1x, /12x,
'IN - OUT =', a, 14x,
'IN - OUT =', a)
316 300
FORMAT(1x, /1x,
'PERCENT DISCREPANCY =', f15.2 &
317 , 5x,
'PERCENT DISCREPANCY =', f15.2/)
332 deallocate (this%msum)
333 deallocate (this%maxsize)
334 deallocate (this%budperc)
335 deallocate (this%written_once)
336 deallocate (this%labeled)
337 deallocate (this%bdtype)
338 deallocate (this%bddim)
339 deallocate (this%labeltitle)
340 deallocate (this%bdzone)
341 deallocate (this%ibudcsv)
342 deallocate (this%icsvheader)
345 deallocate (this%vbvl)
346 deallocate (this%vbnm)
347 deallocate (this%rowlabel)
366 do i = 1, this%maxsize
367 this%vbvl(3, i) =
dzero
368 this%vbvl(4, i) =
dzero
390 isupress_accumulate, rowlabel)
393 real(DP),
intent(in) :: rin
394 real(DP),
intent(in) :: rout
395 real(DP),
intent(in) :: delt
396 character(len=LENBUDTXT),
intent(in) :: text
397 integer(I4B),
optional,
intent(in) :: isupress_accumulate
398 character(len=*),
optional,
intent(in) :: rowlabel
400 character(len=LINELENGTH) :: errmsg
401 character(len=*),
parameter :: fmtbuderr = &
402 &
"('Error in MODFLOW 6.', 'Entries do not match: ', (a), (a) )"
404 integer(I4B) :: maxsize
407 if (
present(isupress_accumulate))
then
408 iscv = isupress_accumulate
413 if (maxsize > this%maxsize)
then
414 call this%resize(maxsize)
419 if (this%written_once)
then
420 if (trim(adjustl(this%vbnm(this%msum))) /= trim(adjustl(text)))
then
421 write (errmsg, fmtbuderr) trim(adjustl(this%vbnm(this%msum))), &
427 this%vbvl(3, this%msum) = rin
428 this%vbvl(4, this%msum) = rout
429 this%vbnm(this%msum) = adjustr(text)
430 if (
present(rowlabel))
then
431 this%rowlabel(this%msum) = adjustl(rowlabel)
432 this%labeled = .true.
434 this%msum = this%msum + 1
455 isupress_accumulate, rowlabel)
458 real(DP),
dimension(:, :),
intent(in) :: budterm
459 real(DP),
intent(in) :: delt
460 character(len=LENBUDTXT),
dimension(:),
intent(in) :: budtxt
461 integer(I4B),
optional,
intent(in) :: isupress_accumulate
462 character(len=*),
optional,
intent(in) :: rowlabel
464 character(len=LINELENGTH) :: errmsg
465 character(len=*),
parameter :: fmtbuderr = &
466 &
"('Error in MODFLOW 6.', 'Entries do not match: ', (a), (a) )"
467 integer(i4b) :: iscv, i
468 integer(I4B) :: nbudterms, maxsize
471 if (
present(isupress_accumulate))
then
472 iscv = isupress_accumulate
476 nbudterms =
size(budtxt)
477 maxsize = this%msum - 1 + nbudterms
478 if (maxsize > this%maxsize)
then
479 call this%resize(maxsize)
483 do i = 1,
size(budtxt)
487 if (this%written_once)
then
488 if (trim(adjustl(this%vbnm(this%msum))) /= &
489 trim(adjustl(budtxt(i))))
then
490 write (errmsg, fmtbuderr) trim(adjustl(this%vbnm(this%msum))), &
491 trim(adjustl(budtxt(i)))
496 this%vbvl(3, this%msum) = budterm(1, i)
497 this%vbvl(4, this%msum) = budterm(2, i)
498 this%vbnm(this%msum) = adjustr(budtxt(i))
499 if (
present(rowlabel))
then
500 this%rowlabel(this%msum) = adjustl(rowlabel)
501 this%labeled = .true.
503 this%msum = this%msum + 1
509 call store_error(
'Could not add multi-entry', terminate=.true.)
526 real(DP),
intent(in) :: delt
530 do i = 1, this%msum - 1
531 this%vbvl(1, i) = this%vbvl(1, i) + this%vbvl(3, i) * delt
532 this%vbvl(2, i) = this%vbvl(2, i) + this%vbvl(4, i) * delt
548 character(len=*),
intent(in) :: name_model
551 allocate (this%maxsize)
552 allocate (this%budperc)
553 allocate (this%written_once)
554 allocate (this%labeled)
555 allocate (this%bdtype)
556 allocate (this%bddim)
557 allocate (this%labeltitle)
558 allocate (this%bdzone)
559 allocate (this%ibudcsv)
560 allocate (this%icsvheader)
565 this%written_once = .false.
566 this%labeled = .false.
588 if (
associated(this%vbvl))
then
589 deallocate (this%vbvl)
592 if (
associated(this%vbnm))
then
593 deallocate (this%vbnm)
596 if (
associated(this%rowlabel))
then
597 deallocate (this%rowlabel)
598 nullify (this%rowlabel)
602 allocate (this%vbvl(4, this%maxsize))
603 allocate (this%vbnm(this%maxsize))
604 allocate (this%rowlabel(this%maxsize))
607 this%vbvl(:, :) =
dzero
609 this%rowlabel(:) =
''
624 integer(I4B),
intent(in) :: maxsize
626 real(DP),
dimension(:, :),
allocatable :: vbvl
627 character(len=LENBUDTXT),
dimension(:),
allocatable :: vbnm
628 character(len=LENBUDROWLABEL),
dimension(:),
allocatable :: rowlabel
629 integer(I4B) :: maxsizeold
632 maxsizeold = this%maxsize
633 allocate (vbvl(4, maxsizeold))
634 allocate (vbnm(maxsizeold))
635 allocate (rowlabel(maxsizeold))
636 vbvl(:, :) = this%vbvl(:, :)
637 vbnm(:) = this%vbnm(:)
638 rowlabel(:) = this%rowlabel(:)
641 this%maxsize = maxsize
642 call this%allocate_arrays()
645 this%vbvl(:, 1:maxsizeold) = vbvl(:, 1:maxsizeold)
646 this%vbnm(1:maxsizeold) = vbnm(1:maxsizeold)
647 this%rowlabel(1:maxsizeold) = rowlabel(1:maxsizeold)
652 deallocate (rowlabel)
666 real(dp),
dimension(:),
contiguous,
intent(in) :: flow
667 real(dp),
intent(out) :: rin
668 real(dp),
intent(out) :: rout
674 if (flow(n) <
dzero)
then
675 rout = rout - flow(n)
693 integer(I4B),
intent(in) :: ibudcsv
694 this%ibudcsv = ibudcsv
709 real(DP),
intent(in) :: totim
718 if (this%ibudcsv > 0)
then
721 if (this%icsvheader == 0)
then
722 call this%write_csv_header()
729 do i = 1, this%msum - 1
730 totrin = totrin + this%vbvl(3, i)
731 totrout = totrout + this%vbvl(4, i)
735 diffr = totrin - totrout
737 avgrat = (totrin + totrout) /
dtwo
738 if (avgrat /=
dzero)
then
743 write (this%ibudcsv,
'(*(G0,:,","))') &
745 (this%vbvl(3, i), i=1, this%msum - 1), &
746 (this%vbvl(4, i), i=1, this%msum - 1), &
747 totrin, totrout, pdiffr
769 character(len=LINELENGTH) :: txt, txtl
770 write (this%ibudcsv,
'(a)', advance=
'NO')
'time,'
773 do l = 1, this%msum - 1
776 if (this%labeled)
then
777 txtl =
'('//trim(adjustl(this%rowlabel(l)))//
')'
779 txt = trim(adjustl(txt))//trim(adjustl(txtl))//
'_IN,'
780 write (this%ibudcsv,
'(a)', advance=
'NO') trim(adjustl(txt))
784 do l = 1, this%msum - 1
787 if (this%labeled)
then
788 txtl =
'('//trim(adjustl(this%rowlabel(l)))//
')'
790 txt = trim(adjustl(txt))//trim(adjustl(txtl))//
'_OUT,'
791 write (this%ibudcsv,
'(a)', advance=
'NO') trim(adjustl(txt))
793 write (this%ibudcsv,
'(a)')
'TOTAL_IN,TOTAL_OUT,PERCENT_DIFFERENCE'
This module contains the BudgetModule.
subroutine budget_ot(this, kstp, kper, iout)
@ brief Output the budget table
subroutine budget_da(this)
@ brief Deallocate memory
subroutine value_to_string(val, string, big, small)
@ brief Convert a number to a string
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
subroutine allocate_scalars(this, name_model)
@ brief allocate scalar variables
subroutine add_single_entry(this, rin, rout, delt, text, isupress_accumulate, rowlabel)
@ brief Add a single row of information
subroutine writecsv(this, totim)
@ brief Write csv output
subroutine write_csv_header(this)
@ brief Write csv header
subroutine resize(this, maxsize)
@ brief Resize the budget object
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
subroutine allocate_arrays(this)
@ brief allocate array variables
subroutine budget_df(this, maxsize, bdtype, bddim, labeltitle, bdzone)
@ brief Define information for this object
subroutine add_multi_entry(this, budterm, delt, budtxt, isupress_accumulate, rowlabel)
@ brief Add multiple rows of information
subroutine finalize_step(this, delt)
@ brief Update accumulators
subroutine reset(this)
@ brief Reset the budget object
subroutine set_ibudcsv(this, ibudcsv)
@ brief Set unit number for csv output file
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenbudrowlabel
maximum length of the rowlabel string used in the budget table
real(dp), parameter dhundred
real constant 100
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
This module defines variable data types.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
Derived type for the Budget object.