MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
gwfgweexchangemodule Module Reference

Data Types

type  gwfgweexchangetype
 

Functions/Subroutines

subroutine, public gwfgwe_cr (filename, id, m1_id, m2_id)
 Create a new GWF to GWE exchange object. More...
 
subroutine set_model_pointers (this)
 Allocate and read. More...
 
subroutine exg_df (this)
 Define the GwfGwe Exchange object. More...
 
subroutine exg_ar (this)
 Allocate and read. More...
 
subroutine gwfconn2gweconn (this, gwfModel, gweModel)
 Link GWE connections to GWF connections or exchanges. More...
 
subroutine link_connections (this, gweConn, gwfConn)
 Links a GWE connection to its GWF counterpart. More...
 
subroutine exg_da (this)
 Deallocate memory. More...
 
subroutine allocate_scalars (this)
 Allocate GwfGwe exchange scalars. More...
 
subroutine gwfbnd2gwefmi (this)
 Call routines in FMI that will set pointers to the necessary flow data (SIMVALS and SIMTOMVR) stored within each GWF flow package. More...
 

Function/Subroutine Documentation

◆ allocate_scalars()

subroutine gwfgweexchangemodule::allocate_scalars ( class(gwfgweexchangetype this)

Definition at line 493 of file exg-gwfgwe.f90.

494  ! -- modules
496  ! -- dummy
497  class(GwfGweExchangeType) :: this
498  !
499  call mem_allocate(this%m1_idx, 'M1ID', this%memoryPath)
500  call mem_allocate(this%m2_idx, 'M2ID', this%memoryPath)
501  this%m1_idx = 0
502  this%m2_idx = 0

◆ exg_ar()

subroutine gwfgweexchangemodule::exg_ar ( class(gwfgweexchangetype this)

Definition at line 181 of file exg-gwfgwe.f90.

182  ! -- modules
184  use dismodule, only: distype
185  use disvmodule, only: disvtype
186  use disumodule, only: disutype
187  ! -- dummy
188  class(GwfGweExchangeType) :: this
189  ! -- local
190  class(BaseModelType), pointer :: mb => null()
191  type(GwfModelType), pointer :: gwfmodel => null()
192  type(GweModelType), pointer :: gwemodel => null()
193  ! -- formats
194  character(len=*), parameter :: fmtdiserr = &
195  "('GWF and GWE Models do not have the same discretization for exchange&
196  & ',a,'.&
197  & GWF Model has ', i0, ' user nodes and ', i0, ' reduced nodes.&
198  & GWE Model has ', i0, ' user nodes and ', i0, ' reduced nodes.&
199  & Ensure discretization packages, including IDOMAIN, are identical.')"
200  character(len=*), parameter :: fmtidomerr = &
201  "('GWF and GWE Models do not have the same discretization for exchange&
202  & ',a,'.&
203  & GWF Model and GWE Model have different IDOMAIN arrays.&
204  & Ensure discretization packages, including IDOMAIN, are identical.')"
205  !
206  ! -- set gwfmodel
207  mb => getbasemodelfromlist(basemodellist, this%m1_idx)
208  select type (mb)
209  type is (gwfmodeltype)
210  gwfmodel => mb
211  end select
212  !
213  ! -- set gwemodel
214  mb => getbasemodelfromlist(basemodellist, this%m2_idx)
215  select type (mb)
216  type is (gwemodeltype)
217  gwemodel => mb
218  end select
219  !
220  ! -- Check to make sure sizes are identical
221  if (gwemodel%dis%nodes /= gwfmodel%dis%nodes .or. &
222  gwemodel%dis%nodesuser /= gwfmodel%dis%nodesuser) then
223  write (errmsg, fmtdiserr) trim(this%name), &
224  gwfmodel%dis%nodesuser, &
225  gwfmodel%dis%nodes, &
226  gwemodel%dis%nodesuser, &
227  gwemodel%dis%nodes
228  call store_error(errmsg, terminate=.true.)
229  end if
230  !
231  ! -- Make sure idomains are identical
232  select type (gwfdis => gwfmodel%dis)
233  type is (distype)
234  select type (gwedis => gwemodel%dis)
235  type is (distype)
236  if (.not. all(gwfdis%idomain == gwedis%idomain)) then
237  write (errmsg, fmtidomerr) trim(this%name)
238  call store_error(errmsg, terminate=.true.)
239  end if
240  end select
241  type is (disvtype)
242  select type (gwedis => gwemodel%dis)
243  type is (disvtype)
244  if (.not. all(gwfdis%idomain == gwedis%idomain)) then
245  write (errmsg, fmtidomerr) trim(this%name)
246  call store_error(errmsg, terminate=.true.)
247  end if
248  end select
249  type is (disutype)
250  select type (gwedis => gwemodel%dis)
251  type is (disutype)
252  if (.not. all(gwfdis%idomain == gwedis%idomain)) then
253  write (errmsg, fmtidomerr) trim(this%name)
254  call store_error(errmsg, terminate=.true.)
255  end if
256  end select
257  end select
258  !
259  ! -- setup pointers to gwf variables allocated in gwf_ar
260  gwemodel%fmi%gwfhead => gwfmodel%x
261  call mem_checkin(gwemodel%fmi%gwfhead, &
262  'GWFHEAD', gwemodel%fmi%memoryPath, &
263  'X', gwfmodel%memoryPath)
264  gwemodel%fmi%gwfsat => gwfmodel%npf%sat
265  call mem_checkin(gwemodel%fmi%gwfsat, &
266  'GWFSAT', gwemodel%fmi%memoryPath, &
267  'SAT', gwfmodel%npf%memoryPath)
268  gwemodel%fmi%gwfspdis => gwfmodel%npf%spdis
269  call mem_checkin(gwemodel%fmi%gwfspdis, &
270  'GWFSPDIS', gwemodel%fmi%memoryPath, &
271  'SPDIS', gwfmodel%npf%memoryPath)
272  gwemodel%fmi%igwfspdis = gwfmodel%npf%icalcspdis
273  !
274  ! -- setup pointers to the flow storage rates. GWF strg arrays are
275  ! available after the gwf_ar routine is called.
276  if (gwemodel%inest > 0) then
277  if (gwfmodel%insto > 0) then
278  gwemodel%fmi%gwfstrgss => gwfmodel%sto%strgss
279  gwemodel%fmi%igwfstrgss = 1
280  if (gwfmodel%sto%iusesy == 1) then
281  gwemodel%fmi%gwfstrgsy => gwfmodel%sto%strgsy
282  gwemodel%fmi%igwfstrgsy = 1
283  end if
284  end if
285  end if
286  !
287  ! -- Set a pointer to conc in buy
288  if (gwfmodel%inbuy > 0) then
289  call gwfmodel%buy%set_concentration_pointer(gwemodel%name, gwemodel%x, &
290  gwemodel%ibound)
291  end if
292  !
293  ! -- Set a pointer to conc (which could be a temperature) in vsc
294  if (gwfmodel%invsc > 0) then
295  call gwfmodel%vsc%set_concentration_pointer(gwemodel%name, gwemodel%x, &
296  gwemodel%ibound, 1)
297  end if
298  !
299  ! -- transfer the boundary package information from gwf to gwe
300  call this%gwfbnd2gwefmi()
301  !
302  ! -- if mover package is active, then set a pointer to it's budget object
303  if (gwfmodel%inmvr /= 0) then
304  gwemodel%fmi%mvrbudobj => gwfmodel%mvr%budobj
305  end if
306  !
307  ! -- connect Connections
308  call this%gwfconn2gweconn(gwfmodel, gwemodel)
Definition: Dis.f90:1
Structured grid discretization.
Definition: Dis.f90:23
Unstructured grid discretization.
Definition: Disu.f90:28
Vertex grid discretization.
Definition: Disv.f90:24
Here is the call graph for this function:

◆ exg_da()

subroutine gwfgweexchangemodule::exg_da ( class(gwfgweexchangetype this)

Definition at line 481 of file exg-gwfgwe.f90.

482  ! -- modules
484  ! -- dummy
485  class(GwfGweExchangeType) :: this
486  !
487  call mem_deallocate(this%m1_idx)
488  call mem_deallocate(this%m2_idx)

◆ exg_df()

subroutine gwfgweexchangemodule::exg_df ( class(gwfgweexchangetype this)

Definition at line 131 of file exg-gwfgwe.f90.

132  ! -- modules
134  ! -- dummy
135  class(GwfGweExchangeType) :: this
136  ! -- local
137  class(BaseModelType), pointer :: mb => null()
138  type(GwfModelType), pointer :: gwfmodel => null()
139  type(GweModelType), pointer :: gwemodel => null()
140  !
141  ! -- set gwfmodel
142  mb => getbasemodelfromlist(basemodellist, this%m1_idx)
143  select type (mb)
144  type is (gwfmodeltype)
145  gwfmodel => mb
146  end select
147  !
148  ! -- set gwemodel
149  mb => getbasemodelfromlist(basemodellist, this%m2_idx)
150  select type (mb)
151  type is (gwemodeltype)
152  gwemodel => mb
153  end select
154  !
155  ! -- Check to make sure that flow is solved before transport and in a
156  ! different IMS solution
157  if (gwfmodel%idsoln >= gwemodel%idsoln) then
158  write (errmsg, '(3a)') 'Problem with GWF-GWE exchange ', trim(this%name), &
159  '. The GWF model must be solved by a different IMS than the GWE model. &
160  &Furthermore, the IMS specified for GWF must be listed in mfsim.nam &
161  &before the IMS for GWE.'
162  call store_error(errmsg, terminate=.true.)
163  end if
164  !
165  ! -- Set pointer to flowja
166  gwemodel%fmi%gwfflowja => gwfmodel%flowja
167  call mem_checkin(gwemodel%fmi%gwfflowja, &
168  'GWFFLOWJA', gwemodel%fmi%memoryPath, &
169  'FLOWJA', gwfmodel%memoryPath)
170 
171  !
172  ! -- Set the npf flag so that specific discharge is available for
173  ! transport calculations if dispersion is active
174  if (gwemodel%incnd > 0) then
175  gwfmodel%npf%icalcspdis = 1
176  end if
Here is the call graph for this function:

◆ gwfbnd2gwefmi()

subroutine gwfgweexchangemodule::gwfbnd2gwefmi ( class(gwfgweexchangetype this)

Definition at line 508 of file exg-gwfgwe.f90.

509  ! -- dummy
510  class(GwfGweExchangeType) :: this
511  ! -- local
512  integer(I4B) :: ngwfpack, ip, iterm, imover
513  class(BaseModelType), pointer :: mb => null()
514  type(GwfModelType), pointer :: gwfmodel => null()
515  type(GweModelType), pointer :: gwemodel => null()
516  class(BndType), pointer :: packobj => null()
517  !
518  ! -- set gwfmodel
519  mb => getbasemodelfromlist(basemodellist, this%m1_idx)
520  select type (mb)
521  type is (gwfmodeltype)
522  gwfmodel => mb
523  end select
524  !
525  ! -- set gwemodel
526  mb => getbasemodelfromlist(basemodellist, this%m2_idx)
527  select type (mb)
528  type is (gwemodeltype)
529  gwemodel => mb
530  end select
531  !
532  ! -- Call routines in FMI that will set pointers to the necessary flow
533  ! data (SIMVALS and SIMTOMVR) stored within each GWF flow package
534  ngwfpack = gwfmodel%bndlist%Count()
535  iterm = 1
536  do ip = 1, ngwfpack
537  packobj => getbndfromlist(gwfmodel%bndlist, ip)
538  call gwemodel%fmi%gwfpackages(iterm)%set_pointers( &
539  'SIMVALS', &
540  packobj%memoryPath, packobj%input_mempath)
541  iterm = iterm + 1
542  !
543  ! -- If a mover is active for this package, then establish a separate
544  ! pointer link for the mover flows stored in SIMTOMVR
545  imover = packobj%imover
546  if (packobj%isadvpak /= 0) imover = 0
547  if (imover /= 0) then
548  call gwemodel%fmi%gwfpackages(iterm)%set_pointers( &
549  'SIMTOMVR', &
550  packobj%memoryPath, packobj%input_mempath)
551  iterm = iterm + 1
552  end if
553  end do
Here is the call graph for this function:

◆ gwfconn2gweconn()

subroutine gwfgweexchangemodule::gwfconn2gweconn ( class(gwfgweexchangetype this,
type(gwfmodeltype), pointer  gwfModel,
type(gwemodeltype), pointer  gweModel 
)
Parameters
thisthis exchange
gwfmodelthe flow model
gwemodelthe energy transport model

Definition at line 313 of file exg-gwfgwe.f90.

314  ! -- modules
315  use simmodule, only: store_error
316  use simvariablesmodule, only: iout
318  ! -- dummy
319  class(GwfGweExchangeType) :: this !< this exchange
320  type(GwfModelType), pointer :: gwfModel !< the flow model
321  type(GweModelType), pointer :: gweModel !< the energy transport model
322  ! -- local
323  class(SpatialModelConnectionType), pointer :: conn => null()
324  class(*), pointer :: objPtr => null()
325  class(GweGweConnectionType), pointer :: gweConn => null()
326  class(GwfGwfConnectionType), pointer :: gwfConn => null()
327  class(GwfExchangeType), pointer :: gwfEx => null()
328  integer(I4B) :: ic1, ic2, iex
329  integer(I4B) :: gwfConnIdx, gwfExIdx
330  logical(LGP) :: areEqual
331  !
332  ! loop over all connections
333  gweloop: do ic1 = 1, baseconnectionlist%Count()
334  !
335  conn => get_smc_from_list(baseconnectionlist, ic1)
336  if (.not. associated(conn%owner, gwemodel)) cycle gweloop
337  !
338  ! start with a GWE conn.
339  objptr => conn
340  gweconn => castasgwegweconnection(objptr)
341  gwfconnidx = -1
342  gwfexidx = -1
343  !
344  ! find matching GWF conn. in same list
345  gwfloop: do ic2 = 1, baseconnectionlist%Count()
346  conn => get_smc_from_list(baseconnectionlist, ic2)
347  !
348  if (associated(conn%owner, gwfmodel)) then
349  objptr => conn
350  gwfconn => castasgwfgwfconnection(objptr)
351  !
352  ! for now, connecting the same nodes nrs will be
353  ! sufficient evidence of equality
354  areequal = all(gwfconn%prim_exchange%nodem1 == &
355  gweconn%prim_exchange%nodem1)
356  areequal = areequal .and. all(gwfconn%prim_exchange%nodem2 == &
357  gweconn%prim_exchange%nodem2)
358  if (areequal) then
359  ! same DIS, same exchange: link and go to next GWE conn.
360  write (iout, '(/6a)') 'Linking exchange ', &
361  trim(gweconn%prim_exchange%name), &
362  ' to ', trim(gwfconn%prim_exchange%name), &
363  ' (using interface model) for GWE model ', &
364  trim(gwemodel%name)
365  gwfconnidx = ic2
366  call this%link_connections(gweconn, gwfconn)
367  exit gwfloop
368  end if
369  end if
370  end do gwfloop
371  !
372  ! fallback option: coupling to old gwfgwf exchange,
373  ! (this will go obsolete at some point)
374  if (gwfconnidx == -1) then
375  gwfloopexg: do iex = 1, baseexchangelist%Count()
376  gwfex => getgwfexchangefromlist(baseexchangelist, iex)
377  !
378  ! -- There is no guarantee that iex is a gwfExg, in which case
379  ! it will return as null. cycle if so.
380  if (.not. associated(gwfex)) cycle gwfloopexg
381  !
382  if (associated(gwfex%model1, gwfmodel) .or. &
383  associated(gwfex%model2, gwfmodel)) then
384 
385  ! check exchanges have same node counts
386  areequal = size(gwfex%nodem1) == size(gweconn%prim_exchange%nodem1)
387  ! then, connecting the same nodes nrs will be
388  ! sufficient evidence of equality
389  if (areequal) &
390  areequal = all(gwfex%nodem1 == gweconn%prim_exchange%nodem1)
391  if (areequal) &
392  areequal = all(gwfex%nodem2 == gweconn%prim_exchange%nodem2)
393  if (areequal) then
394  ! link exchange to connection
395  write (iout, '(/6a)') 'Linking exchange ', &
396  trim(gweconn%prim_exchange%name), &
397  ' to ', trim(gwfex%name), ' for GWE model ', &
398  trim(gwemodel%name)
399  gwfexidx = iex
400  if (gweconn%owns_exchange) then
401  gweconn%gweExchange%gwfsimvals => gwfex%simvals
402  call mem_checkin(gweconn%gweExchange%gwfsimvals, &
403  'GWFSIMVALS', gweconn%gweExchange%memoryPath, &
404  'SIMVALS', gwfex%memoryPath)
405  end if
406  !
407  !cdl link up mvt to mvr
408  if (gwfex%inmvr > 0) then
409  if (gweconn%owns_exchange) then
410  !cdl todo: check and make sure gweEx has mvt active
411  call gweconn%gweExchange%mvt%set_pointer_mvrbudobj( &
412  gwfex%mvr%budobj)
413  end if
414  end if
415  !
416  if (associated(gwfex%model2, gwfmodel)) gweconn%exgflowSign = -1
417  gweconn%gweInterfaceModel%fmi%flows_from_file = .false.
418  !
419  exit gwfloopexg
420  end if
421  end if
422  !
423  end do gwfloopexg
424  end if
425  !
426  if (gwfconnidx == -1 .and. gwfexidx == -1) then
427  ! none found, report
428  write (errmsg, '(/6a)') 'Missing GWF-GWF exchange when connecting GWE'// &
429  ' model ', trim(gwemodel%name), ' with exchange ', &
430  trim(gweconn%prim_exchange%name), ' to GWF model ', &
431  trim(gwfmodel%name)
432  call store_error(errmsg, terminate=.true.)
433  end if
434  !
435  end do gweloop
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
This module contains simulation variables.
Definition: SimVariables.f90:9
integer(i4b) iout
file unit number for simulation output
Here is the call graph for this function:

◆ gwfgwe_cr()

subroutine, public gwfgweexchangemodule::gwfgwe_cr ( character(len=*), intent(in)  filename,
integer(i4b), intent(in)  id,
integer(i4b), intent(in)  m1_id,
integer(i4b), intent(in)  m2_id 
)

Definition at line 46 of file exg-gwfgwe.f90.

47  ! -- modules
49  ! -- dummy
50  character(len=*), intent(in) :: filename
51  integer(I4B), intent(in) :: id
52  integer(I4B), intent(in) :: m1_id
53  integer(I4B), intent(in) :: m2_id
54  ! -- local
55  class(BaseExchangeType), pointer :: baseexchange => null()
56  type(GwfGweExchangeType), pointer :: exchange => null()
57  character(len=20) :: cint
58  !
59  ! -- Create a new exchange and add it to the baseexchangelist container
60  allocate (exchange)
61  baseexchange => exchange
62  call addbaseexchangetolist(baseexchangelist, baseexchange)
63  !
64  ! -- Assign id and name
65  exchange%id = id
66  write (cint, '(i0)') id
67  exchange%name = 'GWF-GWE_'//trim(adjustl(cint))
68  exchange%memoryPath = exchange%name
69  !
70  ! -- allocate scalars
71  call exchange%allocate_scalars()
72  !
73  ! -- NB: convert from id to local model index in base model list
74  exchange%m1_idx = model_loc_idx(m1_id)
75  exchange%m2_idx = model_loc_idx(m2_id)
76  !
77  ! -- set model pointers
78  call exchange%set_model_pointers()
integer(i4b), dimension(:), allocatable model_loc_idx
equals the local index into the basemodel list (-1 when not available)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ link_connections()

subroutine gwfgweexchangemodule::link_connections ( class(gwfgweexchangetype this,
class(gwegweconnectiontype), pointer  gweConn,
class(gwfgwfconnectiontype), pointer  gwfConn 
)
Parameters
thisthis exchange
gweconnGWE connection
gwfconnGWF connection

Definition at line 440 of file exg-gwfgwe.f90.

441  ! -- modules
443  ! -- dummy
444  class(GwfGweExchangeType) :: this !< this exchange
445  class(GweGweConnectionType), pointer :: gweConn !< GWE connection
446  class(GwfGwfConnectionType), pointer :: gwfConn !< GWF connection
447  !
448  !gweConn%exgflowja => gwfConn%exgflowja
449  if (gweconn%owns_exchange) then
450  gweconn%gweExchange%gwfsimvals => gwfconn%gwfExchange%simvals
451  call mem_checkin(gweconn%gweExchange%gwfsimvals, &
452  'GWFSIMVALS', gweconn%gweExchange%memoryPath, &
453  'SIMVALS', gwfconn%gwfExchange%memoryPath)
454  end if
455  !
456  !cdl link up mvt to mvr
457  if (gwfconn%gwfExchange%inmvr > 0) then
458  if (gweconn%owns_exchange) then
459  !cdl todo: check and make sure gweEx has mvt active
460  call gweconn%gweExchange%mvt%set_pointer_mvrbudobj( &
461  gwfconn%gwfExchange%mvr%budobj)
462  end if
463  end if
464  !
465  if (associated(gwfconn%gwfExchange%model2, gwfconn%owner)) then
466  gweconn%exgflowSign = -1
467  end if
468  !
469  ! fmi flows are not read from file
470  gweconn%gweInterfaceModel%fmi%flows_from_file = .false.
471  !
472  ! set concentration pointer for buoyancy
473  !call gwfConn%gwfInterfaceModel%buy%set_concentration_pointer( &
474  ! gweConn%gweModel%name, &
475  ! gweConn%conc, &
476  ! gweConn%icbound)

◆ set_model_pointers()

subroutine gwfgweexchangemodule::set_model_pointers ( class(gwfgweexchangetype this)

Definition at line 83 of file exg-gwfgwe.f90.

84  ! -- dummy
85  class(GwfGweExchangeType) :: this
86  ! -- local
87  class(BaseModelType), pointer :: mb => null()
88  type(GwfModelType), pointer :: gwfmodel => null()
89  type(GweModelType), pointer :: gwemodel => null()
90  !
91  ! -- set gwfmodel
92  gwfmodel => null()
93  mb => getbasemodelfromlist(basemodellist, this%m1_idx)
94  select type (mb)
95  type is (gwfmodeltype)
96  gwfmodel => mb
97  end select
98  !
99  ! -- set gwemodel
100  gwemodel => null()
101  mb => getbasemodelfromlist(basemodellist, this%m2_idx)
102  select type (mb)
103  type is (gwemodeltype)
104  gwemodel => mb
105  end select
106  !
107  ! -- Verify that gwf model is of the correct type
108  if (.not. associated(gwfmodel)) then
109  write (errmsg, '(3a)') 'Problem with GWF-GWE exchange ', trim(this%name), &
110  '. Specified GWF Model does not appear to be of the correct type.'
111  call store_error(errmsg, terminate=.true.)
112  end if
113  !
114  ! -- Verify that gwe model is of the correct type
115  if (.not. associated(gwemodel)) then
116  write (errmsg, '(3a)') 'Problem with GWF-GWE exchange ', trim(this%name), &
117  '. Specified GWF Model does not appear to be of the correct type.'
118  call store_error(errmsg, terminate=.true.)
119  end if
120  !
121  ! -- Tell transport model fmi flows are not read from file
122  gwemodel%fmi%flows_from_file = .false.
123  !
124  ! -- Set a pointer to the GWF bndlist. This will allow the transport model
125  ! to look through the flow packages and establish a link to GWF flows
126  gwemodel%fmi%gwfbndlist => gwfmodel%bndlist
Here is the call graph for this function: