MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
gwt-mwt.f90
Go to the documentation of this file.
1 ! -- Multi-Aquifer Well Transport Module
2 ! -- todo: what to do about reactions in maw? Decay?
3 ! -- todo: save the mwt concentration into the mwt aux variable?
4 ! -- todo: calculate the maw DENSE aux variable using concentration?
5 !
6 ! MAW flows (flowbudptr) index var MWT term Transport Type
7 !---------------------------------------------------------------------------------
8 
9 ! -- terms from MAW that will be handled by parent APT Package
10 ! FLOW-JA-FACE idxbudfjf FLOW-JA-FACE cv2cv (note that this doesn't exist for MAW)
11 ! GWF (aux FLOW-AREA) idxbudgwf GWF cv2gwf
12 ! STORAGE (aux VOLUME) idxbudsto none used for cv volumes
13 ! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:)
14 ! TO-MVR idxbudtmvr TO-MVR q * cfeat
15 
16 ! -- MAW terms
17 ! RATE idxbudrate RATE q < 0: q * cwell, else q * cuser
18 ! FW-RATE idxbudfwrt FW-RATE q * cwell
19 ! RATE-TO-MVR idxbudrtmv RATE-TO-MVR q * cwell
20 ! FW-RATE-TO-MVR idxbudfrtm FW-RATE-TO-MVR q * cwell
21 
22 ! -- terms from MAW that should be skipped
23 ! CONSTANT-TO-MVR ? CONSTANT-TO-MVR q * cwell
24 
25 ! -- terms from a flow file that should be skipped
26 ! CONSTANT none none none
27 ! AUXILIARY none none none
28 
29 ! -- terms that are written to the transport budget file
30 ! none none STORAGE (aux MASS) dM/dt
31 ! none none AUXILIARY none
32 ! none none CONSTANT accumulate
33 !
34 !
36 
37  use kindmodule, only: dp, i4b
42  use bndmodule, only: bndtype, getbndfromlist
43  use tspfmimodule, only: tspfmitype
44  use mawmodule, only: mawtype
45  use observemodule, only: observetype
49 
50  implicit none
51 
52  public mwt_create
53 
54  character(len=*), parameter :: ftype = 'MWT'
55  character(len=*), parameter :: flowtype = 'MAW'
56  character(len=16) :: text = ' MWT'
57 
58  type, extends(tspapttype) :: gwtmwttype
59 
60  integer(I4B), pointer :: idxbudrate => null() ! index of well rate terms in flowbudptr
61  integer(I4B), pointer :: idxbudfwrt => null() ! index of flowing well rate terms in flowbudptr
62  integer(I4B), pointer :: idxbudrtmv => null() ! index of rate to mover terms in flowbudptr
63  integer(I4B), pointer :: idxbudfrtm => null() ! index of flowing well rate to mover terms in flowbudptr
64  real(dp), dimension(:), pointer, contiguous :: concrate => null() ! well rate concentration
65 
66  contains
67 
68  procedure :: bnd_da => mwt_da
69  procedure :: allocate_scalars
70  procedure :: apt_allocate_arrays => mwt_allocate_arrays
71  procedure :: find_apt_package => find_mwt_package
72  procedure :: apt_setting_value => mwt_setting_value
73  procedure :: pak_fc_expanded => mwt_fc_expanded
74  procedure :: pak_solve => mwt_solve
75  procedure :: pak_get_nbudterms => mwt_get_nbudterms
76  procedure :: pak_setup_budobj => mwt_setup_budobj
77  procedure :: pak_fill_budobj => mwt_fill_budobj
78  procedure :: mwt_rate_term
79  procedure :: mwt_fwrt_term
80  procedure :: mwt_rtmv_term
81  procedure :: mwt_frtm_term
82  procedure :: pak_df_obs => mwt_df_obs
83  procedure :: pak_rp_obs => mwt_rp_obs
84  procedure :: pak_bd_obs => mwt_bd_obs
85 
86  end type gwtmwttype
87 
88 contains
89 
90  !> Create new MWT package
91  !<
92  subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
93  mempath, fmi, eqnsclfac, dvt, dvu, dvua)
94  ! -- dummy
95  class(bndtype), pointer :: packobj
96  integer(I4B), intent(in) :: id
97  integer(I4B), intent(in) :: ibcnum
98  integer(I4B), intent(in) :: inunit
99  integer(I4B), intent(in) :: iout
100  character(len=*), intent(in) :: namemodel
101  character(len=*), intent(in) :: pakname
102  character(len=*), intent(in) :: mempath !< input memory path
103  type(tspfmitype), pointer :: fmi
104  real(dp), intent(in), pointer :: eqnsclfac !< governing equation scale factor
105  character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType
106  character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType
107  character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType
108  ! -- local
109  type(gwtmwttype), pointer :: mwtobj
110  !
111  ! -- allocate the object and assign values to object variables
112  allocate (mwtobj)
113  packobj => mwtobj
114  !
115  ! -- create name and memory path
116  call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
117  packobj%text = text
118  !
119  ! -- allocate scalars
120  call mwtobj%allocate_scalars()
121  !
122  ! -- initialize package
123  call packobj%pack_initialize()
124 
125  packobj%inunit = inunit
126  packobj%iout = iout
127  packobj%id = id
128  packobj%ibcnum = ibcnum
129  packobj%ncolbnd = 1
130  packobj%iscloc = 1
131  packobj%isadvpak = 1
132 
133  ! -- Store pointer to flow model interface. When the GwfGwt exchange is
134  ! created, it sets fmi%bndlist so that the GWT model has access to all
135  ! the flow packages
136  mwtobj%fmi => fmi
137  !
138  ! -- Store pointer to governing equation scale factor
139  mwtobj%eqnsclfac => eqnsclfac
140  !
141  ! -- Set labels that will be used in generalized APT class
142  mwtobj%depvartype = dvt
143  mwtobj%depvarunit = dvu
144  mwtobj%depvarunitabbrev = dvua
145  end subroutine mwt_create
146 
147  !> @brief find corresponding mwt package
148  !<
149  subroutine find_mwt_package(this)
150  ! -- modules
152  ! -- dummy
153  class(gwtmwttype) :: this
154  ! -- local
155  character(len=LINELENGTH) :: errmsg
156  class(bndtype), pointer :: packobj
157  integer(I4B) :: ip, icount
158  integer(I4B) :: nbudterm
159  logical :: found
160  !
161  ! -- Initialize found to false, and error later if flow package cannot
162  ! be found
163  found = .false.
164  !
165  ! -- If user is specifying flows in a binary budget file, then set up
166  ! the budget file reader, otherwise set a pointer to the flow package
167  ! budobj
168  if (this%fmi%flows_from_file) then
169  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
170  if (associated(this%flowbudptr)) found = .true.
171  !
172  else
173  if (associated(this%fmi%gwfbndlist)) then
174  ! -- Look through gwfbndlist for a flow package with the same name as
175  ! this transport package name
176  do ip = 1, this%fmi%gwfbndlist%Count()
177  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
178  if (packobj%packName == this%flowpackagename) then
179  found = .true.
180  !
181  ! -- store BndType pointer to packobj, and then
182  ! use the select type to point to the budobj in flow package
183  this%flowpackagebnd => packobj
184  select type (packobj)
185  type is (mawtype)
186  this%flowbudptr => packobj%budobj
187  end select
188  end if
189  if (found) exit
190  end do
191  end if
192  end if
193  !
194  ! -- error if flow package not found
195  if (.not. found) then
196  write (errmsg, '(a)') 'Could not find flow package with name '&
197  &//trim(adjustl(this%flowpackagename))//'.'
198  call store_error(errmsg)
199  call store_error_filename(this%input_fname)
200  end if
201  !
202  ! -- allocate space for idxbudssm, which indicates whether this is a
203  ! special budget term or one that is a general source and sink
204  nbudterm = this%flowbudptr%nbudterm
205  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
206  !
207  ! -- Process budget terms and identify special budget terms
208  write (this%iout, '(/, a, a)') &
209  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
210  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
211  write (this%iout, '(a, i0)') &
212  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
213  icount = 1
214  do ip = 1, this%flowbudptr%nbudterm
215  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
216  case ('FLOW-JA-FACE')
217  this%idxbudfjf = ip
218  this%idxbudssm(ip) = 0
219  case ('GWF')
220  this%idxbudgwf = ip
221  this%idxbudssm(ip) = 0
222  case ('STORAGE')
223  this%idxbudsto = ip
224  this%idxbudssm(ip) = 0
225  case ('RATE')
226  this%idxbudrate = ip
227  this%idxbudssm(ip) = 0
228  case ('FW-RATE')
229  this%idxbudfwrt = ip
230  this%idxbudssm(ip) = 0
231  case ('RATE-TO-MVR')
232  this%idxbudrtmv = ip
233  this%idxbudssm(ip) = 0
234  case ('FW-RATE-TO-MVR')
235  this%idxbudfrtm = ip
236  this%idxbudssm(ip) = 0
237  case ('TO-MVR')
238  this%idxbudtmvr = ip
239  this%idxbudssm(ip) = 0
240  case ('FROM-MVR')
241  this%idxbudfmvr = ip
242  this%idxbudssm(ip) = 0
243  case ('AUXILIARY')
244  this%idxbudaux = ip
245  this%idxbudssm(ip) = 0
246  case default
247  !
248  ! -- set idxbudssm equal to a column index for where the concentrations
249  ! are stored in the concbud(nbudssm, ncv) array
250  this%idxbudssm(ip) = icount
251  icount = icount + 1
252  end select
253  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
254  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
255  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
256  end do
257  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
258  end subroutine find_mwt_package
259 
260  !> @brief Value for a package-specific PERIOD setting
261  !!
262  !! Already resolved by the input context; this only supplies it for
263  !! the shared apt_rp table echo.
264  !<
265  function mwt_setting_value(this, itemno, key) result(val)
266  ! -- dummy
267  class(gwtmwttype), intent(inout) :: this
268  integer(I4B), intent(in) :: itemno
269  character(len=*), intent(in) :: key
270  real(dp) :: val
271  !
272  val = dzero
273  select case (trim(key))
274  case ('RATE')
275  val = this%concrate(itemno)
276  end select
277  end function mwt_setting_value
278 
279  !> @brief Add matrix terms related to MWT
280  !!
281  !! This routine is called from TspAptType%apt_fc_expanded() in
282  !! order to add matrix terms specifically for MWT
283  !<
284  subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
285  ! -- modules
286  ! -- dummy
287  class(gwtmwttype) :: this
288  real(DP), dimension(:), intent(inout) :: rhs
289  integer(I4B), dimension(:), intent(in) :: ia
290  integer(I4B), dimension(:), intent(in) :: idxglo
291  class(matrixbasetype), pointer :: matrix_sln
292  ! -- local
293  integer(I4B) :: j, n1, n2
294  integer(I4B) :: iloc
295  integer(I4B) :: iposd
296  real(DP) :: rrate
297  real(DP) :: rhsval
298  real(DP) :: hcofval
299  !
300  ! -- add puping rate contribution
301  if (this%idxbudrate /= 0) then
302  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
303  call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
304  iloc = this%idxlocnode(n1)
305  iposd = this%idxpakdiag(n1)
306  call matrix_sln%add_value_pos(iposd, hcofval)
307  rhs(iloc) = rhs(iloc) + rhsval
308  end do
309  end if
310  !
311  ! -- add flowing well rate contribution
312  if (this%idxbudfwrt /= 0) then
313  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
314  call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
315  iloc = this%idxlocnode(n1)
316  iposd = this%idxpakdiag(n1)
317  call matrix_sln%add_value_pos(iposd, hcofval)
318  rhs(iloc) = rhs(iloc) + rhsval
319  end do
320  end if
321  !
322  ! -- add rate to mover contribution
323  if (this%idxbudrtmv /= 0) then
324  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
325  call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
326  iloc = this%idxlocnode(n1)
327  iposd = this%idxpakdiag(n1)
328  call matrix_sln%add_value_pos(iposd, hcofval)
329  rhs(iloc) = rhs(iloc) + rhsval
330  end do
331  end if
332  !
333  ! -- add puping rate contribution
334  if (this%idxbudfrtm /= 0) then
335  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
336  call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
337  iloc = this%idxlocnode(n1)
338  iposd = this%idxpakdiag(n1)
339  call matrix_sln%add_value_pos(iposd, hcofval)
340  rhs(iloc) = rhs(iloc) + rhsval
341  end do
342  end if
343  end subroutine mwt_fc_expanded
344 
345  !> @ brief Add terms specific to multi-aquifer wells to the explicit multi-
346  !! aquifer well solute transport solve
347  !<
348  subroutine mwt_solve(this)
349  ! -- dummy
350  class(gwtmwttype) :: this
351  ! -- local
352  integer(I4B) :: j
353  integer(I4B) :: n1, n2
354  real(DP) :: rrate
355  !
356  ! -- add well pumping contribution
357  if (this%idxbudrate /= 0) then
358  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
359  call this%mwt_rate_term(j, n1, n2, rrate)
360  this%dbuff(n1) = this%dbuff(n1) + rrate
361  end do
362  end if
363  !
364  ! -- add flowing well rate contribution
365  if (this%idxbudfwrt /= 0) then
366  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
367  call this%mwt_fwrt_term(j, n1, n2, rrate)
368  this%dbuff(n1) = this%dbuff(n1) + rrate
369  end do
370  end if
371  !
372  ! -- add well pumping rate to mover contribution
373  if (this%idxbudrtmv /= 0) then
374  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
375  call this%mwt_rtmv_term(j, n1, n2, rrate)
376  this%dbuff(n1) = this%dbuff(n1) + rrate
377  end do
378  end if
379  !
380  ! -- add flowing well rate to mover contribution
381  if (this%idxbudfrtm /= 0) then
382  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
383  call this%mwt_frtm_term(j, n1, n2, rrate)
384  this%dbuff(n1) = this%dbuff(n1) + rrate
385  end do
386  end if
387  end subroutine mwt_solve
388 
389  !> @brief Function to return the number of budget terms just for this package
390  !!
391  !! This overrides a function in the parent class.
392  !<
393  function mwt_get_nbudterms(this) result(nbudterms)
394  ! -- modules
395  ! -- dummy
396  class(gwtmwttype) :: this
397  ! -- Return
398  integer(I4B) :: nbudterms
399  ! -- local
400  !
401  ! -- Number of budget terms is 4
402  nbudterms = 1
403  if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
404  if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
405  if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
406  end function mwt_get_nbudterms
407 
408  !> @brief Set up the budget object that stores all the mwt flows
409  !<
410  subroutine mwt_setup_budobj(this, idx)
411  ! -- modules
412  use constantsmodule, only: lenbudtxt
413  ! -- dummy
414  class(gwtmwttype) :: this
415  integer(I4B), intent(inout) :: idx
416  ! -- local
417  integer(I4B) :: maxlist, naux
418  character(len=LENBUDTXT) :: text
419  !
420  ! --
421  text = ' RATE'
422  idx = idx + 1
423  maxlist = this%flowbudptr%budterm(this%idxbudrate)%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  !
433  ! --
434  if (this%idxbudfwrt /= 0) then
435  text = ' FW-RATE'
436  idx = idx + 1
437  maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
438  naux = 0
439  call this%budobj%budterm(idx)%initialize(text, &
440  this%name_model, &
441  this%packName, &
442  this%name_model, &
443  this%packName, &
444  maxlist, .false., .false., &
445  naux)
446  end if
447  !
448  ! --
449  if (this%idxbudrtmv /= 0) then
450  text = ' RATE-TO-MVR'
451  idx = idx + 1
452  maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
453  naux = 0
454  call this%budobj%budterm(idx)%initialize(text, &
455  this%name_model, &
456  this%packName, &
457  this%name_model, &
458  this%packName, &
459  maxlist, .false., .false., &
460  naux)
461  end if
462  !
463  ! --
464  if (this%idxbudfrtm /= 0) then
465  text = ' FW-RATE-TO-MVR'
466  idx = idx + 1
467  maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
468  naux = 0
469  call this%budobj%budterm(idx)%initialize(text, &
470  this%name_model, &
471  this%packName, &
472  this%name_model, &
473  this%packName, &
474  maxlist, .false., .false., &
475  naux)
476  end if
477  end subroutine mwt_setup_budobj
478 
479  !> @brief Copy flow terms into this%budobj
480  !<
481  subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
482  ! -- modules
483  ! -- dummy
484  class(gwtmwttype) :: this
485  integer(I4B), intent(inout) :: idx
486  real(DP), dimension(:), intent(in) :: x
487  real(DP), dimension(:), contiguous, intent(inout) :: flowja
488  real(DP), intent(inout) :: ccratin
489  real(DP), intent(inout) :: ccratout
490  ! -- local
491  integer(I4B) :: j, n1, n2
492  integer(I4B) :: nlist
493  real(DP) :: q
494  ! -- formats
495  !
496  ! -- RATE
497  idx = idx + 1
498  nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
499  call this%budobj%budterm(idx)%reset(nlist)
500  do j = 1, nlist
501  call this%mwt_rate_term(j, n1, n2, q)
502  call this%budobj%budterm(idx)%update_term(n1, n2, q)
503  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
504  end do
505  !
506  ! -- FW-RATE
507  if (this%idxbudfwrt /= 0) then
508  idx = idx + 1
509  nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
510  call this%budobj%budterm(idx)%reset(nlist)
511  do j = 1, nlist
512  call this%mwt_fwrt_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  end if
517  !
518  ! -- RATE-TO-MVR
519  if (this%idxbudrtmv /= 0) then
520  idx = idx + 1
521  nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
522  call this%budobj%budterm(idx)%reset(nlist)
523  do j = 1, nlist
524  call this%mwt_rtmv_term(j, n1, n2, q)
525  call this%budobj%budterm(idx)%update_term(n1, n2, q)
526  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
527  end do
528  end if
529  !
530  ! -- FW-RATE-TO-MVR
531  if (this%idxbudfrtm /= 0) then
532  idx = idx + 1
533  nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
534  call this%budobj%budterm(idx)%reset(nlist)
535  do j = 1, nlist
536  call this%mwt_frtm_term(j, n1, n2, q)
537  call this%budobj%budterm(idx)%update_term(n1, n2, q)
538  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
539  end do
540  end if
541  end subroutine mwt_fill_budobj
542 
543  !> @brief Allocate scalars specific to the streamflow mass transport (SFT)
544  !! package.
545  !<
546  subroutine allocate_scalars(this)
547  ! -- modules
549  ! -- dummy
550  class(gwtmwttype) :: this
551  ! -- local
552  !
553  ! -- allocate scalars in TspAptType
554  call this%TspAptType%allocate_scalars()
555  !
556  ! -- Allocate
557  call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath)
558  call mem_allocate(this%idxbudfwrt, 'IDXBUDFWRT', this%memoryPath)
559  call mem_allocate(this%idxbudrtmv, 'IDXBUDRTMV', this%memoryPath)
560  call mem_allocate(this%idxbudfrtm, 'IDXBUDFRTM', this%memoryPath)
561  !
562  ! -- Initialize
563  this%idxbudrate = 0
564  this%idxbudfwrt = 0
565  this%idxbudrtmv = 0
566  this%idxbudfrtm = 0
567  end subroutine allocate_scalars
568 
569  !> @brief Allocate arrays specific to the streamflow mass transport (SFT)
570  !! package.
571  !<
572  subroutine mwt_allocate_arrays(this)
573  ! -- modules
575  ! -- dummy
576  class(gwtmwttype), intent(inout) :: this
577  !
578  ! -- alias into the input context's permanent, feature-indexed RATE
579  ! array (allocated and DZERO-initialized by the input context)
580  call mem_setptr(this%concrate, 'RATE', this%input_mempath)
581  !
582  ! -- call standard TspAptType allocate arrays
583  call this%TspAptType%apt_allocate_arrays()
584  !
585  end subroutine mwt_allocate_arrays
586 
587  !> @brief Deallocate memory
588  !<
589  subroutine mwt_da(this)
590  ! -- modules
592  ! -- dummy
593  class(gwtmwttype) :: this
594  ! -- local
595  !
596  ! -- deallocate scalars
597  call mem_deallocate(this%idxbudrate)
598  call mem_deallocate(this%idxbudfwrt)
599  call mem_deallocate(this%idxbudrtmv)
600  call mem_deallocate(this%idxbudfrtm)
601  !
602  ! -- input-context-owned alias, not package-allocated
603  nullify (this%concrate)
604  !
605  ! -- deallocate scalars in TspAptType
606  call this%TspAptType%bnd_da()
607  end subroutine mwt_da
608 
609  !> @brief Rate term associated with pumping (or injection)
610  !<
611  subroutine mwt_rate_term(this, ientry, n1, n2, rrate, &
612  rhsval, hcofval)
613  ! -- dummy
614  class(gwtmwttype) :: 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%idxbudrate)%id1(ientry)
627  n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
628  ! -- note that qbnd is negative for extracting well
629  qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
630  if (qbnd < dzero) then
631  ctmp = this%xnewpak(n1)
632  h = qbnd
633  r = dzero
634  else
635  ctmp = this%concrate(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 mwt_rate_term
643 
644  !> @brief Transport matrix term(s) associated with a flowing-
645  !! well rate term associated with pumping (or injection)
646  !<
647  subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, &
648  rhsval, hcofval)
649  ! -- dummy
650  class(gwtmwttype) :: this
651  integer(I4B), intent(in) :: ientry
652  integer(I4B), intent(inout) :: n1
653  integer(I4B), intent(inout) :: n2
654  real(DP), intent(inout), optional :: rrate
655  real(DP), intent(inout), optional :: rhsval
656  real(DP), intent(inout), optional :: hcofval
657  ! -- local
658  real(DP) :: qbnd
659  real(DP) :: ctmp
660  !
661  n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
662  n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
663  qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
664  ctmp = this%xnewpak(n1)
665  if (present(rrate)) rrate = ctmp * qbnd
666  if (present(rhsval)) rhsval = dzero
667  if (present(hcofval)) hcofval = qbnd
668  end subroutine mwt_fwrt_term
669 
670  !> @brief Rate-to-mvr term associated with pumping (or injection)
671  !!
672  !! Pumped water that is made available to the MVR package for transfer to
673  !! another advanced package
674  !<
675  subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, &
676  rhsval, hcofval)
677  ! -- dummy
678  class(gwtmwttype) :: this
679  integer(I4B), intent(in) :: ientry
680  integer(I4B), intent(inout) :: n1
681  integer(I4B), intent(inout) :: n2
682  real(DP), intent(inout), optional :: rrate
683  real(DP), intent(inout), optional :: rhsval
684  real(DP), intent(inout), optional :: hcofval
685  ! -- local
686  real(DP) :: qbnd
687  real(DP) :: ctmp
688  !
689  n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
690  n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
691  qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
692  ctmp = this%xnewpak(n1)
693  if (present(rrate)) rrate = ctmp * qbnd
694  if (present(rhsval)) rhsval = dzero
695  if (present(hcofval)) hcofval = qbnd
696  end subroutine mwt_rtmv_term
697 
698  !> @brief Flowing well rate-to-mvr term (or injection)
699  !!
700  !! Pumped water that is made available to the MVR package for transfer to
701  !! another advanced package
702  !<
703  subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, &
704  rhsval, hcofval)
705  ! -- dummy
706  class(gwtmwttype) :: this
707  integer(I4B), intent(in) :: ientry
708  integer(I4B), intent(inout) :: n1
709  integer(I4B), intent(inout) :: n2
710  real(DP), intent(inout), optional :: rrate
711  real(DP), intent(inout), optional :: rhsval
712  real(DP), intent(inout), optional :: hcofval
713  ! -- local
714  real(DP) :: qbnd
715  real(DP) :: ctmp
716  !
717  n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
718  n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
719  qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
720  ctmp = this%xnewpak(n1)
721  if (present(rrate)) rrate = ctmp * qbnd
722  if (present(rhsval)) rhsval = dzero
723  if (present(hcofval)) hcofval = qbnd
724  end subroutine mwt_frtm_term
725 
726  !> @brief Observations
727  !!
728  !! Store the observation type supported by the APT package and override
729  !! BndType%bnd_df_obs
730  !<
731  subroutine mwt_df_obs(this)
732  ! -- modules
733  ! -- dummy
734  class(gwtmwttype) :: this
735  ! -- local
736  integer(I4B) :: indx
737  !
738  ! -- Store obs type and assign procedure pointer
739  ! for concentration observation type.
740  call this%obs%StoreObsType('concentration', .false., indx)
741  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
742  !
743  ! -- flow-ja-face not supported for MWT
744  !call this%obs%StoreObsType('flow-ja-face', .true., indx)
745  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
746  !
747  ! -- Store obs type and assign procedure pointer
748  ! for from-mvr observation type.
749  call this%obs%StoreObsType('from-mvr', .true., indx)
750  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
751  !
752  ! -- to-mvr not supported for mwt
753  !call this%obs%StoreObsType('to-mvr', .true., indx)
754  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
755  !
756  ! -- Store obs type and assign procedure pointer
757  ! for storage observation type.
758  call this%obs%StoreObsType('storage', .true., indx)
759  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
760  !
761  ! -- Store obs type and assign procedure pointer
762  ! for constant observation type.
763  call this%obs%StoreObsType('constant', .true., indx)
764  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
765  !
766  ! -- Store obs type and assign procedure pointer
767  ! for observation type: mwt
768  call this%obs%StoreObsType('mwt', .true., indx)
769  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
770  !
771  ! -- Store obs type and assign procedure pointer
772  ! for rate observation type.
773  call this%obs%StoreObsType('rate', .true., indx)
774  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
775  !
776  ! -- Store obs type and assign procedure pointer
777  ! for observation type.
778  call this%obs%StoreObsType('fw-rate', .true., indx)
779  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
780  !
781  ! -- Store obs type and assign procedure pointer
782  ! for observation type.
783  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
784  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
785  !
786  ! -- Store obs type and assign procedure pointer
787  ! for observation type.
788  call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx)
789  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
790  end subroutine mwt_df_obs
791 
792  !> @brief Process package specific obs
793  !!
794  !! Method to process specific observations for this package.
795  !<
796  subroutine mwt_rp_obs(this, obsrv, found)
797  ! -- dummy
798  class(gwtmwttype), intent(inout) :: this !< package class
799  type(observetype), intent(inout) :: obsrv !< observation object
800  logical, intent(inout) :: found !< indicate whether observation was found
801  ! -- local
802  !
803  found = .true.
804  select case (obsrv%ObsTypeId)
805  case ('RATE')
806  call this%rp_obs_byfeature(obsrv)
807  case ('FW-RATE')
808  call this%rp_obs_byfeature(obsrv)
809  case ('RATE-TO-MVR')
810  call this%rp_obs_byfeature(obsrv)
811  case ('FW-RATE-TO-MVR')
812  call this%rp_obs_byfeature(obsrv)
813  case default
814  found = .false.
815  end select
816  end subroutine mwt_rp_obs
817 
818  !> @brief Calculate observation value and pass it back to APT
819  !<
820  subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
821  ! -- dummy
822  class(gwtmwttype), intent(inout) :: this
823  character(len=*), intent(in) :: obstypeid
824  real(DP), intent(inout) :: v
825  integer(I4B), intent(in) :: jj
826  logical, intent(inout) :: found
827  ! -- local
828  integer(I4B) :: n1, n2
829  !
830  found = .true.
831  select case (obstypeid)
832  case ('RATE')
833  if (this%iboundpak(jj) /= 0) then
834  call this%mwt_rate_term(jj, n1, n2, v)
835  end if
836  case ('FW-RATE')
837  if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0) then
838  call this%mwt_fwrt_term(jj, n1, n2, v)
839  end if
840  case ('RATE-TO-MVR')
841  if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0) then
842  call this%mwt_rtmv_term(jj, n1, n2, v)
843  end if
844  case ('FW-RATE-TO-MVR')
845  if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0) then
846  call this%mwt_frtm_term(jj, n1, n2, v)
847  end if
848  case default
849  found = .false.
850  end select
851  end subroutine mwt_bd_obs
852 
853 end module gwtmwtmodule
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
character(len= *), parameter flowtype
Definition: gwt-mwt.f90:55
subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
Definition: gwt-mwt.f90:821
subroutine find_mwt_package(this)
find corresponding mwt package
Definition: gwt-mwt.f90:150
subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to MWT.
Definition: gwt-mwt.f90:285
subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Transport matrix term(s) associated with a flowing- well rate term associated with pumping (or inject...
Definition: gwt-mwt.f90:649
character(len=16) text
Definition: gwt-mwt.f90:56
subroutine, public mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, dvt, dvu, dvua)
Create new MWT package.
Definition: gwt-mwt.f90:94
subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Flowing well rate-to-mvr term (or injection)
Definition: gwt-mwt.f90:705
subroutine mwt_setup_budobj(this, idx)
Set up the budget object that stores all the mwt flows.
Definition: gwt-mwt.f90:411
subroutine mwt_da(this)
Deallocate memory.
Definition: gwt-mwt.f90:590
character(len= *), parameter ftype
Definition: gwt-mwt.f90:54
subroutine mwt_rp_obs(this, obsrv, found)
Process package specific obs.
Definition: gwt-mwt.f90:797
subroutine allocate_scalars(this)
Allocate scalars specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:547
integer(i4b) function mwt_get_nbudterms(this)
Function to return the number of budget terms just for this package.
Definition: gwt-mwt.f90:394
subroutine mwt_solve(this)
@ brief Add terms specific to multi-aquifer wells to the explicit multi- aquifer well solute transpor...
Definition: gwt-mwt.f90:349
subroutine mwt_df_obs(this)
Observations.
Definition: gwt-mwt.f90:732
subroutine mwt_allocate_arrays(this)
Allocate arrays specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:573
real(dp) function mwt_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
Definition: gwt-mwt.f90:266
subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate-to-mvr term associated with pumping (or injection)
Definition: gwt-mwt.f90:677
subroutine mwt_rate_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate term associated with pumping (or injection)
Definition: gwt-mwt.f90:613
subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
Definition: gwt-mwt.f90:482
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 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:2690
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.
Definition: tsp-apt.f90:2733
@ 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