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
100 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
101 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
106 call this%BndExtType%allocate_arrays(nodelist, auxvar)
109 call mem_allocate(this%ratechdin, this%maxbound,
'RATECHDIN', this%memoryPath)
110 call mem_allocate(this%ratechdout, this%maxbound,
'RATECHDOUT', &
112 do i = 1, this%maxbound
113 this%ratechdin(i) =
dzero
114 this%ratechdout(i) =
dzero
118 call mem_setptr(this%head,
'HEAD', this%input_mempath)
121 call mem_checkin(this%head,
'HEAD', this%memoryPath, &
122 'HEAD', this%input_mempath)
134 class(
chdtype),
intent(inout) :: this
136 character(len=30) :: nodestr
137 integer(I4B) :: i, node, ibd, ierr
139 if (this%iper /=
kper)
return
142 do i = 1, this%nbound
143 node = this%nodelist(i)
144 this%ibound(node) = this%ibcnum
148 call this%BndExtType%bnd_rp()
152 do i = 1, this%nbound
153 node = this%nodelist(i)
154 ibd = this%ibound(node)
156 call this%dis%noder_to_string(node, nodestr)
158 'Cell is already a constant head (', trim(adjustl(nodestr)),
').'
162 this%ibound(node) = -this%ibcnum
172 if (this%iprpak /= 0)
then
173 call this%write_list()
189 integer(I4B) :: i, node
194 do i = 1, this%nbound
195 node = this%nodelist(i)
196 hb = this%head_mult(i)
199 this%xold(node) = this%xnew(node)
205 call this%obs%obs_ad()
216 class(
chdtype),
intent(inout) :: this
218 character(len=30) :: nodestr
223 character(len=*),
parameter :: fmtchderr = &
224 "('CHD BOUNDARY ',i0,' HEAD (',g0,') IS LESS THAN CELL &
225 &BOTTOM (',g0,')',' FOR CELL ',a)"
228 do i = 1, this%nbound
229 node = this%nodelist(i)
230 bt = this%dis%bot(node)
232 if (this%head_mult(i) < bt .and. this%icelltype(node) /= 0)
then
233 call this%dis%noder_to_string(node, nodestr)
234 write (
errmsg, fmt=fmtchderr) i, this%head_mult(i), bt, trim(nodestr)
253 subroutine chd_fc(this, rhs, ia, idxglo, matrix_sln)
256 real(DP),
dimension(:),
intent(inout) :: rhs
257 integer(I4B),
dimension(:),
intent(in) :: ia
258 integer(I4B),
dimension(:),
intent(in) :: idxglo
271 class(
chdtype),
intent(inout) :: this
272 real(DP),
dimension(:),
intent(in) :: x
273 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
274 integer(I4B),
optional,
intent(in) :: iadv
285 class(
chdtype),
intent(inout) :: this
291 integer(I4B) :: idiag
293 real(DP) :: ratein, rateout
297 if (this%nbound > 0)
then
300 do i = 1, this%nbound
301 node = this%nodelist(i)
302 idiag = this%dis%con%ia(node)
308 do ipos = this%dis%con%ia(node) + 1, &
309 this%dis%con%ia(node + 1) - 1
310 q = this%flowja(ipos)
314 n2 = this%dis%con%ja(ipos)
315 if (this%ibound(n2) > 0)
then
319 rateout = rateout + q
330 this%simvals(i) = rate
331 this%ratechdin(i) = ratein
332 this%ratechdout(i) = rateout
333 this%flowja(idiag) = this%flowja(idiag) + rate
350 type(
budgettype),
intent(inout) :: model_budget
354 integer(I4B) :: isuppress_output
360 call this%calc_chd_rate()
365 call model_budget%addentry(ratin, ratout,
delt, this%text, &
366 isuppress_output, this%packName)
378 call this%BndExtType%bnd_da()
393 class(
chdtype),
intent(inout) :: this
396 this%listlabel = trim(this%filtyp)//
' NO.'
397 if (this%dis%ndim == 3)
then
398 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
399 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
400 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
401 elseif (this%dis%ndim == 2)
then
402 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
403 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
405 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
407 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'HEAD'
408 if (this%inamedbound == 1)
then
409 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
445 call this%obs%StoreObsType(
'chd', .true., indx)
458 class(
chdtype),
intent(inout) :: this
459 integer(I4B),
intent(in) :: row
463 if (this%iauxmultcol > 0)
then
464 head = this%head(row) * this%auxvar(this%iauxmultcol, row)
466 head = this%head(row)
482 class(
chdtype),
intent(inout) :: this
483 integer(I4B),
intent(in) :: col
484 integer(I4B),
intent(in) :: row
490 bndval = this%head_mult(row)
492 errmsg =
'Programming error. CHD bound value requested column '&
493 &
'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.