22 integer(I4B),
pointer :: maxhfb => null()
23 integer(I4B),
pointer :: nhfb => null()
24 integer(I4B),
dimension(:),
pointer,
contiguous :: noden => null()
25 integer(I4B),
dimension(:),
pointer,
contiguous :: nodem => null()
26 integer(I4B),
dimension(:),
pointer,
contiguous :: idxloc => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: hydchr => null()
28 real(dp),
dimension(:),
pointer,
contiguous :: csatsav => null()
29 real(dp),
dimension(:),
pointer,
contiguous :: condsav => null()
32 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
33 integer(I4B),
dimension(:),
pointer,
contiguous :: icelltype => null()
34 integer(I4B),
dimension(:),
pointer,
contiguous :: ihc => null()
35 integer(I4B),
dimension(:),
pointer,
contiguous :: ia => null()
36 integer(I4B),
dimension(:),
pointer,
contiguous :: ja => null()
37 integer(I4B),
dimension(:),
pointer,
contiguous :: jas => null()
38 integer(I4B),
dimension(:),
pointer,
contiguous :: isym => null()
39 real(dp),
dimension(:),
pointer,
contiguous :: condsat => null()
40 real(dp),
dimension(:),
pointer,
contiguous :: top => null()
41 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
42 real(dp),
dimension(:),
pointer,
contiguous :: hwva => null()
43 real(dp),
dimension(:),
pointer,
contiguous :: hnew => null()
46 integer(I4B),
pointer :: ivsc => null()
70 subroutine hfb_cr(hfbobj, name_model, input_mempath, inunit, iout)
73 character(len=*),
intent(in) :: name_model
74 character(len=*),
intent(in) :: input_mempath
75 integer(I4B),
intent(in) :: inunit
76 integer(I4B),
intent(in) :: iout
82 call hfbobj%set_names(1, name_model,
'HFB',
'HFB', input_mempath)
85 call hfbobj%allocate_scalars()
88 hfbobj%inunit = inunit
94 subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc)
100 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
103 integer(I4B),
pointer :: invsc
106 character(len=*),
parameter :: fmtheader = &
107 "(1x, /1x, 'HFB -- HORIZONTAL FLOW BARRIER PACKAGE, VERSION 8, ', &
108 &'4/24/2015 INPUT READ FROM MEMPATH: ', a, /)"
111 write (this%iout, fmtheader) this%input_mempath
115 this%ibound => ibound
118 call mem_setptr(this%icelltype,
'ICELLTYPE', &
131 call this%source_options()
132 call this%source_dimensions()
133 call this%allocate_arrays()
141 write (this%iout,
'(/1x,a,a)')
'Viscosity active in ', &
142 trim(this%filtyp)//
' Package calculations: '//trim(adjustl(this%packName))
155 integer(I4B),
pointer :: iper
157 character(len=*),
parameter :: fmtlsp = &
158 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
160 call mem_setptr(iper,
'IPER', this%input_mempath)
161 if (iper ==
kper)
then
162 call this%condsat_reset()
163 call this%source_data()
164 call this%condsat_modify()
166 write (this%iout, fmtlsp)
'HFB'
178 subroutine hfb_fc(this, kiter, matrix_sln, idxglo, rhs, hnew)
183 integer(I4B) :: kiter
185 integer(I4B),
intent(in),
dimension(:) :: idxglo
186 real(DP),
intent(inout),
dimension(:) :: rhs
187 real(DP),
intent(inout),
dimension(:) :: hnew
189 integer(I4B) :: nodes, nja
190 integer(I4B) :: ihfb, n, m
192 integer(I4B) :: idiag, isymcon
193 integer(I4B) :: ixt3d
194 real(DP) :: cond, condhfb, aterm
195 real(DP) :: fawidth, faheight, faarea
196 real(DP) :: topn, topm, botn, botm
197 real(DP) :: viscratio
201 nodes = this%dis%nodes
202 nja = this%dis%con%nja
203 if (
associated(this%xt3d%ixt3d))
then
204 ixt3d = this%xt3d%ixt3d
211 do ihfb = 1, this%nhfb
212 n = min(this%noden(ihfb), this%nodem(ihfb))
213 m = max(this%noden(ihfb), this%nodem(ihfb))
215 if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
217 if (this%ivsc /= 0)
then
218 call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
221 if (this%hydchr(ihfb) >
dzero)
then
222 if (this%inewton == 0)
then
223 ipos = this%idxloc(ihfb)
228 if (this%icelltype(n) == 1)
then
229 if (hnew(n) < topn) topn = hnew(n)
231 if (this%icelltype(m) == 1)
then
232 if (hnew(m) < topm) topm = hnew(m)
234 if (this%ihc(this%jas(ipos)) == 2)
then
235 faheight = min(topn, topm) - max(botn, botm)
237 faheight =
dhalf * ((topn - botn) + (topm - botm))
240 if (this%ihc(this%jas(ipos)) == 0)
then
241 faarea = this%hwva(this%jas(ipos))
243 fawidth = this%hwva(this%jas(ipos))
244 faarea = fawidth * faheight
247 condhfb = this%hydchr(ihfb) * viscratio * faarea
249 condhfb = this%hydchr(ihfb) * viscratio
252 condhfb = this%hydchr(ihfb)
255 call this%xt3d%xt3d_fhfb(kiter, nodes, nja, matrix_sln, idxglo, &
256 rhs, hnew, n, m, condhfb)
262 if (this%inewton == 0)
then
263 do ihfb = 1, this%nhfb
264 ipos = this%idxloc(ihfb)
265 aterm = matrix_sln%get_value_pos(idxglo(ipos))
268 if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
270 if (this%ivsc /= 0)
then
271 call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
274 if (this%icelltype(n) == 1 .or. this%icelltype(m) == 1 .or. &
282 if (this%icelltype(n) == 1)
then
283 if (hnew(n) < topn) topn = hnew(n)
285 if (this%icelltype(m) == 1)
then
286 if (hnew(m) < topm) topm = hnew(m)
288 if (this%ihc(this%jas(ipos)) == 2)
then
289 faheight = min(topn, topm) - max(botn, botm)
291 faheight =
dhalf * ((topn - botn) + (topm - botm))
294 if (this%ihc(this%jas(ipos)) == 0)
then
295 faarea = this%hwva(this%jas(ipos))
297 fawidth = this%hwva(this%jas(ipos))
298 faarea = fawidth * faheight
301 if (this%hydchr(ihfb) >
dzero)
then
302 condhfb = this%hydchr(ihfb) * viscratio * faarea
303 cond = aterm * condhfb / (aterm + condhfb)
305 cond = -aterm * this%hydchr(ihfb)
309 this%condsav(ihfb) = cond
313 call matrix_sln%add_value_pos(idxglo(idiag), aterm - cond)
314 call matrix_sln%set_value_pos(idxglo(ipos), cond)
317 isymcon = this%isym(ipos)
319 call matrix_sln%add_value_pos(idxglo(idiag), aterm - cond)
320 call matrix_sln%set_value_pos(idxglo(isymcon), cond)
339 real(DP),
intent(inout),
dimension(:) :: hnew
340 real(DP),
intent(inout),
dimension(:) :: flowja
342 integer(I4B) :: ihfb, n, m
346 integer(I4B) :: ixt3d
348 real(DP) :: fawidth, faheight, faarea
349 real(DP) :: topn, topm, botn, botm
350 real(DP) :: viscratio
355 if (
associated(this%xt3d%ixt3d))
then
356 ixt3d = this%xt3d%ixt3d
363 do ihfb = 1, this%nhfb
364 n = min(this%noden(ihfb), this%nodem(ihfb))
365 m = max(this%noden(ihfb), this%nodem(ihfb))
367 if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
369 if (this%ivsc /= 0)
then
370 call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
374 if (this%hydchr(ihfb) >
dzero)
then
375 if (this%inewton == 0)
then
376 ipos = this%idxloc(ihfb)
381 if (this%icelltype(n) == 1)
then
382 if (hnew(n) < topn) topn = hnew(n)
384 if (this%icelltype(m) == 1)
then
385 if (hnew(m) < topm) topm = hnew(m)
387 if (this%ihc(this%jas(ipos)) == 2)
then
388 faheight = min(topn, topm) - max(botn, botm)
390 faheight =
dhalf * ((topn - botn) + (topm - botm))
393 if (this%ihc(this%jas(ipos)) == 0)
then
394 faarea = this%hwva(this%jas(ipos))
396 fawidth = this%hwva(this%jas(ipos))
397 faarea = fawidth * faheight
400 fawidth = this%hwva(this%jas(ipos))
401 condhfb = this%hydchr(ihfb) * viscratio * faarea
403 condhfb = this%hydchr(ihfb)
406 condhfb = this%hydchr(ihfb)
409 call this%xt3d%xt3d_flowjahfb(n, m, hnew, flowja, condhfb)
415 if (this%inewton == 0)
then
416 do ihfb = 1, this%nhfb
419 if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
420 if (this%icelltype(n) == 1 .or. this%icelltype(m) == 1 .or. &
422 ipos = this%dis%con%getjaindex(n, m)
425 cond = this%condsav(ihfb)
426 qnm = cond * (hnew(m) - hnew(n))
428 ipos = this%dis%con%getjaindex(m, n)
452 if (this%inunit > 0)
then
462 call this%NumericalPackageType%da()
466 this%inewton => null()
467 this%ibound => null()
468 this%icelltype => null()
474 this%condsat => null()
490 call this%NumericalPackageType%allocate_scalars()
493 call mem_allocate(this%maxhfb,
'MAXHFB', this%memoryPath)
515 call mem_allocate(this%noden, this%maxhfb,
'NODEN', this%memoryPath)
516 call mem_allocate(this%nodem, this%maxhfb,
'NODEM', this%memoryPath)
517 call mem_allocate(this%hydchr, this%maxhfb,
'HYDCHR', this%memoryPath)
518 call mem_allocate(this%idxloc, this%maxhfb,
'IDXLOC', this%memoryPath)
519 call mem_allocate(this%csatsav, this%maxhfb,
'CSATSAV', this%memoryPath)
520 call mem_allocate(this%condsav, this%maxhfb,
'CONDSAV', this%memoryPath)
523 do ihfb = 1, this%maxhfb
524 this%idxloc(ihfb) = 0
540 call mem_set_value(this%iprpak,
'PRINT_INPUT', this%input_mempath, &
544 write (this%iout,
'(1x,a)')
'PROCESSING HFB OPTIONS'
545 if (found%print_input)
then
546 write (this%iout,
'(4x,a)') &
547 'THE LIST OF HFBS WILL BE PRINTED.'
549 write (this%iout,
'(1x,a)')
'END OF HFB OPTIONS'
564 call mem_set_value(this%maxhfb,
'MAXBOUND', this%input_mempath, &
568 write (this%iout,
'(/1x,a)')
'PROCESSING HFB DIMENSIONS'
569 write (this%iout,
'(4x,a,i7)')
'MAXHFB = ', this%maxhfb
570 write (this%iout,
'(1x,a)')
'END OF HFB DIMENSIONS'
573 if (this%maxhfb <= 0)
then
575 'MAXHFB must be specified with value greater than zero.'
592 integer(I4B),
dimension(:, :),
pointer,
contiguous :: cellids1, cellids2
593 integer(I4B),
dimension(:),
pointer :: cellid1, cellid2
594 real(DP),
dimension(:),
pointer,
contiguous :: hydchr
595 character(len=LINELENGTH) :: nodenstr, nodemstr
596 integer(I4B),
pointer :: nbound
597 integer(I4B) :: n, nodeu1, nodeu2, noder1, noder2
599 character(len=*),
parameter :: fmthfb =
"(i10, 2a10, 1(1pg15.6))"
602 call mem_setptr(nbound,
'NBOUND', this%input_mempath)
603 call mem_setptr(cellids1,
'CELLID1', this%input_mempath)
604 call mem_setptr(cellids2,
'CELLID2', this%input_mempath)
605 call mem_setptr(hydchr,
'HYDCHR', this%input_mempath)
611 write (this%iout,
'(//,1x,a)')
'READING HFB DATA'
612 if (this%iprpak > 0)
then
613 write (this%iout,
'(3a10, 1a15)')
'HFB NUM',
'CELL1',
'CELL2', &
621 cellid1 => cellids1(:, n)
622 cellid2 => cellids2(:, n)
625 if (this%dis%ndim == 1)
then
628 elseif (this%dis%ndim == 2)
then
629 nodeu1 =
get_node(cellid1(1), 1, cellid1(2), &
630 this%dis%mshape(1), 1, &
632 nodeu2 =
get_node(cellid2(1), 1, cellid2(2), &
633 this%dis%mshape(1), 1, &
636 nodeu1 =
get_node(cellid1(1), cellid1(2), cellid1(3), &
637 this%dis%mshape(1), &
638 this%dis%mshape(2), &
640 nodeu2 =
get_node(cellid2(1), cellid2(2), cellid2(3), &
641 this%dis%mshape(1), &
642 this%dis%mshape(2), &
647 noder1 = this%dis%get_nodenumber(nodeu1, 1)
648 noder2 = this%dis%get_nodenumber(nodeu2, 1)
649 if (noder1 <= 0 .or. &
653 this%noden(n) = noder1
654 this%nodem(n) = noder2
657 this%hydchr(n) = hydchr(n)
660 if (this%iprpak /= 0)
then
661 call this%dis%noder_to_string(this%noden(n), nodenstr)
662 call this%dis%noder_to_string(this%nodem(n), nodemstr)
663 write (this%iout, fmthfb) n, trim(adjustl(nodenstr)), &
664 trim(adjustl(nodemstr)), this%hydchr(n)
670 call store_error(
'Errors encountered in HFB input file.')
675 write (this%iout,
'(3x,i0,a,i0)') this%nhfb, &
676 ' HFBs READ FOR STRESS PERIOD ',
kper
677 write (this%iout,
'(1x,a)')
'END READING HFB DATA'
680 call this%check_data()
693 integer(I4B) :: ihfb, n, m
695 character(len=LINELENGTH) :: nodenstr, nodemstr
698 character(len=*),
parameter :: fmterr =
"(1x, 'HFB no. ',i0, &
699 &' is between two unconnected cells: ', a, ' and ', a)"
700 character(len=*),
parameter :: fmtverr =
"(1x, 'HFB no. ',i0, &
701 &' is between two cells not horizontally connected: ', a, ' and ', a)"
703 do ihfb = 1, this%nhfb
707 do ipos = this%ia(n) + 1, this%ia(n + 1) - 1
708 if (m == this%ja(ipos))
then
710 this%idxloc(ihfb) = ipos
716 if (.not. found)
then
717 call this%dis%noder_to_string(n, nodenstr)
718 call this%dis%noder_to_string(m, nodemstr)
719 write (
errmsg, fmterr) ihfb, trim(adjustl(nodenstr)), &
720 trim(adjustl(nodemstr))
740 do ihfb = 1, this%nhfb
741 ipos = this%idxloc(ihfb)
742 this%condsat(this%jas(ipos)) = this%csatsav(ihfb)
758 integer(I4B) :: ihfb, n, m
760 real(DP) :: cond, condhfb
761 real(DP) :: fawidth, faheight, faarea
762 real(DP) :: topn, topm, botn, botm
764 do ihfb = 1, this%nhfb
765 ipos = this%idxloc(ihfb)
766 cond = this%condsat(this%jas(ipos))
767 this%csatsav(ihfb) = cond
771 if (this%inewton == 1 .or. &
772 (this%icelltype(n) == 0 .and. this%icelltype(m) == 0))
then
779 if (this%ihc(this%jas(ipos)) == 2)
then
780 faheight = min(topn, topm) - max(botn, botm)
782 faheight =
dhalf * ((topn - botn) + (topm - botm))
785 if (this%ihc(this%jas(ipos)) == 0)
then
786 faarea = this%hwva(this%jas(ipos))
788 fawidth = this%hwva(this%jas(ipos))
789 faarea = fawidth * faheight
792 if (this%hydchr(ihfb) >
dzero)
then
793 condhfb = this%hydchr(ihfb) * faarea
794 cond = cond * condhfb / (cond + condhfb)
796 cond = -cond * this%hydchr(ihfb)
798 this%condsat(this%jas(ipos)) = cond
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dzero
real constant zero
real(dp), parameter done
real constant 1
integer(i4b) function, public get_node(ilay, irow, icol, nlay, nrow, ncol)
Get node number, given layer, row, and column indices for a structured grid. If any argument is inval...
subroutine hfb_fc(this, kiter, matrix_sln, idxglo, rhs, hnew)
Fill matrix terms.
subroutine check_data(this)
Check for hfb's between two unconnected cells and write a warning.
subroutine hfb_da(this)
Deallocate memory.
subroutine hfb_cq(this, hnew, flowja)
flowja will automatically include the effects of the hfb for confined and newton cases when xt3d is n...
subroutine, public hfb_cr(hfbobj, name_model, input_mempath, inunit, iout)
Create a new hfb object.
subroutine allocate_scalars(this)
Allocate package scalars.
subroutine condsat_modify(this)
Modify condsat.
subroutine condsat_reset(this)
Reset condsat to its value prior to being modified by hfb's.
subroutine source_data(this)
@ brief source hfb period data
subroutine source_dimensions(this)
@ brief Source hfb input options
subroutine hfb_rp(this)
Check for new HFB stress period data.
subroutine allocate_arrays(this)
Allocate package arrays.
subroutine hfb_ar(this, ibound, xt3d, dis, invsc, vsc)
Allocate and read.
subroutine source_options(this)
@ brief Source hfb input options
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 base numerical package type.
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