MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
gwfhfbmodule Module Reference

Data Types

type  gwfhfbtype
 

Functions/Subroutines

subroutine, public hfb_cr (hfbobj, name_model, input_mempath, inunit, iout)
 Create a new hfb object. More...
 
subroutine hfb_ar (this, ibound, xt3d, dis, invsc, vsc)
 Allocate and read. More...
 
subroutine hfb_rp (this)
 Check for new HFB stress period data. More...
 
subroutine hfb_fc (this, kiter, matrix_sln, idxglo, rhs, hnew)
 Fill matrix terms. More...
 
subroutine hfb_cq (this, hnew, flowja)
 flowja will automatically include the effects of the hfb for confined and newton cases when xt3d is not used. More...
 
subroutine hfb_da (this)
 Deallocate memory. More...
 
subroutine allocate_scalars (this)
 Allocate package scalars. More...
 
subroutine allocate_arrays (this)
 Allocate package arrays. More...
 
subroutine source_options (this)
 @ brief Source hfb input options More...
 
subroutine source_dimensions (this)
 @ brief Source hfb input options More...
 
subroutine source_data (this)
 @ brief source hfb period data More...
 
subroutine check_data (this)
 Check for hfb's between two unconnected cells and write a warning. More...
 
subroutine condsat_reset (this)
 Reset condsat to its value prior to being modified by hfb's. More...
 
subroutine condsat_modify (this)
 Modify condsat. More...
 

Function/Subroutine Documentation

◆ allocate_arrays()

subroutine gwfhfbmodule::allocate_arrays ( class(gwfhfbtype this)

Definition at line 507 of file gwf-hfb.f90.

508  ! -- modules
510  ! -- dummy
511  class(GwfHfbType) :: this
512  ! -- local
513  integer(I4B) :: ihfb
514  !
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)
521  !
522  ! -- initialize idxloc to 0
523  do ihfb = 1, this%maxhfb
524  this%idxloc(ihfb) = 0
525  end do

◆ allocate_scalars()

subroutine gwfhfbmodule::allocate_scalars ( class(gwfhfbtype this)

Definition at line 483 of file gwf-hfb.f90.

484  ! -- modules
486  ! -- dummy
487  class(GwfHfbType) :: this
488  !
489  ! -- allocate scalars in NumericalPackageType
490  call this%NumericalPackageType%allocate_scalars()
491  !
492  ! -- allocate scalars
493  call mem_allocate(this%maxhfb, 'MAXHFB', this%memoryPath)
494  call mem_allocate(this%nhfb, 'NHFB', this%memoryPath)
495  !
496  ! -- allocate flag for determining if vsc active
497  call mem_allocate(this%ivsc, 'IVSC', this%memoryPath)
498  !
499  ! -- initialize
500  this%maxhfb = 0
501  this%nhfb = 0
502  this%ivsc = 0

◆ check_data()

subroutine gwfhfbmodule::check_data ( class(gwfhfbtype this)

Store ipos in idxloc

Definition at line 687 of file gwf-hfb.f90.

688  ! -- modules
689  use constantsmodule, only: linelength
690  ! -- dummy
691  class(GwfHfbType) :: this
692  ! -- local
693  integer(I4B) :: ihfb, n, m
694  integer(I4B) :: ipos
695  character(len=LINELENGTH) :: nodenstr, nodemstr
696  logical :: found
697  ! -- formats
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)"
702  !
703  do ihfb = 1, this%nhfb
704  n = this%noden(ihfb)
705  m = this%nodem(ihfb)
706  found = .false.
707  do ipos = this%ia(n) + 1, this%ia(n + 1) - 1
708  if (m == this%ja(ipos)) then
709  found = .true.
710  this%idxloc(ihfb) = ipos
711  exit
712  end if
713  end do
714  !
715  ! -- check to make sure cells are connected
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))
721  call store_error(errmsg)
722  end if
723  end do
724  !
725  ! -- Stop if errors detected
726  if (count_errors() > 0) then
727  call store_error_filename(this%input_fname)
728  end if
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
Here is the call graph for this function:

◆ condsat_modify()

