MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
gwemwemodule Module Reference

Data Types

type  gwemwetype
 

Functions/Subroutines

subroutine, public mwe_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
 Create new MWE package. More...
 
subroutine find_mwe_package (this)
 Find corresponding mwe package. More...
 
real(dp) function mwe_setting_value (this, itemno, key)
 Value for a package-specific PERIOD setting. More...
 
subroutine mwe_fc_expanded (this, rhs, ia, idxglo, matrix_sln)
 Add matrix terms related to MWE. More...
 
subroutine mwe_solve (this)
 Add terms specific to multi-aquifer wells to the explicit multi- aquifer well energy transport solve. More...
 
integer(i4b) function mwe_get_nbudterms (this)
 Function to return the number of budget terms just for this package. More...
 
subroutine mwe_setup_budobj (this, idx)
 Set up the budget object that stores all the mwe flows. More...
 
subroutine mwe_fill_budobj (this, idx, x, flowja, ccratin, ccratout)
 Copy flow terms into thisbudobj. More...
 
subroutine allocate_scalars (this)
 Allocate scalars specific to the multi-aquifer well energy transport (MWE) package. More...
 
subroutine mwe_allocate_arrays (this)
 Allocate arrays specific to the streamflow mass transport (SFT) package. More...
 
subroutine mwe_checkin_deprecated_names (this)
 Alias deprecated MWE variable names to their current storage. More...
 
subroutine mwe_da (this)
 Deallocate memory associated with MWE package. More...
 
subroutine mwe_rate_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Thermal transport matrix term(s) associated with a user-specified flow rate (mwe_rate_term) More...
 
subroutine mwe_fwrt_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Thermal transport matrix term(s) associated with a flowing- well rate term associated with pumping (or injection) More...
 
subroutine mwe_rtmv_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Thermal transport matrix term(s) associated with pumped-water- to-mover term (mwe_rtmv_term) More...
 
subroutine mwe_frtm_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
 Thermal transport matrix term(s) associated with the flowing- well-rate-to-mover term (mwe_frtm_term) More...
 
subroutine mwe_df_obs (this)
 Observations. More...
 
subroutine mwe_rp_obs (this, obsrv, found)
 Process package specific obs. More...
 
subroutine mwe_bd_obs (this, obstypeid, jj, v, found)
 Calculate observation value and pass it back to APT. More...
 
subroutine mwe_read_cvs (this)
 Read feature information for this advanced package. More...
 

Variables

character(len= *), parameter ftype = 'MWE'
 
character(len= *), parameter flowtype = 'MAW'
 
character(len=16) text = ' MWE'
 

Function/Subroutine Documentation

◆ allocate_scalars()

subroutine gwemwemodule::allocate_scalars ( class(gwemwetype)  this)

Definition at line 650 of file gwe-mwe.f90.

651  ! -- modules
653  ! -- dummy
654  class(GweMweType) :: this
655  !
656  ! -- Allocate scalars in TspAptType
657  call this%TspAptType%allocate_scalars()
658  !
659  ! -- Allocate
660  call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath)
661  call mem_allocate(this%idxbudfwrt, 'IDXBUDFWRT', this%memoryPath)
662  call mem_allocate(this%idxbudrtmv, 'IDXBUDRTMV', this%memoryPath)
663  call mem_allocate(this%idxbudfrtm, 'IDXBUDFRTM', this%memoryPath)
664  call mem_allocate(this%idxbudmwcd, 'IDXBUDMWCD', this%memoryPath)
665  !
666  ! -- Initialize
667  this%idxbudrate = 0
668  this%idxbudfwrt = 0
669  this%idxbudrtmv = 0
670  this%idxbudfrtm = 0
671  this%idxbudmwcd = 0

◆ find_mwe_package()

subroutine gwemwemodule::find_mwe_package ( class(gwemwetype)  this)

Definition at line 166 of file gwe-mwe.f90.

