22 character(len=LENFTYPE) ::
ftype =
'CHD'
23 character(len=LENPACKAGENAME) ::
text =
' CHD'
26 real(dp),
dimension(:),
pointer,
contiguous :: head => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: ratechdin => null()
28 real(dp),
dimension(:),
pointer,
contiguous :: ratechdout => null()
54 subroutine chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
57 class(
bndtype),
pointer :: packobj
58 integer(I4B),
intent(in) :: id
59 integer(I4B),
intent(in) :: ibcnum
60 integer(I4B),
intent(in) :: inunit
61 integer(I4B),
intent(in) :: iout
62 character(len=*),
intent(in) :: namemodel
63 character(len=*),
intent(in) :: pakname
64 character(len=*),
intent(in) :: mempath
66 type(
chdtype),
pointer :: chdobj
73 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
77 call chdobj%allocate_scalars()
80 call packobj%pack_initialize()
83 packobj%inunit = inunit
86 packobj%ibcnum = ibcnum
97 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
98 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
103 call this%BndExtType%allocate_arrays(nodelist, auxvar)
106 call mem_allocate(this%ratechdin, this%maxbound,
'RATECHDIN', this%memoryPath)
107 call mem_allocate(this%ratechdout, this%maxbound,
'RATECHDOUT', &
109 do i = 1, this%maxbound
110 this%ratechdin(i) =
dzero
111 this%ratechdout(i) =
dzero
115 call mem_setptr(this%head,
'HEAD', this%input_mempath)
118 call mem_checkin(this%head,
'HEAD', this%memoryPath, &
119 'HEAD', this%input_mempath)
128 class(
chdtype),
intent(inout) :: this
130 character(len=30) :: nodestr
131 integer(I4B) :: i, node, ibd, ierr
133 if (this%iper /=
kper)
return
136 do i = 1, this%nbound
137 node = this%nodelist(i)
138 this%ibound(node) = this%ibcnum
142 call this%BndExtType%bnd_rp()
146 do i = 1, this%nbound
147 node = this%nodelist(i)
148 ibd = this%ibound(node)
150 call this%dis%noder_to_string(node, nodestr)
152 'Cell is already a constant head (', trim(adjustl(nodestr)),
').'
156 this%ibound(node) = -this%ibcnum
166 if (this%iprpak /= 0)
then
167 call this%write_list()
180 integer(I4B) :: i, node
185 do i = 1, this%nbound
186 node = this%nodelist(i)
187 hb = this%head_mult(i)
190 this%xold(node) = this%xnew(node)
196 call this%obs%obs_ad()
204 class(
chdtype),
intent(inout) :: this
206 character(len=30) :: nodestr
211 character(len=*),
parameter :: fmtchderr = &
212 "('CHD BOUNDARY ',i0,' HEAD (',g0,') IS LESS THAN CELL &
213 &BOTTOM (',g0,')',' FOR CELL ',a)"
216 do i = 1, this%nbound
217 node = this%nodelist(i)
218 bt = this%dis%bot(node)
220 if (this%head_mult(i) < bt .and. this%icelltype(node) /= 0)
then
221 call this%dis%noder_to_string(node, nodestr)
222 write (
errmsg, fmt=fmtchderr) i, this%head_mult(i), bt, trim(nodestr)
238 subroutine chd_fc(this, rhs, ia, idxglo, matrix_sln)
241 real(DP),
dimension(:),
intent(inout) :: rhs
242 integer(I4B),
dimension(:),
intent(in) :: ia
243 integer(I4B),
dimension(:),
intent(in) :: idxglo
253 class(
chdtype),
intent(inout) :: this
254 real(DP),
dimension(:),
intent(in) :: x
255 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
256 integer(I4B),
optional,
intent(in) :: iadv
267 class(
chdtype),
intent(inout) :: this
273 integer(I4B) :: idiag
275 real(DP) :: ratein, rateout
279 if (this%nbound > 0)
then
282 do i = 1, this%nbound
283 node = this%nodelist(i)
284 idiag = this%dis%con%ia(node)
290 do ipos = this%dis%con%ia(node) + 1, &
291 this%dis%con%ia(node + 1) - 1
292 q = this%flowja(ipos)
296 n2 = this%dis%con%ja(ipos)
297 if (this%ibound(n2) > 0)
then
301 rateout = rateout + q
312 this%simvals(i) = rate
313 this%ratechdin(i) = ratein
314 this%ratechdout(i) = rateout
315 this%flowja(idiag) = this%flowja(idiag) + rate
329 type(
budgettype),
intent(inout) :: model_budget
333 integer(I4B) :: isuppress_output
339 call this%calc_chd_rate()
344 call model_budget%addentry(ratin, ratout,
delt, this%text, &
345 isuppress_output, this%packName)
357 call this%BndExtType%bnd_da()
369 class(
chdtype),
intent(inout) :: this
372 this%listlabel = trim(this%filtyp)//
' NO.'
373 if (this%dis%ndim == 3)
then
374 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
375 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
376 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
377 elseif (this%dis%ndim == 2)
then
378 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
379 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
381 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
383 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'HEAD'
384 if (this%inamedbound == 1)
then
385 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
415 call this%obs%StoreObsType(
'chd', .true., indx)
425 class(
chdtype),
intent(inout) :: this
426 integer(I4B),
intent(in) :: row
430 if (this%iauxmultcol > 0)
then
431 head = this%head(row) * this%auxvar(this%iauxmultcol, row)
433 head = this%head(row)
446 class(
chdtype),
intent(inout) :: this
447 integer(I4B),
intent(in) :: col
448 integer(I4B),
intent(in) :: row
454 bndval = this%head_mult(row)
456 errmsg =
'Programming error. CHD bound value requested column '&
457 &
'outside range of ncolbnd (1).'
This module contains the extended boundary package.
This module contains the base boundary package.
This module contains the BudgetModule.
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
subroutine chd_ck(this)
Check constant concentration/temperature boundary condition data.
character(len=lenpackagename) text
subroutine calc_chd_rate(this)
Calculate the CHD cell rates, to be called.
subroutine chd_da(this)
Deallocate memory.
subroutine define_listlabel(this)
Define the list heading that is written to iout when PRINT_INPUT option is used.
subroutine chd_cq(this, x, flowja, iadv)
Calculate flow associated with constant head boundary.
character(len=lenftype) ftype
real(dp) function chd_bound_value(this, col, row)
@ brief Return a bound value
subroutine chd_df_obs(this)
Overrides bnd_df_obs from bndType class.
subroutine chd_rp(this)
Constant concentration/temperature read and prepare (rp) routine.
subroutine chd_ad(this)
Constant head package advance routine.
subroutine, public chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a new constant head package.
real(dp) function head_mult(this, row)
Apply auxiliary multiplier to specified head if appropriate.
subroutine chd_allocate_arrays(this, nodelist, auxvar)
Allocate arrays specific to the constant head package.
logical function chd_obs_supported(this)
Overrides bnd_obs_supported from bndType class.
subroutine chd_bd(this, model_budget)
Add package ratin/ratout to model budget.
subroutine chd_fc(this, rhs, ia, idxglo, matrix_sln)
Override bnd_fc and do nothing.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter namedboundflag
named bound flag
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
real(dp), parameter dzero
real constant zero
real(dp), parameter done
real constant 1
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the derived types ObserveType and ObsDataType.
This module contains the derived type ObsType.
subroutine, public defaultobsidprocessor(obsrv, dis, inunitobs, iout)
@ brief Process IDstring provided for each observation
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.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
type(timeserieslinktype) function, pointer, public gettimeserieslinkfromlist(list, indx)
Get time series link from a list.
Derived type for the Budget object.