26 character(len=LENBUDTXT) :: name
28 integer(I4B) :: nbudterm
31 real(dp),
dimension(:),
pointer :: xnew => null()
32 real(dp),
dimension(:),
pointer :: xold => null()
35 integer(I4B) :: iflowja
36 real(dp),
dimension(:),
pointer :: flowja => null()
40 real(dp),
dimension(:, :),
pointer :: qsto => null()
52 logical,
pointer :: add_cellids => null()
53 integer(I4B),
pointer :: icellid => null()
54 integer(I4B),
pointer :: nflowterms => null()
55 integer(I4B),
dimension(:),
pointer :: istart => null()
56 integer(I4B),
dimension(:),
pointer :: iflowterms => null()
85 character(len=*),
intent(in) :: name
108 bddim_opt, labeltitle_opt, bdzone_opt, &
112 integer(I4B),
intent(in) :: ncv
113 integer(I4B),
intent(in) :: nbudterm
114 integer(I4B),
intent(in) :: iflowja
115 integer(I4B),
intent(in) :: nsto
116 character(len=*),
optional :: bddim_opt
117 character(len=*),
optional :: labeltitle_opt
118 character(len=*),
optional :: bdzone_opt
119 integer(I4B),
intent(in),
optional :: ibudcsv
121 character(len=20) :: bdtype
122 character(len=5) :: bddim
123 character(len=16) :: labeltitle
124 character(len=20) :: bdzone
128 this%nbudterm = nbudterm
129 this%iflowja = iflowja
133 allocate (this%budterm(nbudterm))
139 if (
present(bddim_opt))
then
146 if (
present(bdzone_opt))
then
149 bdzone =
'ENTIRE MODEL'
153 if (
present(labeltitle_opt))
then
154 labeltitle = labeltitle_opt
156 labeltitle =
'PACKAGE NAME'
160 call this%budtable%budget_df(nbudterm, bdtype, bddim, labeltitle, bdzone)
163 if (
present(ibudcsv))
then
164 call this%budtable%set_ibudcsv(ibudcsv)
176 integer(I4B),
intent(in) :: iout
177 character(len=*),
intent(in),
optional :: cellids
179 character(len=LINELENGTH) :: title
180 character(len=LINELENGTH) :: text
181 character(len=LENBUDTXT) :: flowtype
182 character(len=LENBUDTXT) :: tag
183 character(len=LENBUDTXT) :: coupletype
185 logical :: add_cellids
186 integer(I4B) :: maxcol
192 if (
present(cellids))
then
196 add_cellids = .false.
200 allocate (this%add_cellids)
201 allocate (this%icellid)
202 allocate (this%nflowterms)
205 this%add_cellids = add_cellids
211 if (add_cellids)
then
214 do i = 1, this%nbudterm
216 flowtype = this%budterm(i)%get_flowtype()
217 if (trim(adjustl(flowtype)) ==
'FLOW-JA-FACE')
then
220 else if (trim(adjustl(flowtype)) /=
'AUXILIARY')
then
225 this%nflowterms = this%nflowterms + 1
226 if (add_cellids)
then
227 if (trim(adjustl(flowtype)) == trim(adjustl(coupletype)))
then
235 allocate (this%istart(this%nflowterms))
236 allocate (this%iflowterms(this%nflowterms))
239 title = trim(this%name)//
' PACKAGE - SUMMARY OF FLOWS FOR '// &
240 'EACH CONTROL VOLUME'
241 call table_cr(this%flowtab, this%name, title)
242 call this%flowtab%table_df(this%ncv, maxcol, iout, transient=.true.)
246 call this%flowtab%initialize_column(text, 10, alignment=
tabcenter)
247 if (add_cellids)
then
249 call this%flowtab%initialize_column(text, 20, alignment=
tableft)
252 do i = 1, this%nbudterm
254 flowtype = this%budterm(i)%get_flowtype()
255 tag = trim(adjustl(flowtype))
256 ipos = index(tag,
'-')
260 if (trim(adjustl(flowtype)) ==
'FLOW-JA-FACE')
then
263 call this%flowtab%initialize_column(text, 12, alignment=
tabcenter)
265 call this%flowtab%initialize_column(text, 12, alignment=
tabcenter)
266 else if (trim(adjustl(flowtype)) /=
'AUXILIARY')
then
268 call this%flowtab%initialize_column(tag, 12, alignment=
tabcenter)
271 this%iflowterms(idx) = i
276 call this%flowtab%initialize_column(text, 12, alignment=
tabcenter)
277 text =
'PERCENT DIFFERENCE'
278 call this%flowtab%initialize_column(text, 12, alignment=
tabcenter)
292 character(len=LENBUDTXT) :: flowtype
294 real(DP) :: ratin, ratout
297 call this%budtable%reset()
300 do i = 1, this%nbudterm
303 flowtype = this%budterm(i)%flowtype
304 select case (trim(adjustl(flowtype)))
305 case (
'FLOW-JA-FACE')
310 call this%budterm(i)%accumulate_flow(ratin, ratout)
313 call this%budtable%addentry(ratin, ratout,
delt, flowtype)
327 integer(I4B),
intent(in) :: kstp
328 integer(I4B),
intent(in) :: kper
329 character(len=20),
dimension(:),
optional :: cellidstr
331 character(len=LENBUDTXT) :: flowtype
332 character(len=20) :: cellid
333 integer(I4B) :: nlist
351 do j = 1, this%nflowterms
356 call this%flowtab%set_kstpkper(kstp, kper)
360 call this%flowtab%add_term(icv)
367 if (this%add_cellids)
then
368 if (
present(cellidstr))
then
374 cellid = cellidstr(icv)
380 idx = this%iflowterms(j)
382 id2 = this%budterm(idx)%get_id2(i)
384 call dis%noder_to_string(id2, cellid)
389 call this%flowtab%add_term(cellid)
393 do j = 1, this%nflowterms
402 idx = this%iflowterms(j)
403 flowtype = this%budterm(idx)%get_flowtype()
404 nlist = this%budterm(idx)%get_nlist()
408 colterm:
do i = this%istart(j), nlist
409 id1 = this%budterm(idx)%get_id1(i)
410 if (this%budterm(idx)%ordered_id1)
then
423 v = this%budterm(idx)%get_flow(i)
425 if (trim(adjustl(flowtype)) ==
'FLOW-JA-FACE')
then
427 qoutflow = qoutflow + v
429 qinflow = qinflow + v
443 if (trim(adjustl(flowtype)) ==
'FLOW-JA-FACE')
then
444 call this%flowtab%add_term(qinflow)
445 call this%flowtab%add_term(qoutflow)
447 call this%flowtab%add_term(q)
453 qavg =
dhalf * (qin - qout)
455 if (qavg >
dzero)
then
458 call this%flowtab%add_term(qerr)
459 call this%flowtab%add_term(qpd)
471 integer(I4B),
intent(in) :: kstp
472 integer(I4B),
intent(in) :: kper
473 integer(I4B),
intent(in) :: iout
474 integer(I4B),
intent(in) :: ibudfl
475 real(DP),
intent(in) :: totim
476 real(DP),
intent(in) :: delt
479 call this%budtable%finalize_step(delt)
480 if (ibudfl /= 0)
then
481 call this%budtable%budget_ot(kstp, kper, iout)
483 call this%budtable%writecsv(totim)
496 integer(I4B),
intent(in) :: ibinun
497 integer(I4B),
intent(in) :: kstp
498 integer(I4B),
intent(in) :: kper
499 real(DP),
intent(in) :: delt
500 real(DP),
intent(in) :: pertim
501 real(DP),
intent(in) :: totim
502 integer(I4B),
intent(in) :: iout
507 do i = 1, this%nbudterm
508 call this%budterm(i)%save_flows(dis, ibinun, kstp, kper, delt, &
522 integer(I4B),
intent(in) :: ibinun
532 do i = 1, this%nbudterm
533 call this%budterm(i)%read_flows(dis, ibinun, kstp, kper, delt, &
550 do i = 1, this%nbudterm
551 call this%budterm(i)%deallocate_arrays()
555 if (
associated(this%flowtab))
then
556 deallocate (this%add_cellids)
557 deallocate (this%icellid)
558 deallocate (this%nflowterms)
559 deallocate (this%istart)
560 deallocate (this%iflowterms)
561 call this%flowtab%table_da()
562 deallocate (this%flowtab)
563 nullify (this%flowtab)
567 if (
associated(this%budtable))
then
568 call this%budtable%budget_da()
569 deallocate (this%budtable)
570 nullify (this%budtable)
582 character(len=*),
intent(in) :: name
583 integer(I4B),
intent(in) :: ibinun
584 integer(I4B),
intent(in) :: iout
585 character(len=16),
dimension(:),
optional :: colconv1
586 character(len=16),
dimension(:),
optional :: colconv2
588 integer(I4B) :: ncv, nbudterm
589 integer(I4B) :: iflowja, nsto
596 call this%bfr_init(ibinun, ncv, nbudterm, iout)
602 call this%budgetobject_df(ncv, nbudterm, iflowja, nsto)
606 if (
present(colconv1))
then
608 do j = 1,
size(colconv1)
609 if (colconv1(j) == adjustl(this%bfr%budtxtarray(i)))
then
610 this%budterm(i)%olconv1 = .true.
616 if (
present(colconv2))
then
618 do j = 1,
size(colconv2)
619 if (colconv2(j) == adjustl(this%bfr%budtxtarray(i)))
then
620 this%budterm(i)%olconv2 = .true.
633 subroutine bfr_init(this, ibinun, ncv, nbudterm, iout)
636 integer(I4B),
intent(in) :: ibinun
637 integer(I4B),
intent(inout) :: ncv
638 integer(I4B),
intent(inout) :: nbudterm
639 integer(I4B),
intent(in) :: iout
643 call this%bfr%initialize(ibinun, iout, ncv)
644 nbudterm = this%bfr%nbudterms
659 integer(I4B),
intent(in) :: iout
663 character(len=*),
parameter :: fmtkstpkper = &
664 &
"(1x,/1x, a, ' READING BUDGET TERMS FOR KSTP ', i0, ' KPER ', i0)"
665 character(len=*),
parameter :: fmtbudkstpkper = &
666 "(1x,/1x, a, ' SETTING BUDGET TERMS FOR KSTP ', i0, ' AND KPER ', &
667 &i0, ' TO BUDGET FILE TERMS FROM KSTP ', i0, ' AND KPER ', i0)"
677 if (this%bfr%endoffile)
then
680 if (this%bfr%kpernext ==
kper + 1 .and. this%bfr%kstpnext == 1) &
690 write (iout, fmtkstpkper) this%name,
kstp,
kper
693 call this%fill_from_bfr(dis, iout)
696 write (iout, fmtbudkstpkper) trim(this%name),
kstp,
kper, &
697 this%bfr%kstp, this%bfr%kper
710 integer(I4B),
intent(in) :: iout
716 do i = 1, this%nbudterm
717 call this%bfr%read_record(success, iout)
718 call this%budterm(i)%fill_from_bfr(this%bfr, dis)
This module contains the BudgetModule.
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
subroutine accumulate_terms(this)
Add up accumulators and submit to budget table.
subroutine, public budgetobject_cr(this, name)
Create a new budget object.
subroutine save_flows(this, dis, ibinun, kstp, kper, delt, pertim, totim, iout)
Write the budget table.
subroutine bfr_advance(this, dis, iout)
Advance the binary file readers for setting the budget terms of the next time step.
subroutine flowtable_df(this, iout, cellids)
Define the new flow table object.
subroutine write_budtable(this, kstp, kper, iout, ibudfl, totim, delt)
Write the budget table.
subroutine write_flowtable(this, dis, kstp, kper, cellidstr)
Write the flow table for each advanced package control volume.
subroutine budgetobject_df(this, ncv, nbudterm, iflowja, nsto, bddim_opt, labeltitle_opt, bdzone_opt, ibudcsv)
Define the new budget object.
subroutine bfr_init(this, ibinun, ncv, nbudterm, iout)
Initialize the budget file reader.
subroutine, public budgetobject_cr_bfr(this, name, ibinun, iout, colconv1, colconv2)
Create a new budget object from a binary flow file.
subroutine budgetobject_da(this)
Deallocate.
subroutine read_flows(this, dis, ibinun)
Read from a binary file into this BudgetObjectType.
subroutine fill_from_bfr(this, dis, iout)
Copy the information from the binary file into budterms.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ tabcenter
centered table column
@ tabright
right justified table column
@ tableft
left justified table column
@ tabucstring
upper case string table data
@ tabstring
string table data
@ tabinteger
integer table data
real(dp), parameter dhundred
real constant 100
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
This module defines variable data types.
subroutine, public table_cr(this, name, title)
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
Derived type for the Budget object.