167  ! -- modules
169  ! -- dummy
170  class(GweMweType) :: this
171  ! -- local
172  character(len=LINELENGTH) :: errmsg
173  class(BndType), pointer :: packobj
174  integer(I4B) :: ip, icount
175  integer(I4B) :: nbudterm
176  logical :: found
177  !
178  ! -- Initialize found to false, and error later if flow package cannot
179  ! be found
180  found = .false.
181  !
182  ! -- If user is specifying flows in a binary budget file, then set up
183  ! the budget file reader, otherwise set a pointer to the flow package
184  ! budobj
185  if (this%fmi%flows_from_file) then
186  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
187  if (associated(this%flowbudptr)) found = .true.
188  !
189  else
190  if (associated(this%fmi%gwfbndlist)) then
191  ! -- Look through gwfbndlist for a flow package with the same name as
192  ! this transport package name
193  do ip = 1, this%fmi%gwfbndlist%Count()
194  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
195  if (packobj%packName == this%flowpackagename) then
196  found = .true.
197  !
198  ! -- Store BndType pointer to packobj, and then
199  ! use the select type to point to the budobj in flow package
200  this%flowpackagebnd => packobj
201  select type (packobj)
202  type is (mawtype)
203  this%flowbudptr => packobj%budobj
204  end select
205  end if
206  if (found) exit
207  end do
208  end if
209  end if
210  !
211  ! -- Error if flow package not found
212  if (.not. found) then
213  write (errmsg, '(a)') 'Could not find flow package with name '&
214  &//trim(adjustl(this%flowpackagename))//'.'
215  call store_error(errmsg)
216  call store_error_filename(this%input_fname)
217  end if
218  !
219  ! -- Allocate space for idxbudssm, which indicates whether this is a
220  ! special budget term or one that is a general source and sink
221  nbudterm = this%flowbudptr%nbudterm
222  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
223  !
224  ! -- Process budget terms and identify special budget terms
225  write (this%iout, '(/, a, a)') &
226  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
227  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
228  write (this%iout, '(a, i0)') &
229  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
230  icount = 1
231  do ip = 1, this%flowbudptr%nbudterm
232  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
233  case ('FLOW-JA-FACE')
234  this%idxbudfjf = ip
235  this%idxbudssm(ip) = 0
236  case ('GWF')
237  this%idxbudgwf = ip
238  this%idxbudssm(ip) = 0
239  case ('STORAGE')
240  this%idxbudsto = ip
241  this%idxbudssm(ip) = 0
242  case ('RATE')
243  this%idxbudrate = ip
244  this%idxbudssm(ip) = 0
245  case ('FW-RATE')
246  this%idxbudfwrt = ip
247  this%idxbudssm(ip) = 0
248  case ('RATE-TO-MVR')
249  this%idxbudrtmv = ip
250  this%idxbudssm(ip) = 0
251  case ('FW-RATE-TO-MVR')
252  this%idxbudfrtm = ip
253  this%idxbudssm(ip) = 0
254  case ('TO-MVR')
255  this%idxbudtmvr = ip
256  this%idxbudssm(ip) = 0
257  case ('FROM-MVR')
258  this%idxbudfmvr = ip
259  this%idxbudssm(ip) = 0
260  case ('AUXILIARY')
261  this%idxbudaux = ip
262  this%idxbudssm(ip) = 0
263  case default
264  !
265  ! -- Set idxbudssm equal to a column index for where the temperatures
266  ! are stored in the tempbud(nbudssm, ncv) array
267  this%idxbudssm(ip) = icount
268  icount = icount + 1
269  end select
270  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
271  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
272  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
273  end do
274  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
275  !
276  ! -- Streambed conduction term
277  this%idxbudmwcd = this%idxbudgwf
Here is the call graph for this function:

◆ mwe_allocate_arrays()

subroutine gwemwemodule::mwe_allocate_arrays ( class(gwemwetype), intent(inout)  this)

Definition at line 677 of file gwe-mwe.f90.

678  ! -- modules
680  ! -- dummy
681  class(GweMweType), intent(inout) :: this
682  !
683  ! -- alias into the input context's permanent, feature-indexed RATE
684  ! array (allocated and DZERO-initialized by the input context)
685  call mem_setptr(this%temprate, 'RATE', this%input_mempath)
686  !
687  ! -- Call standard TspAptType allocate arrays
688  call this%TspAptType%apt_allocate_arrays()
689  !

◆ mwe_bd_obs()

subroutine gwemwemodule::mwe_bd_obs ( class(gwemwetype), intent(inout)  this,
character(len=*), intent(in)  obstypeid,
integer(i4b), intent(in)  jj,
real(dp), intent(inout)  v,
logical, intent(inout)  found 
)

Definition at line 936 of file gwe-mwe.f90.

937  ! -- dummy
938  class(GweMweType), intent(inout) :: this
939  character(len=*), intent(in) :: obstypeid
940  real(DP), intent(inout) :: v
941  integer(I4B), intent(in) :: jj
942  logical, intent(inout) :: found
943  ! -- local
944  integer(I4B) :: n1, n2
945  !
946  found = .true.
947  select case (obstypeid)
948  case ('RATE')
949  if (this%iboundpak(jj) /= 0) then
950  call this%mwe_rate_term(jj, n1, n2, v)
951  end if
952  case ('FW-RATE')
953  if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0) then
954  call this%mwe_fwrt_term(jj, n1, n2, v)
955  end if
956  case ('RATE-TO-MVR')
957  if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0) then
958  call this%mwe_rtmv_term(jj, n1, n2, v)
959  end if
960  case ('FW-RATE-TO-MVR')
961  if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0) then
962  call this%mwe_frtm_term(jj, n1, n2, v)
963  end if
964  case default
965  found = .false.
966  end select

