21 character(len=LENFTYPE) ::
ftype =
'DRN'
22 character(len=LENPACKAGENAME) ::
text =
' DRN'
26 real(dp),
dimension(:),
pointer,
contiguous :: elev => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: cond => null()
28 integer(I4B),
pointer :: iauxddrncol => null()
29 integer(I4B),
pointer :: icubic_scaling => null()
58 subroutine drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
61 class(
bndtype),
pointer :: packobj
62 integer(I4B),
intent(in) :: id
63 integer(I4B),
intent(in) :: ibcnum
64 integer(I4B),
intent(in) :: inunit
65 integer(I4B),
intent(in) :: iout
66 character(len=*),
intent(in) :: namemodel
67 character(len=*),
intent(in) :: pakname
68 character(len=*),
intent(in) :: mempath
70 type(
drntype),
pointer :: drnobj
77 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
81 call drnobj%allocate_scalars()
84 call packobj%pack_initialize()
87 packobj%inunit = inunit
90 packobj%ibcnum = ibcnum
106 call this%BndExtType%bnd_da()
129 call this%BndExtType%allocate_scalars()
132 call mem_allocate(this%iauxddrncol,
'IAUXDDRNCOL', this%memoryPath)
133 call mem_allocate(this%icubic_scaling,
'ICUBIC_SCALING', this%memoryPath)
137 if (this%inewton /= 0)
then
138 this%icubic_scaling = 1
140 this%icubic_scaling = 0
154 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
155 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
158 call this%BndExtType%allocate_arrays(nodelist, auxvar)
161 call mem_setptr(this%elev,
'ELEV', this%input_mempath)
162 call mem_setptr(this%cond,
'COND', this%input_mempath)
165 call mem_checkin(this%elev,
'ELEV', this%memoryPath, &
166 'ELEV', this%input_mempath)
167 call mem_checkin(this%cond,
'COND', this%memoryPath, &
168 'COND', this%input_mempath)
179 class(
drntype),
intent(inout) :: this
181 if (this%iper /=
kper)
return
184 call this%BndExtType%bnd_rp()
187 if (this%ivsc == 1)
then
188 call this%drn_store_user_cond()
192 if (this%iprpak /= 0)
then
193 call this%write_list()
209 class(
drntype),
intent(inout) :: this
212 character(len=LENAUXNAME) :: ddrnauxname
216 call this%BndExtType%source_options()
219 call mem_set_value(this%imover,
'MOVER', this%input_mempath, found%mover)
220 call mem_set_value(ddrnauxname,
'AUXDEPTHNAME', this%input_mempath, &
222 call mem_set_value(this%icubic_scaling,
'ICUBICSFAC', this%input_mempath, &
225 if (found%auxdepthname)
then
226 this%iauxddrncol = -1
229 if (this%naux == 0)
then
230 write (
errmsg,
'(a,2(1x,a))') &
231 'AUXDEPTHNAME was specified as', trim(adjustl(ddrnauxname)), &
232 'but no AUX variables specified.'
239 if (ddrnauxname == this%auxname(n))
then
246 if (this%iauxddrncol == 0)
then
247 write (
errmsg,
'(a,2(1x,a))') &
248 'AUXDEPTHNAME was specified as', trim(adjustl(ddrnauxname)), &
249 'but no AUX variable found with this name.'
254 if (found%icubicsfac)
then
255 call this%parser%DevOpt()
259 call this%log_drn_options(found)
271 class(
drntype),
intent(inout) :: this
277 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text)) &
280 if (found%mover)
then
281 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
284 if (found%icubicsfac)
then
285 write (this%iout,
'(4x,a,1x,a)') &
286 'CUBIC SCALING will be used for drains with non-zero DDRN values', &
287 'even if the NEWTON-RAPHSON method is not being used.'
291 write (this%iout,
'(1x,a)') &
292 'END OF '//trim(adjustl(this%text))//
' OPTIONS'
302 class(
drntype),
intent(inout) :: this
311 character(len=*),
parameter :: fmtddrnerr = &
312 "('SCALED-CONDUCTANCE DRN BOUNDARY (',i0,') BOTTOM ELEVATION &
313 &(',f10.3,') IS LESS THAN CELL BOTTOM (',f10.3,')')"
314 character(len=*),
parameter :: fmtdrnerr = &
315 "('DRN BOUNDARY (',i0,') ELEVATION (',f10.3,') IS LESS THAN CELL &
316 &BOTTOM (',f10.3,')')"
317 character(len=*),
parameter :: fmtcondmulterr = &
318 "('DRN BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS &
320 character(len=*),
parameter :: fmtconderr = &
321 "('DRN BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN &
325 do i = 1, this%nbound
326 node = this%nodelist(i)
327 bt = this%dis%bot(node)
331 call this%get_drain_elevations(i, drndepth, drntop, drnbot)
334 if (drnbot < bt .and. this%icelltype(node) /= 0)
then
335 if (drndepth /=
dzero)
then
336 write (
errmsg, fmt=fmtddrnerr) i, drnbot, bt
338 write (
errmsg, fmt=fmtdrnerr) i, drnbot, bt
342 if (this%iauxmultcol > 0)
then
343 if (this%auxvar(this%iauxmultcol, i) <
dzero)
then
344 write (
errmsg, fmt=fmtcondmulterr) &
345 i, this%auxvar(this%iauxmultcol, i)
349 if (this%cond(i) <
dzero)
then
350 write (
errmsg, fmt=fmtconderr) i, this%cond(i)
379 if (this%nbound == 0)
return
382 do i = 1, this%nbound
383 node = this%nodelist(i)
384 if (this%ibound(node) <= 0)
then
391 cdrn = this%cond_mult(i)
395 call this%get_drain_factor(i, fact, drnbot)
398 this%rhs(i) = -fact * cdrn * drnbot
399 this%hcof(i) = -fact * cdrn
408 subroutine drn_fc(this, rhs, ia, idxglo, matrix_sln)
411 real(DP),
dimension(:),
intent(inout) :: rhs
412 integer(I4B),
dimension(:),
intent(in) :: ia
413 integer(I4B),
dimension(:),
intent(in) :: idxglo
425 if (this%imover == 1)
then
426 call this%pakmvrobj%fc()
430 do i = 1, this%nbound
432 rhs(n) = rhs(n) + this%rhs(i)
434 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
437 call this%get_drain_factor(i, fact, drnbot)
441 if (this%imover == 1 .and. fact >
dzero)
then
442 drncond = this%cond_mult(i)
443 qdrn = fact * drncond * (this%xnew(n) - drnbot)
444 call this%pakmvrobj%accumulate_qformvr(i, qdrn)
454 subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln)
458 real(DP),
dimension(:),
intent(inout) :: rhs
459 integer(I4B),
dimension(:),
intent(in) :: ia
460 integer(I4B),
dimension(:),
intent(in) :: idxglo
474 if (this%iauxddrncol /= 0)
then
475 do i = 1, this%nbound
476 node = this%nodelist(i)
479 if (this%ibound(node) <= 0)
then
484 cdrn = this%cond_mult(i)
485 xnew = this%xnew(node)
489 call this%get_drain_elevations(i, drndepth, drntop, drnbot)
492 if (drndepth /=
dzero)
then
495 drterm = drterm * cdrn * (drnbot - xnew)
499 call matrix_sln%add_value_pos(idxglo(ipos), drterm)
500 rhs(node) = rhs(node) + drterm * xnew
514 class(
drntype),
intent(inout) :: this
517 this%listlabel = trim(this%filtyp)//
' NO.'
518 if (this%dis%ndim == 3)
then
519 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
520 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
521 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
522 elseif (this%dis%ndim == 2)
then
523 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
524 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
526 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
528 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'DRAIN EL.'
529 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'CONDUCTANCE'
530 if (this%inamedbound == 1)
then
531 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
543 class(
drntype),
intent(inout) :: this
544 integer(I4B),
intent(in) :: i
545 real(DP),
intent(inout) :: drndepth
546 real(DP),
intent(inout) :: drntop
547 real(DP),
intent(inout) :: drnbot
554 drnelev = this%elev(i)
557 if (this%iauxddrncol > 0)
then
558 drndepth = this%auxvar(this%iauxddrncol, i)
562 if (drndepth /=
dzero)
then
563 elev = drnelev + drndepth
564 drntop = max(elev, drnelev)
565 drnbot = min(elev, drnelev)
579 class(
drntype),
intent(inout) :: this
580 integer(I4B),
intent(in) :: i
581 real(DP),
intent(inout) :: factor
582 real(DP),
intent(inout),
optional :: opt_drnbot
591 node = this%nodelist(i)
592 xnew = this%xnew(node)
596 call this%get_drain_elevations(i, drndepth, drntop, drnbot)
599 if (
present(opt_drnbot))
then
604 if (drndepth /=
dzero)
then
605 if (this%icubic_scaling /= 0)
then
611 if (xnew <= drnbot)
then
650 call this%obs%StoreObsType(
'drn', .true., indx)
655 call this%obs%StoreObsType(
'to-mvr', .true., indx)
666 class(
drntype),
intent(inout) :: this
671 do n = 1, this%nbound
672 this%condinput(n) = this%cond_mult(n)
685 class(
drntype),
intent(inout) :: this
686 integer(I4B),
intent(in) :: row
690 if (this%iauxmultcol > 0)
then
691 cond = this%cond(row) * this%auxvar(this%iauxmultcol, row)
693 cond = this%cond(row)
706 class(
drntype),
intent(inout) :: this
707 integer(I4B),
intent(in) :: col
708 integer(I4B),
intent(in) :: row
714 bndval = this%elev(row)
716 bndval = this%cond_mult(row)
718 errmsg =
'Programming error. DRN bound value requested column '&
719 &
'outside range of ncolbnd (2).'
This module contains the extended boundary package.
This module contains the base boundary package.
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 lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
integer(i4b), parameter lenauxname
maximum length of a aux variable
real(dp), parameter dzero
real constant zero
real(dp), parameter dtwo
real constant 2
real(dp), parameter done
real constant 1
character(len=lenftype) ftype
subroutine drn_da(this)
Deallocate memory.
subroutine, public drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Drn Package and point packobj to the new package.
real(dp) function cond_mult(this, row)
Apply multiplier to conductance value depending on user-selected option.
subroutine drn_fn(this, rhs, ia, idxglo, matrix_sln)
Fill newton terms.
subroutine drn_allocate_arrays(this, nodelist, auxvar)
Allocate package arrays.
real(dp) function drn_bound_value(this, col, row)
Return requested boundary value.
subroutine define_listlabel(this)
Define the list heading that is written to iout when PRINT_INPUT option is used.
logical function drn_obs_supported(this)
Return true because DRN package supports observations.
subroutine get_drain_factor(this, i, factor, opt_drnbot)
Get the drain conductance scale factor.
subroutine drn_allocate_scalars(this)
Allocate package scalar members.
subroutine drn_cf(this)
Formulate the HCOF and RHS terms.
subroutine drn_ck(this)
Check drain boundary condition data.
subroutine drn_options(this)
Source options specific to DrnType.
subroutine drn_rp(this)
Read and prepare.
character(len=lenpackagename) text
subroutine get_drain_elevations(this, i, drndepth, drntop, drnbot)
Define drain depth and the top and bottom elevations used to scale the drain conductance.
subroutine log_drn_options(this, found)
@ brief Log DRN specific package options
subroutine drn_store_user_cond(this)
Store user-specified drain conductance.
subroutine drn_fc(this, rhs, ia, idxglo, matrix_sln)
Copy rhs and hcof into solution rhs and amat.
subroutine drn_df_obs(this)
Store observation type supported by DRN package.
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 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
real(dp) function squadraticsaturation(top, bot, x, eps)
@ brief sQuadraticSaturation
real(dp) function sqsaturationderivative(top, bot, x, c1, c2)
@ brief sQSaturationDerivative
real(dp) function sqsaturation(top, bot, x, c1, c2)
@ brief sQSaturation
integer(i4b), pointer, public kper
current stress period number
This class is used to store a single deferred-length character string. It was designed to work in an ...