18 character(len=LENFTYPE) ::
ftype =
'RIV'
19 character(len=LENPACKAGENAME) ::
text =
' RIV'
22 real(dp),
dimension(:),
pointer,
contiguous :: stage => null()
23 real(dp),
dimension(:),
pointer,
contiguous :: cond => null()
24 real(dp),
dimension(:),
pointer,
contiguous :: rbot => null()
49 subroutine riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
52 class(
bndtype),
pointer :: packobj
53 integer(I4B),
intent(in) :: id
54 integer(I4B),
intent(in) :: ibcnum
55 integer(I4B),
intent(in) :: inunit
56 integer(I4B),
intent(in) :: iout
57 character(len=*),
intent(in) :: namemodel
58 character(len=*),
intent(in) :: pakname
59 character(len=*),
intent(in) :: mempath
61 type(
rivtype),
pointer :: rivobj
68 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
72 call rivobj%allocate_scalars()
75 call packobj%pack_initialize()
77 packobj%inunit = inunit
80 packobj%ibcnum = ibcnum
96 call this%BndExtType%bnd_da()
115 class(
rivtype),
intent(inout) :: this
120 call this%BndExtType%source_options()
123 call mem_set_value(this%imover,
'MOVER', this%input_mempath, found%mover)
126 call this%log_riv_options(found)
138 class(
rivtype),
intent(inout) :: this
142 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text)) &
145 if (found%mover)
then
146 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
150 write (this%iout,
'(1x,a)') &
151 'END OF '//trim(adjustl(this%text))//
' OPTIONS'
164 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
165 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
168 call this%BndExtType%allocate_arrays(nodelist, auxvar)
171 call mem_setptr(this%stage,
'STAGE', this%input_mempath)
172 call mem_setptr(this%cond,
'COND', this%input_mempath)
173 call mem_setptr(this%rbot,
'RBOT', this%input_mempath)
176 call mem_checkin(this%stage,
'STAGE', this%memoryPath, &
177 'STAGE', this%input_mempath)
178 call mem_checkin(this%cond,
'COND', this%memoryPath, &
179 'COND', this%input_mempath)
180 call mem_checkin(this%rbot,
'RBOT', this%memoryPath, &
181 'RBOT', this%input_mempath)
193 class(
rivtype),
intent(inout) :: this
195 if (this%iper /=
kper)
return
198 call this%BndExtType%bnd_rp()
201 if (this%ivsc == 1)
then
202 call this%riv_store_user_cond()
206 if (this%iprpak /= 0)
then
207 call this%write_list()
221 class(
rivtype),
intent(inout) :: this
223 character(len=LINELENGTH) :: errmsg
230 character(len=*),
parameter :: fmtriverr = &
231 "('RIV BOUNDARY (',i0,') RIVER BOTTOM (',f10.4,') IS LESS &
232 &THAN CELL BOTTOM (',f10.4,')')"
233 character(len=*),
parameter :: fmtriverr2 = &
234 "('RIV BOUNDARY (',i0,') RIVER STAGE (',f10.4,') IS LESS &
235 &THAN RIVER BOTTOM (',f10.4,')')"
236 character(len=*),
parameter :: fmtriverr3 = &
237 "('RIV BOUNDARY (',i0,') RIVER STAGE (',f10.4,') IS LESS &
238 &THAN CELL BOTTOM (',f10.4,')')"
239 character(len=*),
parameter :: fmtcondmulterr = &
240 "('RIV BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS &
242 character(len=*),
parameter :: fmtconderr = &
243 "('RIV BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN &
247 do i = 1, this%nbound
248 node = this%nodelist(i)
249 bt = this%dis%bot(node)
250 stage = this%stage(i)
253 if (rbot < bt .and. this%icelltype(node) /= 0)
then
254 write (errmsg, fmt=fmtriverr) i, rbot, bt
257 if (stage < rbot)
then
258 write (errmsg, fmt=fmtriverr2) i, stage, rbot
261 if (stage < bt .and. this%icelltype(node) /= 0)
then
262 write (errmsg, fmt=fmtriverr3) i, stage, bt
265 if (this%iauxmultcol > 0)
then
266 if (this%auxvar(this%iauxmultcol, i) < dzero)
then
267 write (errmsg, fmt=fmtcondmulterr) &
268 i, this%auxvar(this%iauxmultcol, i)
272 if (this%cond(i) < dzero)
then
273 write (errmsg, fmt=fmtconderr) i, this%cond(i)
295 integer(I4B) :: i, node
296 real(DP) :: hriv, criv, rbot
299 if (this%nbound .eq. 0)
return
302 do i = 1, this%nbound
303 node = this%nodelist(i)
304 if (this%ibound(node) <= 0)
then
310 criv = this%cond_mult(i)
312 if (this%xnew(node) <= rbot)
then
313 this%rhs(i) = -criv * (hriv - rbot)
316 this%rhs(i) = -criv * hriv
327 subroutine riv_fc(this, rhs, ia, idxglo, matrix_sln)
330 real(DP),
dimension(:),
intent(inout) :: rhs
331 integer(I4B),
dimension(:),
intent(in) :: ia
332 integer(I4B),
dimension(:),
intent(in) :: idxglo
335 integer(I4B) :: i, n, ipos
336 real(DP) :: cond, stage, qriv
339 if (this%imover == 1)
then
340 call this%pakmvrobj%fc()
344 do i = 1, this%nbound
346 rhs(n) = rhs(n) + this%rhs(i)
348 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
352 stage = this%stage(i)
353 if (this%imover == 1 .and. this%xnew(n) > stage)
then
354 cond = this%cond_mult(i)
355 qriv = cond * (this%xnew(n) - stage)
356 call this%pakmvrobj%accumulate_qformvr(i, qriv)
369 class(
rivtype),
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),
'STAGE'
384 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'CONDUCTANCE'
385 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOTTOM EL.'
386 if (this%inamedbound == 1)
then
387 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
422 call this%obs%StoreObsType(
'riv', .true., indx)
427 call this%obs%StoreObsType(
'to-mvr', .true., indx)
438 class(
rivtype),
intent(inout) :: this
443 do n = 1, this%nbound
444 this%condinput(n) = this%cond_mult(n)
457 class(
rivtype),
intent(inout) :: this
458 integer(I4B),
intent(in) :: row
462 if (this%iauxmultcol > 0)
then
463 cond = this%cond(row) * this%auxvar(this%iauxmultcol, row)
465 cond = this%cond(row)
478 class(
rivtype),
intent(inout) :: this
479 integer(I4B),
intent(in) :: col
480 integer(I4B),
intent(in) :: row
486 bndval = this%stage(row)
488 bndval = this%cond_mult(row)
490 bndval = this%rbot(row)
492 errmsg =
'Programming error. RIV bound value requested column '&
493 &
'outside range of ncolbnd (3).'
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.)
real(dp), parameter dzero
real constant zero
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
subroutine riv_store_user_cond(this)
Store user-specified conductance value.
logical function riv_obs_supported(this)
Return true because RIV package supports observations.
real(dp) function cond_mult(this, row)
Apply multiplier to conductance if auxmultcol option is in use.
subroutine riv_allocate_arrays(this, nodelist, auxvar)
Allocate package arrays.
subroutine log_riv_options(this, found)
Log options specific to RivType.
subroutine riv_df_obs(this)
Store observation type supported by RIV package.
character(len=lenftype) ftype
subroutine define_listlabel(this)
Define the list heading that is written to iout when PRINT_INPUT option is used.
subroutine riv_options(this)
Set options specific to RivType.
character(len=lenpackagename) text
subroutine, public riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Riv Package and point packobj to the new package.
subroutine riv_cf(this)
Formulate the HCOF and RHS terms.
real(dp) function riv_bound_value(this, col, row)
Return requested boundary value.
subroutine riv_ck(this)
Check river boundary condition data.
subroutine riv_da(this)
Deallocate memory.
subroutine riv_fc(this, rhs, ia, idxglo, matrix_sln)
Copy rhs and hcof into solution rhs and amat.
subroutine riv_rp(this)
Read and prepare.
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.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
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 ...