◆ mwe_checkin_deprecated_names()

subroutine gwemwemodule::mwe_checkin_deprecated_names ( class(gwemwetype), intent(inout)  this)

Definition at line 694 of file gwe-mwe.f90.

695  ! -- modules
697  ! -- dummy
698  class(GweMweType), intent(inout) :: this
699  ! -- code
700  !
701  ! -- names common to all advanced transport packages
702  call this%TspAptType%apt_checkin_deprecated_names()
703  !
704  call mem_alias_deprecated(this%temprate, 'TEMPRATE', this%memoryPath, &
705  'RATE', this%input_mempath, '6.8.2')
Previous variable names checked in as deprecated aliases.
Definition: MemoryAlias.f90:7

◆ mwe_create()

subroutine, public gwemwemodule::mwe_create ( class(bndtype), pointer  packobj,
integer(i4b), intent(in)  id,
integer(i4b), intent(in)  ibcnum,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  namemodel,
character(len=*), intent(in)  pakname,
character(len=*), intent(in)  mempath,
type(tspfmitype), pointer  fmi,
real(dp), intent(in), pointer  eqnsclfac,
type(gweinputdatatype), intent(in), target  gwecommon,
character(len=*), intent(in)  dvt,
character(len=*), intent(in)  dvu,
character(len=*), intent(in)  dvua 
)
Parameters
[in]mempathinput memory path
[in]eqnsclfacgoverning equation scale factor
[in]gwecommonshared data container for use by multiple GWE packages
[in]dvtFor GWE, set to "TEMPERATURE" in TspAptType
[in]dvuFor GWE, set to "energy" in TspAptType
[in]dvuaFor GWE, set to "E" in TspAptType

Definition at line 103 of file gwe-mwe.f90.

105  ! -- dummy
106  class(BndType), pointer :: packobj
107  integer(I4B), intent(in) :: id
108  integer(I4B), intent(in) :: ibcnum
109  integer(I4B), intent(in) :: inunit
110  integer(I4B), intent(in) :: iout
111  character(len=*), intent(in) :: namemodel
112  character(len=*), intent(in) :: pakname
113  character(len=*), intent(in) :: mempath !< input memory path
114  type(TspFmiType), pointer :: fmi
115  real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
116  type(GweInputDataType), intent(in), target :: gwecommon !< shared data container for use by multiple GWE packages
117  character(len=*), intent(in) :: dvt !< For GWE, set to "TEMPERATURE" in TspAptType
118  character(len=*), intent(in) :: dvu !< For GWE, set to "energy" in TspAptType
119  character(len=*), intent(in) :: dvua !< For GWE, set to "E" in TspAptType
120  ! -- local
121  type(GweMweType), pointer :: mweobj
122  !
123  ! -- Allocate the object and assign values to object variables
124  allocate (mweobj)
125  packobj => mweobj
126  !
127  ! -- Create name and memory path
128  call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
129  packobj%text = text
130  !
131  ! -- Allocate scalars
132  call mweobj%allocate_scalars()
133  !
134  ! -- Initialize package
135  call packobj%pack_initialize()
136  !
137  packobj%inunit = inunit
138  packobj%iout = iout
139  packobj%id = id
140  packobj%ibcnum = ibcnum
141  packobj%ncolbnd = 1
142  packobj%iscloc = 1
143  packobj%isadvpak = 1
144  !
145  ! -- Store pointer to flow model interface. When the GwfGwe exchange is
146  ! created, it sets fmi%bndlist so that the GWE model has access to all
147  ! the flow packages
148  mweobj%fmi => fmi
149  !
150  ! -- Store pointer to governing equation scale factor
151  mweobj%eqnsclfac => eqnsclfac
152  !
153  ! -- Store pointer to shared data module for accessing cpw, rhow
154  ! for the budget calculations, and for accessing the latent heat of
155  ! vaporization for evaporative cooling.
156  mweobj%gwecommon => gwecommon
157  !
158  ! -- Set labels that will be used in generalized APT class
159  mweobj%depvartype = dvt
160  mweobj%depvarunit = dvu
161  mweobj%depvarunitabbrev = dvua
Here is the caller graph for this function:

◆ mwe_da()

subroutine gwemwemodule::mwe_da ( class(gwemwetype)  this)

Definition at line 710 of file gwe-mwe.f90.

