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