subroutine gwfhfbmodule::condsat_modify ( class(gwfhfbtype this)
private

Modify condsat for the following conditions:

  1. If Newton is active
  2. If icelltype for n and icelltype for m is 0

Definition at line 752 of file gwf-hfb.f90.

753  ! -- modules
754  use constantsmodule, only: dhalf, dzero
755  ! -- dummy
756  class(GwfHfbType) :: this
757  ! -- local
758  integer(I4B) :: ihfb, n, m
759  integer(I4B) :: ipos
760  real(DP) :: cond, condhfb
761  real(DP) :: fawidth, faheight, faarea
762  real(DP) :: topn, topm, botn, botm
763  !
764  do ihfb = 1, this%nhfb
765  ipos = this%idxloc(ihfb)
766  cond = this%condsat(this%jas(ipos))
767  this%csatsav(ihfb) = cond
768  n = this%noden(ihfb)
769  m = this%nodem(ihfb)
770  !
771  if (this%inewton == 1 .or. &
772  (this%icelltype(n) == 0 .and. this%icelltype(m) == 0)) then
773  !
774  ! -- Calculate hfb conductance
775  topn = this%top(n)
776  topm = this%top(m)
777  botn = this%bot(n)
778  botm = this%bot(m)
779  if (this%ihc(this%jas(ipos)) == 2) then
780  faheight = min(topn, topm) - max(botn, botm)
781  else
782  faheight = dhalf * ((topn - botn) + (topm - botm))
783  end if
784 
785  if (this%ihc(this%jas(ipos)) == 0) then
786  faarea = this%hwva(this%jas(ipos))
787  else
788  fawidth = this%hwva(this%jas(ipos))
789  faarea = fawidth * faheight
790  end if
791 
792  if (this%hydchr(ihfb) > dzero) then
793  condhfb = this%hydchr(ihfb) * faarea
794  cond = cond * condhfb / (cond + condhfb)
795  else
796  cond = -cond * this%hydchr(ihfb)
797  end if
798  this%condsat(this%jas(ipos)) = cond
799  end if
800  end do
real(dp), parameter dhalf
real constant 1/2
Definition: Constants.f90:68
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65

◆ condsat_reset()

subroutine gwfhfbmodule::condsat_reset ( class(gwfhfbtype this)

Definition at line 733 of file gwf-hfb.f90.

734  ! -- dummy
735  class(GwfHfbType) :: this
736  ! -- local
737  integer(I4B) :: ihfb
738  integer(I4B) :: ipos
739  !
740  do ihfb = 1, this%nhfb
741  ipos = this%idxloc(ihfb)
742  this%condsat(this%jas(ipos)) = this%csatsav(ihfb)
743  end do

◆ hfb_ar()

subroutine gwfhfbmodule::hfb_ar ( class(gwfhfbtype this,
integer(i4b), dimension(:), pointer, contiguous  ibound,
type(xt3dtype), pointer  xt3d,
class(disbasetype), intent(inout), pointer  dis,
integer(i4b), pointer  invsc,
type(gwfvsctype), intent(in), pointer  vsc 
)
private
Parameters
[in,out]disdiscretization package
invscindicates if viscosity package is active
[in]vscviscosity package

Definition at line 94 of file gwf-hfb.f90.

95  ! -- modules
98  ! -- dummy
99  class(GwfHfbType) :: this
100  integer(I4B), dimension(:), pointer, contiguous :: ibound
101  type(Xt3dType), pointer :: xt3d
102  class(DisBaseType), pointer, intent(inout) :: dis !< discretization package
103  integer(I4B), pointer :: invsc !< indicates if viscosity package is active
104  type(GwfVscType), pointer, intent(in) :: vsc !< viscosity package
105  ! -- formats
106  character(len=*), parameter :: fmtheader = &
107  "(1x, /1x, 'HFB -- HORIZONTAL FLOW BARRIER PACKAGE, VERSION 8, ', &
108  &'4/24/2015 INPUT READ FROM MEMPATH: ', a, /)"
109  !
110  ! -- Print a message identifying the node property flow package.
111  write (this%iout, fmtheader) this%input_mempath
112  !
113  ! -- Set pointers
114  this%dis => dis
115  this%ibound => ibound
116  this%xt3d => xt3d
117  !
118  call mem_setptr(this%icelltype, 'ICELLTYPE', &
119  create_mem_path(this%name_model, 'NPF'))
120  call mem_setptr(this%ihc, 'IHC', create_mem_path(this%name_model, 'CON'))
121  call mem_setptr(this%ia, 'IA', create_mem_path(this%name_model, 'CON'))
122  call mem_setptr(this%ja, 'JA', create_mem_path(this%name_model, 'CON'))
123  call mem_setptr(this%jas, 'JAS', create_mem_path(this%name_model, 'CON'))
124  call mem_setptr(this%isym, 'ISYM', create_mem_path(this%name_model, 'CON'))
125  call mem_setptr(this%condsat, 'CONDSAT', create_mem_path(this%name_model, &
126  'NPF'))
127  call mem_setptr(this%top, 'TOP', create_mem_path(this%name_model, 'DIS'))
128  call mem_setptr(this%bot, 'BOT', create_mem_path(this%name_model, 'DIS'))
129  call mem_setptr(this%hwva, 'HWVA', create_mem_path(this%name_model, 'CON'))
130  !
131  call this%source_options()
132  call this%source_dimensions()
133  call this%allocate_arrays()
134  !
135  ! -- If vsc package active, set ivsc
136  if (invsc /= 0) then
137  this%ivsc = 1
138  this%vsc => vsc
139  !
140  ! -- Notify user via listing file viscosity accounted for by HFB package
141  write (this%iout, '(/1x,a,a)') 'Viscosity active in ', &
142  trim(this%filtyp)//' Package calculations: '//trim(adjustl(this%packName))
143  end if
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
Here is the call graph for this function:

◆ hfb_cq()

subroutine gwfhfbmodule::hfb_cq ( class(gwfhfbtype this,
real(dp), dimension(:), intent(inout)  hnew,
real(dp), dimension(:), intent(inout)  flowja 
)

This method recalculates flowja for the other cases.

Definition at line 334 of file gwf-hfb.f90.

335  ! -- modules
336  use constantsmodule, only: dhalf, dzero, done
337  ! -- dummy
338  class(GwfHfbType) :: this
339  real(DP), intent(inout), dimension(:) :: hnew
340  real(DP), intent(inout), dimension(:) :: flowja
341  ! -- local
342  integer(I4B) :: ihfb, n, m
343  integer(I4B) :: ipos
344  real(DP) :: qnm
345  real(DP) :: cond
346  integer(I4B) :: ixt3d
347  real(DP) :: condhfb
348  real(DP) :: fawidth, faheight, faarea
349  real(DP) :: topn, topm, botn, botm
350  real(DP) :: viscratio
351  !
352  ! -- initialize viscratio
353  viscratio = done
354  !
355  if (associated(this%xt3d%ixt3d)) then
356  ixt3d = this%xt3d%ixt3d
357  else
358  ixt3d = 0
359  end if
360  !
361  if (ixt3d > 0) then
362  !
363  do ihfb = 1, this%nhfb
364  n = min(this%noden(ihfb), this%nodem(ihfb))
365  m = max(this%noden(ihfb), this%nodem(ihfb))
366  ! -- Skip if either cell is inactive.
367  if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
368  !!! if(this%icelltype(n) == 1 .or. this%icelltype(m) == 1) then
369  if (this%ivsc /= 0) then
370  call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
371  end if
372  !
373  ! -- Compute scale factor for hfb correction
374  if (this%hydchr(ihfb) > dzero) then
375  if (this%inewton == 0) then
376  ipos = this%idxloc(ihfb)
377  topn = this%top(n)
378  topm = this%top(m)
379  botn = this%bot(n)
380  botm = this%bot(m)
381  if (this%icelltype(n) == 1) then
382  if (hnew(n) < topn) topn = hnew(n)
383  end if
384  if (this%icelltype(m) == 1) then
385  if (hnew(m) < topm) topm = hnew(m)
386  end if
387  if (this%ihc(this%jas(ipos)) == 2) then
388  faheight = min(topn, topm) - max(botn, botm)
389  else
390  faheight = dhalf * ((topn - botn) + (topm - botm))
391  end if
392 
393  if (this%ihc(this%jas(ipos)) == 0) then
394  faarea = this%hwva(this%jas(ipos))
395  else
396  fawidth = this%hwva(this%jas(ipos))
397  faarea = fawidth * faheight
398  end if
399 
400  fawidth = this%hwva(this%jas(ipos))
401  condhfb = this%hydchr(ihfb) * viscratio * faarea
402  else
403  condhfb = this%hydchr(ihfb)
404  end if
405  else
406  condhfb = this%hydchr(ihfb)
407  end if
408  ! -- Make hfb corrections for xt3d
409  call this%xt3d%xt3d_flowjahfb(n, m, hnew, flowja, condhfb)
410  end do
411  !
412  else
413  !
414  ! -- Recalculate flowja for non-newton unconfined.
415  if (this%inewton == 0) then
416  do ihfb = 1, this%nhfb
417  n = this%noden(ihfb)
418  m = this%nodem(ihfb)
419  if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
420  if (this%icelltype(n) == 1 .or. this%icelltype(m) == 1 .or. &
421  this%ivsc /= 0) then
422  ipos = this%dis%con%getjaindex(n, m)
423  !
424  ! -- condsav already accnts for visc adjustment
425  cond = this%condsav(ihfb)
426  qnm = cond * (hnew(m) - hnew(n))
427  flowja(ipos) = qnm
428  ipos = this%dis%con%getjaindex(m, n)
429  flowja(ipos) = -qnm
430  !
431  end if
432  end do
433  end if
434  !
435  end if
real(dp), parameter done
real constant 1
Definition: Constants.f90:76

◆ hfb_cr()

subroutine, public gwfhfbmodule::hfb_cr ( type(gwfhfbtype), pointer  hfbobj,
character(len=*), intent(in)  name_model,
character(len=*), intent(in)  input_mempath,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout 
)

Definition at line 70 of file gwf-hfb.f90.

71  ! -- dummy
72  type(GwfHfbType), pointer :: hfbobj
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
77  !
78  ! -- Create the object
79  allocate (hfbobj)
80  !
81  ! -- create name and memory path
82  call hfbobj%set_names(1, name_model, 'HFB', 'HFB', input_mempath)
83  !
84  ! -- Allocate scalars
85  call hfbobj%allocate_scalars()
86  !
87  ! -- Save unit numbers
88  hfbobj%inunit = inunit
89  hfbobj%iout = iout
Here is the caller graph for this function:

◆ hfb_da()

subroutine gwfhfbmodule::hfb_da ( class(gwfhfbtype this)

Definition at line 440 of file gwf-hfb.f90.

441  ! -- modules
443  ! -- dummy
444  class(GwfHfbType) :: this
445  !
446  ! -- Scalars
447  call mem_deallocate(this%maxhfb)
448  call mem_deallocate(this%nhfb)
449  call mem_deallocate(this%ivsc)
450  !
451  ! -- Arrays
452  if (this%inunit > 0) then
453  call mem_deallocate(this%noden)
454  call mem_deallocate(this%nodem)
455  call mem_deallocate(this%hydchr)
456  call mem_deallocate(this%idxloc)
457  call mem_deallocate(this%csatsav)
458  call mem_deallocate(this%condsav)
459  end if
460  !
461  ! -- deallocate parent
462  call this%NumericalPackageType%da()
463  !
464  ! -- nullify pointers
465  this%xt3d => null()
466  this%inewton => null()
467  this%ibound => null()
468  this%icelltype => null()
469  this%ihc => null()
470  this%ia => null()
471  this%ja => null()
472  this%jas => null()
473  this%isym => null()
474  this%condsat => null()
475  this%top => null()
476  this%bot => null()
477  this%hwva => null()
478  this%vsc => null()

◆ hfb_fc()

subroutine gwfhfbmodule::hfb_fc ( class(gwfhfbtype this,
integer(i4b)  kiter,
class(matrixbasetype), pointer  matrix_sln,
integer(i4b), dimension(:), intent(in)  idxglo,
real(dp), dimension(:), intent(inout)  rhs,
real(dp), dimension(:), intent(inout)  hnew 
)

Fill amatsln for the following conditions:

  1. XT3D OR
  2. Not Newton, and
  3. Cell type n is convertible or cell type m is convertible

Definition at line 178 of file gwf-hfb.f90.

179  ! -- modules
180  use constantsmodule, only: dhalf, dzero, done
181  ! -- dummy
182  class(GwfHfbType) :: this
183  integer(I4B) :: kiter
184  class(MatrixBaseType), pointer :: matrix_sln
185  integer(I4B), intent(in), dimension(:) :: idxglo
186  real(DP), intent(inout), dimension(:) :: rhs
187  real(DP), intent(inout), dimension(:) :: hnew
188  ! -- local
189  integer(I4B) :: nodes, nja
190  integer(I4B) :: ihfb, n, m
191  integer(I4B) :: ipos
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
198  !
199  ! -- initialize variables
200  viscratio = done
201  nodes = this%dis%nodes
202  nja = this%dis%con%nja
203  if (associated(this%xt3d%ixt3d)) then
204  ixt3d = this%xt3d%ixt3d
205  else
206  ixt3d = 0
207  end if
208  !
209  if (ixt3d > 0) then
210  !
211  do ihfb = 1, this%nhfb
212  n = min(this%noden(ihfb), this%nodem(ihfb))
213  m = max(this%noden(ihfb), this%nodem(ihfb))
214  ! -- Skip if either cell is inactive.
215  if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
216  !!! if(this%icelltype(n) == 1 .or. this%icelltype(m) == 1) then
217  if (this%ivsc /= 0) then
218  call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
219  end if
220  ! -- Compute scale factor for hfb correction
221  if (this%hydchr(ihfb) > dzero) then
222  if (this%inewton == 0) then
223  ipos = this%idxloc(ihfb)
224  topn = this%top(n)
225  topm = this%top(m)
226  botn = this%bot(n)
227  botm = this%bot(m)
228  if (this%icelltype(n) == 1) then
229  if (hnew(n) < topn) topn = hnew(n)
230  end if
231  if (this%icelltype(m) == 1) then
232  if (hnew(m) < topm) topm = hnew(m)
233  end if
234  if (this%ihc(this%jas(ipos)) == 2) then
235  faheight = min(topn, topm) - max(botn, botm)
236  else
237  faheight = dhalf * ((topn - botn) + (topm - botm))
238  end if
239 
240  if (this%ihc(this%jas(ipos)) == 0) then
241  faarea = this%hwva(this%jas(ipos))
242  else
243  fawidth = this%hwva(this%jas(ipos))
244  faarea = fawidth * faheight
245  end if
246 
247  condhfb = this%hydchr(ihfb) * viscratio * faarea
248  else
249  condhfb = this%hydchr(ihfb) * viscratio
250  end if
251  else
252  condhfb = this%hydchr(ihfb)
253  end if
254  ! -- Make hfb corrections for xt3d
255  call this%xt3d%xt3d_fhfb(kiter, nodes, nja, matrix_sln, idxglo, &
256  rhs, hnew, n, m, condhfb)
257  end do
258  !
259  else
260  !
261  ! -- For Newton, the effect of the barrier is included in condsat.
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))
266  n = this%noden(ihfb)
267  m = this%nodem(ihfb)
268  if (this%ibound(n) == 0 .or. this%ibound(m) == 0) cycle
269  !
270  if (this%ivsc /= 0) then
271  call this%vsc%get_visc_ratio(n, m, hnew(n), hnew(m), viscratio)
272  end if
273  !
274  if (this%icelltype(n) == 1 .or. this%icelltype(m) == 1 .or. &
275  this%ivsc /= 0) then
276  !
277  ! -- Calculate hfb conductance
278  topn = this%top(n)
279  topm = this%top(m)
280  botn = this%bot(n)
281  botm = this%bot(m)
282  if (this%icelltype(n) == 1) then
283  if (hnew(n) < topn) topn = hnew(n)
284  end if
285  if (this%icelltype(m) == 1) then
286  if (hnew(m) < topm) topm = hnew(m)
287  end if
288  if (this%ihc(this%jas(ipos)) == 2) then
289  faheight = min(topn, topm) - max(botn, botm)
290  else
291  faheight = dhalf * ((topn - botn) + (topm - botm))
292  end if
293 
294  if (this%ihc(this%jas(ipos)) == 0) then
295  faarea = this%hwva(this%jas(ipos))
296  else
297  fawidth = this%hwva(this%jas(ipos))
298  faarea = fawidth * faheight
299  end if
300 
301  if (this%hydchr(ihfb) > dzero) then
302  condhfb = this%hydchr(ihfb) * viscratio * faarea
303  cond = aterm * condhfb / (aterm + condhfb)
304  else
305  cond = -aterm * this%hydchr(ihfb)
306  end if
307  !
308  ! -- Save cond for budget calculation
309  this%condsav(ihfb) = cond
310  !
311  ! -- Fill row n diag and off diag
312  idiag = this%ia(n)
313  call matrix_sln%add_value_pos(idxglo(idiag), aterm - cond)
314  call matrix_sln%set_value_pos(idxglo(ipos), cond)
315  !
316  ! -- Fill row m diag and off diag
317  isymcon = this%isym(ipos)
318  idiag = this%ia(m)
319  call matrix_sln%add_value_pos(idxglo(idiag), aterm - cond)
320  call matrix_sln%set_value_pos(idxglo(isymcon), cond)
321  !
322  end if
323  end do
324  end if
325  !
326  end if

◆ hfb_rp()

subroutine gwfhfbmodule::hfb_rp ( class(gwfhfbtype this)

Definition at line 148 of file gwf-hfb.f90.

149  ! -- modules
151  use tdismodule, only: kper
152  ! -- dummy
153  class(GwfHfbType) :: this
154  ! -- local
155  integer(I4B), pointer :: iper
156  ! -- formats
157  character(len=*), parameter :: fmtlsp = &
158  &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
159 
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()
165  else
166  write (this%iout, fmtlsp) 'HFB'
167  end if
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23

◆ source_data()

subroutine gwfhfbmodule::source_data ( class(gwfhfbtype), intent(inout)  this)

Definition at line 583 of file gwf-hfb.f90.

584  ! -- modules
585  use tdismodule, only: kper
586  use constantsmodule, only: linelength
588  use geomutilmodule, only: get_node
589  ! -- dummy
590  class(GwfHfbType), intent(inout) :: this
591  ! -- local
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
598  ! -- formats
599  character(len=*), parameter :: fmthfb = "(i10, 2a10, 1(1pg15.6))"
600 
601  ! set input context pointers
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)
606 
607  ! set nhfb
608  this%nhfb = nbound
609 
610  ! log data
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', &
614  'HYDCHR'
615  end if
616 
617  ! update state
618  do n = 1, this%nhfb
619 
620  ! set cellid
621  cellid1 => cellids1(:, n)
622  cellid2 => cellids2(:, n)
623 
624  ! set node user
625  if (this%dis%ndim == 1) then
626  nodeu1 = cellid1(1)
627  nodeu2 = cellid2(1)
628  elseif (this%dis%ndim == 2) then
629  nodeu1 = get_node(cellid1(1), 1, cellid1(2), &
630  this%dis%mshape(1), 1, &
631  this%dis%mshape(2))
632  nodeu2 = get_node(cellid2(1), 1, cellid2(2), &
633  this%dis%mshape(1), 1, &
634  this%dis%mshape(2))
635  else
636  nodeu1 = get_node(cellid1(1), cellid1(2), cellid1(3), &
637  this%dis%mshape(1), &
638  this%dis%mshape(2), &
639  this%dis%mshape(3))
640  nodeu2 = get_node(cellid2(1), cellid2(2), cellid2(3), &
641  this%dis%mshape(1), &
642  this%dis%mshape(2), &
643  this%dis%mshape(3))
644  end if
645 
646  ! set nodes
647  noder1 = this%dis%get_nodenumber(nodeu1, 1)
648  noder2 = this%dis%get_nodenumber(nodeu2, 1)
649  if (noder1 <= 0 .or. &
650  noder2 <= 0) then
651  cycle
652  else
653  this%noden(n) = noder1
654  this%nodem(n) = noder2
655  end if
656 
657  this%hydchr(n) = hydchr(n)
658 
659  ! print input if requested
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)
665  end if
666  end do
667 
668  ! check errors
669  if (count_errors() > 0) then
670  call store_error('Errors encountered in HFB input file.')
671  call store_error_filename(this%input_fname)
672  end if
673 
674  ! finalize logging
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'
678 
679  ! input data check
680  call this%check_data()
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...
Definition: GeomUtil.f90:83
Here is the call graph for this function:

◆ source_dimensions()

subroutine gwfhfbmodule::source_dimensions ( class(gwfhfbtype this)

Definition at line 554 of file gwf-hfb.f90.

555  ! -- modules
558  ! -- dummy
559  class(GwfHfbType) :: this
560  ! -- local
561  type(GwfHfbParamFoundType) :: found
562 
563  ! update dimensions from input context
564  call mem_set_value(this%maxhfb, 'MAXBOUND', this%input_mempath, &
565  found%maxbound)
566 
567  ! log dimensions
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'
571 
572  ! check dimensions
573  if (this%maxhfb <= 0) then
574  write (errmsg, '(a)') &
575  'MAXHFB must be specified with value greater than zero.'
576  call store_error(errmsg)
577  call store_error_filename(this%input_mempath)
578  end if
Here is the call graph for this function:

◆ source_options()

subroutine gwfhfbmodule::source_options ( class(gwfhfbtype this)

Definition at line 530 of file gwf-hfb.f90.

531  ! -- modules
534  ! -- dummy
535  class(GwfHfbType) :: this
536  ! -- local
537  type(GwfHfbParamFoundType) :: found
538 
539  ! update options from input context
540  call mem_set_value(this%iprpak, 'PRINT_INPUT', this%input_mempath, &
541  found%print_input)
542 
543  ! log options
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.'
548  end if
549  write (this%iout, '(1x,a)') 'END OF HFB OPTIONS'