711  ! -- modules
713  ! -- dummy
714  class(GweMweType) :: this
715  !
716  ! -- Deallocate scalars
717  call mem_deallocate(this%idxbudrate)
718  call mem_deallocate(this%idxbudfwrt)
719  call mem_deallocate(this%idxbudrtmv)
720  call mem_deallocate(this%idxbudfrtm)
721  call mem_deallocate(this%idxbudmwcd)
722  !
723  ! -- input-context-owned alias, not package-allocated
724  nullify (this%temprate)
725  !
726  ! -- Deallocate arrays
727  call mem_deallocate(this%ktf)
728  call mem_deallocate(this%rfeatthk)
729  !
730  ! -- Deallocate scalars in TspAptType
731  call this%TspAptType%bnd_da()

◆ mwe_df_obs()

subroutine gwemwemodule::mwe_df_obs ( class(gwemwetype)  this)

Store the observation type supported by the APT package and override BndTypebnd_df_obs

Definition at line 849 of file gwe-mwe.f90.

850  ! -- dummy
851  class(GweMweType) :: this
852  ! -- local
853  integer(I4B) :: indx
854  !
855  ! -- Store obs type and assign procedure pointer
856  ! for temperature observation type.
857  call this%obs%StoreObsType('temperature', .false., indx)
858  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
859  !
860  ! -- Flow-ja-face not supported for MWE
861  !call this%obs%StoreObsType('flow-ja-face', .true., indx)
862  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
863  !
864  ! -- Store obs type and assign procedure pointer
865  ! for from-mvr observation type.
866  call this%obs%StoreObsType('from-mvr', .true., indx)
867  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
868  !
869  ! -- To-mvr not supported for mwe
870  !call this%obs%StoreObsType('to-mvr', .true., indx)
871  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
872  !
873  ! -- Store obs type and assign procedure pointer
874  ! for storage observation type.
875  call this%obs%StoreObsType('storage', .true., indx)
876  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
877  !
878  ! -- Store obs type and assign procedure pointer
879  ! for constant observation type.
880  call this%obs%StoreObsType('constant', .true., indx)
881  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
882  !
883  ! -- Store obs type and assign procedure pointer
884  ! for observation type: mwe
885  call this%obs%StoreObsType('mwe', .true., indx)
886  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
887  !
888  ! -- Store obs type and assign procedure pointer
889  ! for rate observation type.
890  call this%obs%StoreObsType('rate', .true., indx)
891  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
892  !
893  ! -- Store obs type and assign procedure pointer
894  ! for observation type.
895  call this%obs%StoreObsType('fw-rate', .true., indx)
896  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
897  !
898  ! -- Store obs type and assign procedure pointer
899  ! for observation type.
900  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
901  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
902  !
903  ! -- Store obs type and assign procedure pointer
904  ! for observation type.
905  call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx)
906  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
Here is the call graph for this function:

◆ mwe_fc_expanded()

subroutine gwemwemodule::mwe_fc_expanded ( class(gwemwetype)  this,
real(dp), dimension(:), intent(inout)  rhs,
integer(i4b), dimension(:), intent(in)  ia,
integer(i4b), dimension(:), intent(in)  idxglo,
class(matrixbasetype), pointer  matrix_sln 
)

This routine is called from TspAptTypeapt_fc_expanded() in order to add matrix terms specifically for MWE

Definition at line 304 of file gwe-mwe.f90.

