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