MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
gwt-uzt.f90
Go to the documentation of this file.
1 ! -- Unsaturated Zone Flow Transport Module
2 ! -- todo: what to do about reactions in uzf? Decay?
3 ! -- todo: save the uzt concentration into the uzt aux variable?
4 ! -- todo: calculate the uzf DENSE aux variable using concentration?
5 ! -- todo: GWD and GWD-TO-MVR do not seem to be included; prob in UZF?
6 !
7 ! UZF flows (flowbudptr) index var UZT term Transport Type
8 !---------------------------------------------------------------------------------
9 
10 ! -- terms from UZF that will be handled by parent APT Package
11 ! FLOW-JA-FACE idxbudfjf FLOW-JA-FACE cv2cv
12 ! GWF (aux FLOW-AREA) idxbudgwf GWF uzf2gwf
13 ! STORAGE (aux VOLUME) idxbudsto none used for water volumes
14 ! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:)
15 ! AUXILIARY none none none
16 ! none none STORAGE (aux MASS)
17 ! none none AUXILIARY none
18 
19 ! -- terms from UZF that need to be handled here
20 ! INFILTRATION idxbudinfl INFILTRATION q < 0: q * cwell, else q * cuser
21 ! REJ-INF idxbudrinf REJ-INF q * cuzt
22 ! UZET idxbuduzet UZET q * cet
23 ! REJ-INF-TO-MVR idxbudritm REJ-INF-TO-MVR q * cinfil?
24 
25 ! -- terms from UZF that should be skipped
26 
28 
29  use kindmodule, only: dp, i4b
34  use bndmodule, only: bndtype, getbndfromlist
35  use tspfmimodule, only: tspfmitype
36  use uzfmodule, only: uzftype
37  use observemodule, only: observetype
41  implicit none
42 
43  public uzt_create
44 
45  character(len=*), parameter :: ftype = 'UZT'
46  character(len=*), parameter :: flowtype = 'UZF'
47  character(len=16) :: text = ' UZT'
48 
49  type, extends(tspapttype) :: gwtuzttype
50 
51  integer(I4B), pointer :: idxbudinfl => null() ! index of uzf infiltration terms in flowbudptr
52  integer(I4B), pointer :: idxbudrinf => null() ! index of rejected infiltration terms in flowbudptr
53  integer(I4B), pointer :: idxbuduzet => null() ! index of unsat et terms in flowbudptr
54  integer(I4B), pointer :: idxbudritm => null() ! index of rej infil to mover rate to mover terms in flowbudptr
55  real(dp), dimension(:), pointer, contiguous :: concinfl => null() ! infiltration concentration
56  real(dp), dimension(:), pointer, contiguous :: concuzet => null() ! unsat et concentration
57 
58  contains
59 
60  procedure :: bnd_da => uzt_da
61  procedure :: allocate_scalars
62  procedure :: apt_allocate_arrays => uzt_allocate_arrays
63  procedure :: apt_checkin_deprecated_names => uzt_checkin_deprecated_names
64  procedure :: find_apt_package => find_uzt_package
65  procedure :: apt_setting_value => uzt_setting_value
66  procedure :: pak_fc_expanded => uzt_fc_expanded
67  procedure :: pak_solve => uzt_solve
68  procedure :: pak_get_nbudterms => uzt_get_nbudterms
69  procedure :: pak_setup_budobj => uzt_setup_budobj
70  procedure :: pak_fill_budobj => uzt_fill_budobj
71  procedure :: uzt_infl_term
72  procedure :: uzt_rinf_term
73  procedure :: uzt_uzet_term
74  procedure :: uzt_ritm_term
75  procedure :: pak_df_obs => uzt_df_obs
76  procedure :: pak_rp_obs => uzt_rp_obs
77  procedure :: pak_bd_obs => uzt_bd_obs
78  procedure :: get_mvr_depvar
79 
80  end type gwtuzttype
81 
82 contains
83 
84  !> @brief Create a new UZT package
85  !<
86  subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
87  mempath, fmi, eqnsclfac, dvt, dvu, dvua)
88  ! -- dummy
89  class(bndtype), pointer :: packobj
90  integer(I4B), intent(in) :: id
91  integer(I4B), intent(in) :: ibcnum
92  integer(I4B), intent(in) :: inunit
93  integer(I4B), intent(in) :: iout
94  character(len=*), intent(in) :: namemodel
95  character(len=*), intent(in) :: pakname
96  character(len=*), intent(in) :: mempath !< input memory path
97  type(tspfmitype), pointer :: fmi
98  real(dp), intent(in), pointer :: eqnsclfac !< governing equation scale factor
99  character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType
100  character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType
101  character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType
102  ! -- local
103  type(gwtuzttype), pointer :: uztobj
104  !
105  ! -- allocate the object and assign values to object variables
106  allocate (uztobj)
107  packobj => uztobj
108  !
109  ! -- create name and memory path
110  call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
111  packobj%text = text
112  !
113  ! -- allocate scalars
114  call uztobj%allocate_scalars()
115  !
116  ! -- initialize package
117  call packobj%pack_initialize()
118  !
119  packobj%inunit = inunit
120  packobj%iout = iout
121  packobj%id = id
122  packobj%ibcnum = ibcnum
123  packobj%ncolbnd = 1
124  packobj%iscloc = 1
125  packobj%isadvpak = 1
126  !
127  ! -- Store pointer to flow model interface. When the GwfGwt exchange is
128  ! created, it sets fmi%bndlist so that the GWT model has access to all
129  ! the flow packages
130  uztobj%fmi => fmi
131  !
132  ! -- Store pointer to governing equation scale factor
133  uztobj%eqnsclfac => eqnsclfac
134  !
135  ! -- Set labels that will be used in generalized APT class
136  uztobj%depvartype = dvt
137  uztobj%depvarunit = dvu
138  uztobj%depvarunitabbrev = dvua
139  end subroutine uzt_create
140 
141  !> @brief Find corresponding uzt package
142  !<
143  subroutine find_uzt_package(this)
144  ! -- modules
146  ! -- dummy
147  class(gwtuzttype) :: this
148  ! -- local
149  character(len=LINELENGTH) :: errmsg
150  class(bndtype), pointer :: packobj
151  integer(I4B) :: ip, icount
152  integer(I4B) :: nbudterm
153  logical :: found
154  !
155  ! -- Initialize found to false, and error later if flow package cannot
156  ! be found
157  found = .false.
158  !
159  ! -- If user is specifying flows in a binary budget file, then set up
160  ! the budget file reader, otherwise set a pointer to the flow package
161  ! budobj
162  if (this%fmi%flows_from_file) then
163  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
164  if (associated(this%flowbudptr)) found = .true.
165  !
166  else
167  if (associated(this%fmi%gwfbndlist)) then
168  ! -- Look through gwfbndlist for a flow package with the same name as
169  ! this transport package name
170  do ip = 1, this%fmi%gwfbndlist%Count()
171  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
172  if (packobj%packName == this%flowpackagename) then
173  found = .true.
174  !
175  ! -- store BndType pointer to packobj, and then
176  ! use the select type to point to the budobj in flow package
177  this%flowpackagebnd => packobj
178  select type (packobj)
179  type is (uzftype)
180  this%flowbudptr => packobj%budobj
181  end select
182  end if
183  if (found) exit
184  end do
185  end if
186  end if
187  !
188  ! -- error if flow package not found
189  if (.not. found) then
190  write (errmsg, '(a)') 'Could not find flow package with name '&
191  &//trim(adjustl(this%flowpackagename))//'.'
192  call store_error(errmsg)
193  call store_error_filename(this%input_fname)
194  end if
195  !
196  ! -- allocate space for idxbudssm, which indicates whether this is a
197  ! special budget term or one that is a general source and sink
198  nbudterm = this%flowbudptr%nbudterm
199  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
200  !
201  ! -- Process budget terms and identify special budget terms
202  write (this%iout, '(/, a, a)') &
203  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
204  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
205  write (this%iout, '(a, i0)') &
206  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
207  icount = 1
208  do ip = 1, this%flowbudptr%nbudterm
209  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
210  case ('FLOW-JA-FACE')
211  this%idxbudfjf = ip
212  this%idxbudssm(ip) = 0
213  case ('GWF')
214  this%idxbudgwf = ip
215  this%idxbudssm(ip) = 0
216  case ('STORAGE')
217  this%idxbudsto = ip
218  this%idxbudssm(ip) = 0
219  case ('INFILTRATION')
220  this%idxbudinfl = ip
221  this%idxbudssm(ip) = 0
222  case ('REJ-INF')
223  this%idxbudrinf = ip
224  this%idxbudssm(ip) = 0
225  case ('UZET')
226  this%idxbuduzet = ip
227  this%idxbudssm(ip) = 0
228  case ('REJ-INF-TO-MVR')
229  this%idxbudritm = ip
230  this%idxbudssm(ip) = 0
231  case ('TO-MVR')
232  this%idxbudtmvr = ip
233  this%idxbudssm(ip) = 0
234  case ('FROM-MVR')
235  this%idxbudfmvr = ip
236  this%idxbudssm(ip) = 0
237  case ('AUXILIARY')
238  this%idxbudaux = ip
239  this%idxbudssm(ip) = 0
240  case default
241  !
242  ! -- set idxbudssm equal to a column index for where the concentrations
243  ! are stored in the concbud(nbudssm, ncv) array
244  this%idxbudssm(ip) = icount
245  icount = icount + 1
246  end select
247  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
248  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
249  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
250  end do
251  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
252  end subroutine find_uzt_package
253 
254  !> @brief Value for a package-specific PERIOD setting
255  !!
256  !! Already resolved by the input context; this only supplies it for
257  !! the shared apt_rp table echo.
258  !<
259  function uzt_setting_value(this, itemno, key) result(val)
260  ! -- dummy
261  class(gwtuzttype), intent(inout) :: this
262  integer(I4B), intent(in) :: itemno
263  character(len=*), intent(in) :: key
264  real(dp) :: val
265  !
266  val = dzero
267  select case (trim(key))
268  case ('INFILTRATION')
269  val = this%concinfl(itemno)
270  case ('UZET')
271  val = this%concuzet(itemno)
272  end select
273  end function uzt_setting_value
274 
275  !> @brief Add matrix terms related to UZT
276  !!
277  !! This will be called from TspAptType%apt_fc_expanded()
278  !! in order to add matrix terms specifically for this package
279  !<
280  subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
281  ! -- modules
282  ! -- dummy
283  class(gwtuzttype) :: this
284  real(DP), dimension(:), intent(inout) :: rhs
285  integer(I4B), dimension(:), intent(in) :: ia
286  integer(I4B), dimension(:), intent(in) :: idxglo
287  class(matrixbasetype), pointer :: matrix_sln
288  ! -- local
289  integer(I4B) :: j, n1, n2
290  integer(I4B) :: iloc
291  integer(I4B) :: iposd
292  real(DP) :: rrate
293  real(DP) :: rhsval
294  real(DP) :: hcofval
295  !
296  ! -- add infiltration contribution
297  if (this%idxbudinfl /= 0) then
298  do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
299  call this%uzt_infl_term(j, n1, n2, rrate, rhsval, hcofval)
300  iloc = this%idxlocnode(n1)
301  iposd = this%idxpakdiag(n1)
302  call matrix_sln%add_value_pos(iposd, hcofval)
303  rhs(iloc) = rhs(iloc) + rhsval
304  end do
305  end if
306  !
307  ! -- add rejected infiltration contribution
308  if (this%idxbudrinf /= 0) then
309  do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
310  call this%uzt_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
311  iloc = this%idxlocnode(n1)
312  iposd = this%idxpakdiag(n1)
313  call matrix_sln%add_value_pos(iposd, hcofval)
314  rhs(iloc) = rhs(iloc) + rhsval
315  end do
316  end if
317  !
318  ! -- add unsaturated et contribution
319  if (this%idxbuduzet /= 0) then
320  do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
321  call this%uzt_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
322  iloc = this%idxlocnode(n1)
323  iposd = this%idxpakdiag(n1)
324  call matrix_sln%add_value_pos(iposd, hcofval)
325  rhs(iloc) = rhs(iloc) + rhsval
326  end do
327  end if
328  !
329  ! -- add rejected infiltration to mover contribution
330  if (this%idxbudritm /= 0) then
331  do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
332  call this%uzt_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
333  iloc = this%idxlocnode(n1)
334  iposd = this%idxpakdiag(n1)
335  call matrix_sln%add_value_pos(iposd, hcofval)
336  rhs(iloc) = rhs(iloc) + rhsval
337  end do
338  end if
339  end subroutine uzt_fc_expanded
340 
341  !> @brief Explicit solve
342  !!
343  !! Add terms specific to the unsaturated zone to the explicit unsaturated-
344  !! zone solve
345  subroutine uzt_solve(this)
346  ! -- dummy
347  class(gwtuzttype) :: this
348  ! -- local
349  integer(I4B) :: j
350  integer(I4B) :: n1, n2
351  real(DP) :: rrate
352  !
353  ! -- add infiltration contribution
354  if (this%idxbudinfl /= 0) then
355  do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
356  call this%uzt_infl_term(j, n1, n2, rrate)
357  this%dbuff(n1) = this%dbuff(n1) + rrate
358  end do
359  end if
360  !
361  ! -- add rejected infiltration contribution
362  if (this%idxbudrinf /= 0) then
363  do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
364  call this%uzt_rinf_term(j, n1, n2, rrate)
365  this%dbuff(n1) = this%dbuff(n1) + rrate
366  end do
367  end if
368  !
369  ! -- add unsaturated et contribution
370  if (this%idxbuduzet /= 0) then
371  do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
372  call this%uzt_uzet_term(j, n1, n2, rrate)
373  this%dbuff(n1) = this%dbuff(n1) + rrate
374  end do
375  end if
376  !
377  ! -- add rejected infiltration to mover contribution
378  if (this%idxbudritm /= 0) then
379  do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
380  call this%uzt_ritm_term(j, n1, n2, rrate)
381  this%dbuff(n1) = this%dbuff(n1) + rrate
382  end do
383  end if
384  end subroutine uzt_solve
385 
386  !> @brief Function that returns the number of budget terms for this package
387  !!
388  !! This overrides function in parent.
389  !<
390  function uzt_get_nbudterms(this) result(nbudterms)
391  ! -- modules
392  ! -- dummy
393  class(gwtuzttype) :: this
394  ! -- return
395  integer(I4B) :: nbudterms
396  ! -- local
397  !
398  ! -- Number of budget terms is 4
399  nbudterms = 0
400  if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
401  if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
402  if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
403  if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
404  end function uzt_get_nbudterms
405 
406  !> @brief Override similarly named function in APT
407  !!
408  !! Set the concentration to be used by MVT as the user-specified
409  !! concentration applied to the infiltration
410  !<
411  function get_mvr_depvar(this)
412  ! -- dummy
413  class(gwtuzttype) :: this
414  ! -- return
415  real(dp), dimension(:), contiguous, pointer :: get_mvr_depvar
416  !
417  get_mvr_depvar => this%concinfl
418  end function get_mvr_depvar
419 
420  !> @brief Set up the budget object that stores all the unsaturated-zone flows
421  !<
422  subroutine uzt_setup_budobj(this, idx)
423  ! -- modules
424  use constantsmodule, only: lenbudtxt
425  ! -- dummy
426  class(gwtuzttype) :: this
427  integer(I4B), intent(inout) :: idx
428  ! -- local
429  integer(I4B) :: maxlist, naux
430  character(len=LENBUDTXT) :: text
431  !
432  ! -- Infiltration flux
433  text = ' INFILTRATION'
434  idx = idx + 1
435  maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
436  naux = 0
437  call this%budobj%budterm(idx)%initialize(text, &
438  this%name_model, &
439  this%packName, &
440  this%name_model, &
441  this%packName, &
442  maxlist, .false., .false., &
443  naux)
444  !
445  ! -- Rejected infiltration flux (and subsequently removed from the model)
446  if (this%idxbudrinf /= 0) then
447  text = ' REJ-INF'
448  idx = idx + 1
449  maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
450  naux = 0
451  call this%budobj%budterm(idx)%initialize(text, &
452  this%name_model, &
453  this%packName, &
454  this%name_model, &
455  this%packName, &
456  maxlist, .false., .false., &
457  naux)
458  end if
459  !
460  ! -- Evapotranspiration flux originating from the unsaturated zone
461  if (this%idxbuduzet /= 0) then
462  text = ' UZET'
463  idx = idx + 1
464  maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
465  naux = 0
466  call this%budobj%budterm(idx)%initialize(text, &
467  this%name_model, &
468  this%packName, &
469  this%name_model, &
470  this%packName, &
471  maxlist, .false., .false., &
472  naux)
473  end if
474  !
475  ! -- Rejected infiltration flux that is transferred to the MVR/MVT packages
476  if (this%idxbudritm /= 0) then
477  text = ' INF-REJ-TO-MVR'
478  idx = idx + 1
479  maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
480  naux = 0
481  call this%budobj%budterm(idx)%initialize(text, &
482  this%name_model, &
483  this%packName, &
484  this%name_model, &
485  this%packName, &
486  maxlist, .false., .false., &
487  naux)
488  end if
489  end subroutine uzt_setup_budobj
490 
491  !> @brief Copy flow terms into this%budobj
492  subroutine uzt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
493  ! -- modules
494  ! -- dummy
495  class(gwtuzttype) :: this
496  integer(I4B), intent(inout) :: idx
497  real(DP), dimension(:), intent(in) :: x
498  real(DP), dimension(:), contiguous, intent(inout) :: flowja
499  real(DP), intent(inout) :: ccratin
500  real(DP), intent(inout) :: ccratout
501  ! -- local
502  integer(I4B) :: j, n1, n2
503  integer(I4B) :: nlist
504  real(DP) :: q
505  ! -- formats
506  !
507  ! -- INFILTRATION
508  idx = idx + 1
509  nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
510  call this%budobj%budterm(idx)%reset(nlist)
511  do j = 1, nlist
512  call this%uzt_infl_term(j, n1, n2, q)
513  call this%budobj%budterm(idx)%update_term(n1, n2, q)
514  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
515  end do
516  !
517  ! -- REJ-INF
518  if (this%idxbudrinf /= 0) then
519  idx = idx + 1
520  nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
521  call this%budobj%budterm(idx)%reset(nlist)
522  do j = 1, nlist
523  call this%uzt_rinf_term(j, n1, n2, q)
524  call this%budobj%budterm(idx)%update_term(n1, n2, q)
525  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
526  end do
527  end if
528  !
529  ! -- UZET
530  if (this%idxbuduzet /= 0) then
531  idx = idx + 1
532  nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
533  call this%budobj%budterm(idx)%reset(nlist)
534  do j = 1, nlist
535  call this%uzt_uzet_term(j, n1, n2, q)
536  call this%budobj%budterm(idx)%update_term(n1, n2, q)
537  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
538  end do
539  end if
540  !
541  ! -- REJ-INF-TO-MVR
542  if (this%idxbudritm /= 0) then
543  idx = idx + 1
544  nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
545  call this%budobj%budterm(idx)%reset(nlist)
546  do j = 1, nlist
547  call this%uzt_ritm_term(j, n1, n2, q)
548  call this%budobj%budterm(idx)%update_term(n1, n2, q)
549  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
550  end do
551  end if
552  end subroutine uzt_fill_budobj
553 
554  !> @brief Allocate scalar variables for package
555  !!
556  !! Method to allocate scalar variables for the package.
557  !<
558  subroutine allocate_scalars(this)
559  ! -- modules
561  ! -- dummy
562  class(gwtuzttype) :: this
563  ! -- local
564  !
565  ! -- allocate scalars in TspAptType
566  call this%TspAptType%allocate_scalars()
567  !
568  ! -- Allocate
569  call mem_allocate(this%idxbudinfl, 'IDXBUDINFL', this%memoryPath)
570  call mem_allocate(this%idxbudrinf, 'IDXBUDRINF', this%memoryPath)
571  call mem_allocate(this%idxbuduzet, 'IDXBUDUZET', this%memoryPath)
572  call mem_allocate(this%idxbudritm, 'IDXBUDRITM', this%memoryPath)
573  !
574  ! -- Initialize
575  this%idxbudinfl = 0
576  this%idxbudrinf = 0
577  this%idxbuduzet = 0
578  this%idxbudritm = 0
579  end subroutine allocate_scalars
580 
581  !> @brief Allocate arrays for package
582  !!
583  !! Method to allocate arrays for the package.
584  !<
585  subroutine uzt_allocate_arrays(this)
586  ! -- modules
588  ! -- dummy
589  class(gwtuzttype), intent(inout) :: this
590  !
591  ! -- alias into the input context's permanent, feature-indexed arrays
592  ! (allocated and DZERO-initialized by the input context)
593  call mem_setptr(this%concinfl, 'INFILTRATION', this%input_mempath)
594  call mem_setptr(this%concuzet, 'UZET', this%input_mempath)
595  !
596  ! -- call standard TspAptType allocate arrays
597  call this%TspAptType%apt_allocate_arrays()
598  !
599  end subroutine uzt_allocate_arrays
600 
601  !> @brief Alias deprecated UZT variable names to their current storage
602  !<
604  ! -- modules
606  ! -- dummy
607  class(gwtuzttype), intent(inout) :: this
608  ! -- code
609  !
610  ! -- names common to all advanced transport packages
611  call this%TspAptType%apt_checkin_deprecated_names()
612  !
613  call mem_alias_deprecated(this%concinfl, 'CONCINFL', this%memoryPath, &
614  'INFILTRATION', this%input_mempath, '6.8.2')
615  call mem_alias_deprecated(this%concuzet, 'CONCUZET', this%memoryPath, &
616  'UZET', this%input_mempath, '6.8.2')
617  end subroutine uzt_checkin_deprecated_names
618 
619  !> @brief Deallocate memory
620  !!
621  !! Method to deallocate memory for the package.
622  !<
623  subroutine uzt_da(this)
624  ! -- modules
626  ! -- dummy
627  class(gwtuzttype) :: this
628  ! -- local
629  !
630  ! -- deallocate scalars
631  call mem_deallocate(this%idxbudinfl)
632  call mem_deallocate(this%idxbudrinf)
633  call mem_deallocate(this%idxbuduzet)
634  call mem_deallocate(this%idxbudritm)
635  !
636  ! -- input-context-owned aliases, not package-allocated
637  nullify (this%concinfl)
638  nullify (this%concuzet)
639  !
640  ! -- deallocate scalars in TspAptType
641  call this%TspAptType%bnd_da()
642  end subroutine uzt_da
643 
644  !> @brief Infiltration term
645  !!
646  !! Accounts for mass added to the subsurface via infiltration. For example,
647  !! mass entering the model domain via rainfall or irrigation.
648  !<
649  subroutine uzt_infl_term(this, ientry, n1, n2, rrate, &
650  rhsval, hcofval)
651  ! -- dummy
652  class(gwtuzttype) :: this
653  integer(I4B), intent(in) :: ientry
654  integer(I4B), intent(inout) :: n1
655  integer(I4B), intent(inout) :: n2
656  real(DP), intent(inout), optional :: rrate
657  real(DP), intent(inout), optional :: rhsval
658  real(DP), intent(inout), optional :: hcofval
659  ! -- local
660  real(DP) :: qbnd
661  real(DP) :: ctmp
662  real(DP) :: h, r
663  !
664  n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
665  n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
666  ! -- note that qbnd is negative for negative infiltration
667  qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
668  if (qbnd < dzero) then
669  ctmp = this%xnewpak(n1)
670  h = qbnd
671  r = dzero
672  else
673  ctmp = this%concinfl(n1)
674  h = dzero
675  r = -qbnd * ctmp
676  end if
677  if (present(rrate)) rrate = qbnd * ctmp
678  if (present(rhsval)) rhsval = r
679  if (present(hcofval)) hcofval = h
680  end subroutine uzt_infl_term
681 
682  !> @brief Rejected infiltration term
683  !!
684  !! Accounts for mass that is added to the model from specifying an
685  !! infiltration rate and concentration, but is subsequently removed from
686  !! the model as that portion of the infiltration that is rejected (and
687  !! NOT transferred to another advanced package via the MVR/MVT packages).
688  !<
689  subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, &
690  rhsval, hcofval)
691  ! -- dummy
692  class(gwtuzttype) :: this
693  integer(I4B), intent(in) :: ientry
694  integer(I4B), intent(inout) :: n1
695  integer(I4B), intent(inout) :: n2
696  real(DP), intent(inout), optional :: rrate
697  real(DP), intent(inout), optional :: rhsval
698  real(DP), intent(inout), optional :: hcofval
699  ! -- local
700  real(DP) :: qbnd
701  real(DP) :: ctmp
702  !
703  n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
704  n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
705  qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
706  ctmp = this%concinfl(n1)
707  if (present(rrate)) rrate = ctmp * qbnd
708  if (present(rhsval)) rhsval = dzero
709  if (present(hcofval)) hcofval = qbnd
710  end subroutine uzt_rinf_term
711 
712  !> @brief Evapotranspiration from the unsaturated-zone term
713  !!
714  !! Accounts for mass removed as a result of evapotranspiration from the
715  !! unsaturated zone.
716  !<
717  subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, &
718  rhsval, hcofval)
719  ! -- dummy
720  class(gwtuzttype) :: this
721  integer(I4B), intent(in) :: ientry
722  integer(I4B), intent(inout) :: n1
723  integer(I4B), intent(inout) :: n2
724  real(DP), intent(inout), optional :: rrate
725  real(DP), intent(inout), optional :: rhsval
726  real(DP), intent(inout), optional :: hcofval
727  ! -- local
728  real(DP) :: qbnd
729  real(DP) :: ctmp
730  real(DP) :: omega
731  !
732  n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
733  n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
734  ! -- note that qbnd is negative for uzet
735  qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
736  ctmp = this%concuzet(n1)
737  if (this%xnewpak(n1) < ctmp) then
738  omega = done
739  else
740  omega = dzero
741  end if
742  if (present(rrate)) &
743  rrate = omega * qbnd * this%xnewpak(n1) + &
744  (done - omega) * qbnd * ctmp
745  if (present(rhsval)) rhsval = -(done - omega) * qbnd * ctmp
746  if (present(hcofval)) hcofval = omega * qbnd
747  end subroutine uzt_uzet_term
748 
749  !> @brief Rejected infiltration to MVR/MVT term
750  !!
751  !! Accounts for energy that is added to the model from specifying an
752  !! infiltration rate and temperature, but does not infiltrate into the
753  !! subsurface. This subroutine is called when the rejected infiltration
754  !! is transferred to another advanced package via the MVR/MVT packages.
755  !<
756  subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, &
757  rhsval, hcofval)
758  ! -- dummy
759  class(gwtuzttype) :: this
760  integer(I4B), intent(in) :: ientry
761  integer(I4B), intent(inout) :: n1
762  integer(I4B), intent(inout) :: n2
763  real(DP), intent(inout), optional :: rrate
764  real(DP), intent(inout), optional :: rhsval
765  real(DP), intent(inout), optional :: hcofval
766  ! -- local
767  real(DP) :: qbnd
768  real(DP) :: ctmp
769  !
770  n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
771  n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
772  qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
773  ctmp = this%concinfl(n1)
774  if (present(rrate)) rrate = ctmp * qbnd
775  if (present(rhsval)) rhsval = dzero
776  if (present(hcofval)) hcofval = qbnd
777  end subroutine uzt_ritm_term
778 
779  !> @brief Define UZT Observation
780  !!
781  !! This subroutine:
782  !! - Stores observation types supported by the parent APT package.
783  !! - Overrides BndType%bnd_df_obs
784  !<
785  subroutine uzt_df_obs(this)
786  ! -- modules
787  ! -- dummy
788  class(gwtuzttype) :: this
789  ! -- local
790  integer(I4B) :: indx
791  !
792  ! -- Store obs type and assign procedure pointer
793  ! for concentration observation type.
794  call this%obs%StoreObsType('concentration', .false., indx)
795  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
796  !
797  ! -- Store obs type and assign procedure pointer
798  ! for flow between uzt cells.
799  call this%obs%StoreObsType('flow-ja-face', .true., indx)
800  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
801  !
802  ! -- Store obs type and assign procedure pointer
803  ! for from-mvr observation type.
804  call this%obs%StoreObsType('from-mvr', .true., indx)
805  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
806  !
807  ! -- to-mvr not supported for uzt
808  !call this%obs%StoreObsType('to-mvr', .true., indx)
809  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
810  !
811  ! -- Store obs type and assign procedure pointer
812  ! for storage observation type.
813  call this%obs%StoreObsType('storage', .true., indx)
814  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
815  !
816  ! -- Store obs type and assign procedure pointer
817  ! for constant observation type.
818  call this%obs%StoreObsType('constant', .true., indx)
819  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
820  !
821  ! -- Store obs type and assign procedure pointer
822  ! for observation type: uzt
823  call this%obs%StoreObsType('uzt', .true., indx)
824  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
825  !
826  ! -- Store obs type and assign procedure pointer
827  ! for observation type.
828  call this%obs%StoreObsType('infiltration', .true., indx)
829  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
830  !
831  ! -- Store obs type and assign procedure pointer
832  ! for observation type.
833  call this%obs%StoreObsType('rej-inf', .true., indx)
834  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
835  !
836  ! -- Store obs type and assign procedure pointer
837  ! for observation type.
838  call this%obs%StoreObsType('uzet', .true., indx)
839  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
840  !
841  ! -- Store obs type and assign procedure pointer
842  ! for observation type.
843  call this%obs%StoreObsType('rej-inf-to-mvr', .true., indx)
844  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
845  end subroutine uzt_df_obs
846 
847  !> @brief Process package specific obs
848  !!
849  !! Method to process specific observations for this package.
850  !<
851  subroutine uzt_rp_obs(this, obsrv, found)
852  ! -- dummy
853  class(gwtuzttype), intent(inout) :: this !< package class
854  type(observetype), intent(inout) :: obsrv !< observation object
855  logical, intent(inout) :: found !< indicate whether observation was found
856  ! -- local
857  !
858  found = .true.
859  select case (obsrv%ObsTypeId)
860  case ('INFILTRATION')
861  call this%rp_obs_byfeature(obsrv)
862  case ('REJ-INF')
863  call this%rp_obs_byfeature(obsrv)
864  case ('UZET')
865  call this%rp_obs_byfeature(obsrv)
866  case ('REJ-INF-TO-MVR')
867  call this%rp_obs_byfeature(obsrv)
868  case default
869  found = .false.
870  end select
871  end subroutine uzt_rp_obs
872 
873  !> @brief Calculate observation value and pass it back to APT
874  !<
875  subroutine uzt_bd_obs(this, obstypeid, jj, v, found)
876  ! -- dummy
877  class(gwtuzttype), intent(inout) :: this
878  character(len=*), intent(in) :: obstypeid
879  real(DP), intent(inout) :: v
880  integer(I4B), intent(in) :: jj
881  logical, intent(inout) :: found
882  ! -- local
883  integer(I4B) :: n1, n2
884  !
885  found = .true.
886  select case (obstypeid)
887  case ('INFILTRATION')
888  if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0) then
889  call this%uzt_infl_term(jj, n1, n2, v)
890  end if
891  case ('REJ-INF')
892  if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0) then
893  call this%uzt_rinf_term(jj, n1, n2, v)
894  end if
895  case ('UZET')
896  if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0) then
897  call this%uzt_uzet_term(jj, n1, n2, v)
898  end if
899  case ('REJ-INF-TO-MVR')
900  if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0) then
901  call this%uzt_ritm_term(jj, n1, n2, v)
902  end if
903  case default
904  found = .false.
905  end select
906  end subroutine uzt_bd_obs
907 
908 end module gwtuztmodule
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration to MVR/MVT term.
Definition: gwt-uzt.f90:758
subroutine uzt_rp_obs(this, obsrv, found)
Process package specific obs.
Definition: gwt-uzt.f90:852
subroutine uzt_solve(this)
Explicit solve.
Definition: gwt-uzt.f90:346
integer(i4b) function uzt_get_nbudterms(this)
Function that returns the number of budget terms for this package.
Definition: gwt-uzt.f90:391
subroutine uzt_df_obs(this)
Define UZT Observation.
Definition: gwt-uzt.f90:786
subroutine uzt_da(this)
Deallocate memory.
Definition: gwt-uzt.f90:624
character(len= *), parameter flowtype
Definition: gwt-uzt.f90:46
real(dp) function, dimension(:), pointer, contiguous get_mvr_depvar(this)
Override similarly named function in APT.
Definition: gwt-uzt.f90:412
subroutine allocate_scalars(this)
Allocate scalar variables for package.
Definition: gwt-uzt.f90:559
subroutine uzt_allocate_arrays(this)
Allocate arrays for package.
Definition: gwt-uzt.f90:586
subroutine uzt_setup_budobj(this, idx)
Set up the budget object that stores all the unsaturated-zone flows.
Definition: gwt-uzt.f90:423
character(len=16) text
Definition: gwt-uzt.f90:47
subroutine uzt_infl_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Infiltration term.
Definition: gwt-uzt.f90:651
subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration term.
Definition: gwt-uzt.f90:691
subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to UZT.
Definition: gwt-uzt.f90:281
subroutine uzt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
Definition: gwt-uzt.f90:493
real(dp) function uzt_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
Definition: gwt-uzt.f90:260
subroutine uzt_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
Definition: gwt-uzt.f90:876
character(len= *), parameter ftype
Definition: gwt-uzt.f90:45
subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Evapotranspiration from the unsaturated-zone term.
Definition: gwt-uzt.f90:719
subroutine, public uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new UZT package.
Definition: gwt-uzt.f90:88
subroutine uzt_checkin_deprecated_names(this)
Alias deprecated UZT variable names to their current storage.
Definition: gwt-uzt.f90:604
subroutine find_uzt_package(this)
Find corresponding uzt package.
Definition: gwt-uzt.f90:144
This module defines variable data types.
Definition: kind.f90:8
Previous variable names checked in as deprecated aliases.
Definition: MemoryAlias.f90:7
This module contains the derived types ObserveType and ObsDataType.
Definition: Observe.f90:15
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:204
subroutine, public apt_process_obsid(obsrv, dis, inunitobs, iout)
Process observation IDs for an advanced package.
Definition: tsp-apt.f90:2729
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.
Definition: tsp-apt.f90:2772
@ brief BndType
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23