305  ! -- dummy
306  class(GweMweType) :: this
307  real(DP), dimension(:), intent(inout) :: rhs
308  integer(I4B), dimension(:), intent(in) :: ia
309  integer(I4B), dimension(:), intent(in) :: idxglo
310  class(MatrixBaseType), pointer :: matrix_sln
311  ! -- local
312  integer(I4B) :: j, n, n1, n2
313  integer(I4B) :: iloc
314  integer(I4B) :: iposd, iposoffd
315  integer(I4B) :: ipossymd, ipossymoffd
316  integer(I4B) :: auxpos
317  real(DP) :: rrate
318  real(DP) :: rhsval
319  real(DP) :: hcofval
320  real(DP) :: ctherm ! kluge?
321  real(DP) :: wa !< wetted area
322  real(DP) :: ktf !< thermal conductivity of streambed material
323  real(DP) :: s !< thickness of conductive wellbore material
324  !
325  ! -- Add puping rate contribution
326  if (this%idxbudrate /= 0) then
327  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
328  call this%mwe_rate_term(j, n1, n2, rrate, rhsval, hcofval)
329  iloc = this%idxlocnode(n1)
330  iposd = this%idxpakdiag(n1)
331  call matrix_sln%add_value_pos(iposd, hcofval)
332  rhs(iloc) = rhs(iloc) + rhsval
333  end do
334  end if
335  !
336  ! -- Add flowing well rate contribution
337  if (this%idxbudfwrt /= 0) then
338  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
339  call this%mwe_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
340  iloc = this%idxlocnode(n1)
341  iposd = this%idxpakdiag(n1)
342  call matrix_sln%add_value_pos(iposd, hcofval)
343  rhs(iloc) = rhs(iloc) + rhsval
344  end do
345  end if
346  !
347  ! -- Add rate to mover contribution
348  if (this%idxbudrtmv /= 0) then
349  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
350  call this%mwe_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
351  iloc = this%idxlocnode(n1)
352  iposd = this%idxpakdiag(n1)
353  call matrix_sln%add_value_pos(iposd, hcofval)
354  rhs(iloc) = rhs(iloc) + rhsval
355  end do
356  end if
357  !
358  ! -- Add puping rate contribution
359  if (this%idxbudfrtm /= 0) then
360  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
361  call this%mwe_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
362  iloc = this%idxlocnode(n1)
363  iposd = this%idxpakdiag(n1)
364  call matrix_sln%add_value_pos(iposd, hcofval)
365  rhs(iloc) = rhs(iloc) + rhsval
366  end do
367  end if
368  !
369  ! -- Add wellbore conduction contribution
370  do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
371  !
372  ! -- Set n to feature number and process if active features
373  n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
374  if (this%iboundpak(n) /= 0) then
375  !
376  ! -- Set acoef and rhs to negative so they are relative to mwe and not gwe
377  auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
378  wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
379  ktf = this%ktf(n)
380  s = this%rfeatthk(n)
381  ctherm = ktf * wa / s
382  !
383  ! -- Add to mwe row
384  iposd = this%idxdglo(j)
385  iposoffd = this%idxoffdglo(j)
386  call matrix_sln%add_value_pos(iposd, -ctherm) ! kluge note: make sure the signs on ctherm are correct here and below
387  call matrix_sln%add_value_pos(iposoffd, ctherm)
388  !
389  ! -- Add to gwe row for mwe connection
390  ipossymd = this%idxsymdglo(j)
391  ipossymoffd = this%idxsymoffdglo(j)
392  call matrix_sln%add_value_pos(ipossymd, -ctherm)
393  call matrix_sln%add_value_pos(ipossymoffd, ctherm)
394  end if
395  end do

◆ mwe_fill_budobj()

subroutine gwemwemodule::mwe_fill_budobj ( class(gwemwetype)  this,
integer(i4b), intent(inout)  idx,
real(dp), dimension(:), intent(in)  x,
real(dp), dimension(:), intent(inout), contiguous  flowja,
real(dp), intent(inout)  ccratin,
real(dp), intent(inout)  ccratout 
)

Definition at line 555 of file gwe-mwe.f90.

556  ! -- dummy
557  class(GweMweType) :: this
558  integer(I4B), intent(inout) :: idx
559  real(DP), dimension(:), intent(in) :: x
560  real(DP), dimension(:), contiguous, intent(inout) :: flowja
561  real(DP), intent(inout) :: ccratin
562  real(DP), intent(inout) :: ccratout
563  ! -- local
564  integer(I4B) :: j, n1, n2
565  integer(I4B) :: nlist
566  integer(I4B) :: igwfnode
567  integer(I4B) :: idiag
568  integer(I4B) :: auxpos
569  real(DP) :: q
570  real(DP) :: ctherm
571  real(DP) :: wa !< wetted area
572  real(DP) :: ktf !< thermal conductivity of streambed material
573  real(DP) :: s !< thickness of conductive streambed materia
574  !
575  ! -- Rate
576  idx = idx + 1
577  nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
578  call this%budobj%budterm(idx)%reset(nlist)
579  do j = 1, nlist
580  call this%mwe_rate_term(j, n1, n2, q)
581  call this%budobj%budterm(idx)%update_term(n1, n2, q)
582  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
583  end do
584  !
585  ! -- FW-Rate
586  if (this%idxbudfwrt /= 0) then
587  idx = idx + 1
588  nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
589  call this%budobj%budterm(idx)%reset(nlist)
590  do j = 1, nlist
591  call this%mwe_fwrt_term(j, n1, n2, q)
592  call this%budobj%budterm(idx)%update_term(n1, n2, q)
593  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
594  end do
595  end if
596  !
597  ! -- Rate-To-MVR
598  if (this%idxbudrtmv /= 0) then
599  idx = idx + 1
600  nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
601  call this%budobj%budterm(idx)%reset(nlist)
602  do j = 1, nlist
603  call this%mwe_rtmv_term(j, n1, n2, q)
604  call this%budobj%budterm(idx)%update_term(n1, n2, q)
605  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
606  end do
607  end if
608  !
609  ! -- FW-Rate-To-MVR
610  if (this%idxbudfrtm /= 0) then
611  idx = idx + 1
612  nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
613  call this%budobj%budterm(idx)%reset(nlist)
614  do j = 1, nlist
615  call this%mwe_frtm_term(j, n1, n2, q)
616  call this%budobj%budterm(idx)%update_term(n1, n2, q)
617  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
618  end do
619  end if
620  !
621  ! -- Wellbore-Cond
622  idx = idx + 1
623  call this%budobj%budterm(idx)%reset(this%maxbound)
624  do j = 1, this%flowbudptr%budterm(this%idxbudmwcd)%nlist
625  q = dzero
626  n1 = this%flowbudptr%budterm(this%idxbudmwcd)%id1(j)
627  igwfnode = this%flowbudptr%budterm(this%idxbudmwcd)%id2(j)
628  if (this%iboundpak(n1) /= 0) then
629  auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
630  wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
631  ktf = this%ktf(n1)
632  s = this%rfeatthk(n1)
633  ctherm = ktf * wa / s
634  q = ctherm * (x(igwfnode) - this%xnewpak(n1))
635  end if
636  call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
637  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
638  if (this%iboundpak(n1) /= 0) then
639  ! -- Contribution to gwe cell budget
640  this%simvals(j) = this%simvals(j) - q
641  idiag = this%dis%con%ia(igwfnode)
642  flowja(idiag) = flowja(idiag) - q
643  end if
644  end do

◆ mwe_frtm_term()

subroutine gwemwemodule::mwe_frtm_term ( class(gwemwetype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 822 of file gwe-mwe.f90.

823  ! -- dummy
824  class(GweMweType) :: this
825  integer(I4B), intent(in) :: ientry
826  integer(I4B), intent(inout) :: n1
827  integer(I4B), intent(inout) :: n2
828  real(DP), intent(inout), optional :: rrate
829  real(DP), intent(inout), optional :: rhsval
830  real(DP), intent(inout), optional :: hcofval
831  ! -- local
832  real(DP) :: qbnd
833  real(DP) :: ctmp
834  !
835  n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
836  n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
837  qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
838  ctmp = this%xnewpak(n1)
839  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
840  if (present(rhsval)) rhsval = dzero
841  if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

◆ mwe_fwrt_term()

subroutine gwemwemodule::mwe_fwrt_term ( class(gwemwetype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 772 of file gwe-mwe.f90.

773  ! -- dummy
774  class(GweMweType) :: this
775  integer(I4B), intent(in) :: ientry
776  integer(I4B), intent(inout) :: n1
777  integer(I4B), intent(inout) :: n2
778  real(DP), intent(inout), optional :: rrate
779  real(DP), intent(inout), optional :: rhsval
780  real(DP), intent(inout), optional :: hcofval
781  ! -- local
782  real(DP) :: qbnd
783  real(DP) :: ctmp
784  !
785  n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
786  n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
787  qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
788  ctmp = this%xnewpak(n1)
789  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
790  if (present(rhsval)) rhsval = dzero
791  if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

◆ mwe_get_nbudterms()

integer(i4b) function gwemwemodule::mwe_get_nbudterms ( class(gwemwetype)  this)

This overrides a function in the parent class.

Definition at line 446 of file gwe-mwe.f90.

447  ! -- dummy
448  class(GweMweType) :: this
449  ! -- return
450  integer(I4B) :: nbudterms
451  !
452  ! -- Number of potential budget terms is 5
453  nbudterms = 1 ! RATE
454  if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
455  if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
456  if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
457  if (this%idxbudmwcd /= 0) nbudterms = nbudterms + 1

◆ mwe_rate_term()

subroutine gwemwemodule::mwe_rate_term ( class(gwemwetype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 737 of file gwe-mwe.f90.

738  ! -- dummy
739  class(GweMweType) :: this
740  integer(I4B), intent(in) :: ientry
741  integer(I4B), intent(inout) :: n1
742  integer(I4B), intent(inout) :: n2
743  real(DP), intent(inout), optional :: rrate
744  real(DP), intent(inout), optional :: rhsval
745  real(DP), intent(inout), optional :: hcofval
746  ! -- local
747  real(DP) :: qbnd
748  real(DP) :: ctmp
749  real(DP) :: h, r
750  !
751  n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
752  n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
753  ! -- Note that qbnd is negative for an extracting well
754  qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
755  if (qbnd < dzero) then
756  ctmp = this%xnewpak(n1)
757  h = qbnd
758  r = dzero
759  else
760  ctmp = this%temprate(n1)
761  h = dzero
762  r = -qbnd * ctmp
763  end if
764  if (present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
765  if (present(rhsval)) rhsval = r * this%eqnsclfac
766  if (present(hcofval)) hcofval = h * this%eqnsclfac

◆ mwe_read_cvs()

subroutine gwemwemodule::mwe_read_cvs ( class(gwemwetype), intent(inout)  this)

Definition at line 971 of file gwe-mwe.f90.

974  class(GweMweType), intent(inout) :: this
975  integer(I4B) :: n, ifeat
976  real(DP), dimension(:), pointer, contiguous :: ktf_ptr => null()
977  real(DP), dimension(:), pointer, contiguous :: fthk_ptr => null()
978  call this%TspAptType%apt_source_cvs()
979  call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath)
980  call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath)
981  call mem_setptr(ktf_ptr, 'KTF', this%input_mempath)
982  call mem_setptr(fthk_ptr, 'FTHK', this%input_mempath)
983  do n = 1, size(this%pkg_ifno)
984  ifeat = this%pkg_ifno(n)
985  if (ifeat < 1 .or. ifeat > this%ncv) cycle
986  this%ktf(ifeat) = ktf_ptr(n)
987  this%rfeatthk(ifeat) = fthk_ptr(n)
988  if (this%rfeatthk(ifeat) <= dzero) then
989  write (errmsg, '(4x,a)') &
990  '****ERROR. Specified thickness used for thermal '// &
991  'conduction MUST BE > 0 else divide by zero error occurs'
992  call store_error(errmsg)
993  end if
994  end do
995  if (count_errors() > 0) then
996  call store_error_filename(this%input_fname)
997  end if
998  call memorystore_release('KTF', this%input_mempath)
999  call memorystore_release('FTHK', this%input_mempath)
subroutine, public memorystore_release(varname, memory_path)
Release a single variable from the memory store.
Here is the call graph for this function:

◆ mwe_rp_obs()

subroutine gwemwemodule::mwe_rp_obs ( class(gwemwetype), intent(inout)  this,
type(observetype), intent(inout)  obsrv,
logical, intent(inout)  found 
)

Method to process specific observations for this package.

Parameters
[in,out]thispackage class
[in,out]obsrvobservation object
[in,out]foundindicate whether observation was found

Definition at line 913 of file gwe-mwe.f90.

914  ! -- dummy
915  class(GweMweType), intent(inout) :: this !< package class
916  type(ObserveType), intent(inout) :: obsrv !< observation object
917  logical, intent(inout) :: found !< indicate whether observation was found
918  !
919  found = .true.
920  select case (obsrv%ObsTypeId)
921  case ('RATE')
922  call this%rp_obs_byfeature(obsrv)
923  case ('FW-RATE')
924  call this%rp_obs_byfeature(obsrv)
925  case ('RATE-TO-MVR')
926  call this%rp_obs_byfeature(obsrv)
927  case ('FW-RATE-TO-MVR')
928  call this%rp_obs_byfeature(obsrv)
929  case default
930  found = .false.
931  end select

◆ mwe_rtmv_term()

subroutine gwemwemodule::mwe_rtmv_term ( class(gwemwetype)  this,
integer(i4b), intent(in)  ientry,
integer(i4b), intent(inout)  n1,
integer(i4b), intent(inout)  n2,
real(dp), intent(inout), optional  rrate,
real(dp), intent(inout), optional  rhsval,
real(dp), intent(inout), optional  hcofval 
)

Definition at line 797 of file gwe-mwe.f90.

798  ! -- dummy
799  class(GweMweType) :: this
800  integer(I4B), intent(in) :: ientry
801  integer(I4B), intent(inout) :: n1
802  integer(I4B), intent(inout) :: n2
803  real(DP), intent(inout), optional :: rrate
804  real(DP), intent(inout), optional :: rhsval
805  real(DP), intent(inout), optional :: hcofval
806  ! -- local
807  real(DP) :: qbnd
808  real(DP) :: ctmp
809  !
810  n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
811  n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
812  qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
813  ctmp = this%xnewpak(n1)
814  if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
815  if (present(rhsval)) rhsval = dzero
816  if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

◆ mwe_setting_value()

real(dp) function gwemwemodule::mwe_setting_value ( class(gwemwetype), intent(inout)  this,
integer(i4b), intent(in)  itemno,
character(len=*), intent(in)  key 
)

Already resolved by the input context; this only supplies it for the shared apt_rp table echo.

Definition at line 285 of file gwe-mwe.f90.

286  ! -- dummy
287  class(GweMweType), intent(inout) :: this
288  integer(I4B), intent(in) :: itemno
289  character(len=*), intent(in) :: key
290  real(DP) :: val
291  !
292  val = dzero
293  select case (trim(key))
294  case ('RATE')
295  val = this%temprate(itemno)
296  end select

◆ mwe_setup_budobj()

subroutine gwemwemodule::mwe_setup_budobj ( class(gwemwetype)  this,
integer(i4b), intent(inout)  idx 
)

Definition at line 462 of file gwe-mwe.f90.

463  ! -- modules
464  use constantsmodule, only: lenbudtxt
465  ! -- dummy
466  class(GweMweType) :: this
467  integer(I4B), intent(inout) :: idx
468  ! -- local
469  integer(I4B) :: n, n1, n2
470  integer(I4B) :: maxlist, naux
471  real(DP) :: q
472  character(len=LENBUDTXT) :: text
473  !
474  ! -- User-specified rate
475  text = ' RATE'
476  idx = idx + 1
477  maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
478  naux = 0
479  call this%budobj%budterm(idx)%initialize(text, &
480  this%name_model, &
481  this%packName, &
482  this%name_model, &
483  this%packName, &
484  maxlist, .false., .false., &
485  naux)
486  !
487  ! -- Flowing well rate
488  if (this%idxbudfwrt /= 0) then
489  text = ' FW-RATE'
490  idx = idx + 1
491  maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
492  naux = 0
493  call this%budobj%budterm(idx)%initialize(text, &
494  this%name_model, &
495  this%packName, &
496  this%name_model, &
497  this%packName, &
498  maxlist, .false., .false., &
499  naux)
500  end if
501  !
502  ! -- User-specified flow rate to mover
503  if (this%idxbudrtmv /= 0) then
504  text = ' RATE-TO-MVR'
505  idx = idx + 1
506  maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
507  naux = 0
508  call this%budobj%budterm(idx)%initialize(text, &
509  this%name_model, &
510  this%packName, &
511  this%name_model, &
512  this%packName, &
513  maxlist, .false., .false., &
514  naux)
515  end if
516  !
517  ! -- Fflowing well rate to mover
518  if (this%idxbudfrtm /= 0) then
519  text = ' FW-RATE-TO-MVR'
520  idx = idx + 1
521  maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
522  naux = 0
523  call this%budobj%budterm(idx)%initialize(text, &
524  this%name_model, &
525  this%packName, &
526  this%name_model, &
527  this%packName, &
528  maxlist, .false., .false., &
529  naux)
530  end if
531  !
532  ! -- Conduction through wellbore (and/or filter pack)
533  text = ' WELLBORE-COND'
534  idx = idx + 1
535  maxlist = this%flowbudptr%budterm(this%idxbudmwcd)%maxlist
536  naux = 0
537  call this%budobj%budterm(idx)%initialize(text, &
538  this%name_model, &
539  this%packName, &
540  this%name_model, &
541  this%packName, &
542  maxlist, .false., .false., &
543  naux)
544  call this%budobj%budterm(idx)%reset(maxlist)
545  q = dzero
546  do n = 1, maxlist
547  n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
548  n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
549  call this%budobj%budterm(idx)%update_term(n1, n2, q)
550  end do
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37

◆ mwe_solve()

subroutine gwemwemodule::mwe_solve ( class(gwemwetype)  this)

Definition at line 401 of file gwe-mwe.f90.

402  ! -- dummy
403  class(GweMweType) :: this
404  ! -- local
405  integer(I4B) :: j
406  integer(I4B) :: n1, n2
407  real(DP) :: rrate
408  !
409  ! -- Add well pumping contribution
410  if (this%idxbudrate /= 0) then
411  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
412  call this%mwe_rate_term(j, n1, n2, rrate)
413  this%dbuff(n1) = this%dbuff(n1) + rrate
414  end do
415  end if
416  !
417  ! -- Add flowing well rate contribution
418  if (this%idxbudfwrt /= 0) then
419  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
420  call this%mwe_fwrt_term(j, n1, n2, rrate)
421  this%dbuff(n1) = this%dbuff(n1) + rrate
422  end do
423  end if
424  !
425  ! -- Add well pumping rate to mover contribution
426  if (this%idxbudrtmv /= 0) then
427  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
428  call this%mwe_rtmv_term(j, n1, n2, rrate)
429  this%dbuff(n1) = this%dbuff(n1) + rrate
430  end do
431  end if
432  !
433  ! -- Add flowing well rate to mover contribution
434  if (this%idxbudfrtm /= 0) then
435  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
436  call this%mwe_frtm_term(j, n1, n2, rrate)
437  this%dbuff(n1) = this%dbuff(n1) + rrate
438  end do
439  end if

Variable Documentation

◆ flowtype

character(len=*), parameter gwemwemodule::flowtype = 'MAW'

Definition at line 59 of file gwe-mwe.f90.

59  character(len=*), parameter :: flowtype = 'MAW'

◆ ftype

character(len=*), parameter gwemwemodule::ftype = 'MWE'

Definition at line 58 of file gwe-mwe.f90.

58  character(len=*), parameter :: ftype = 'MWE'

◆ text

character(len=16) gwemwemodule::text = ' MWE'

Definition at line 60 of file gwe-mwe.f90.

60  character(len=16) :: text = ' MWE'