MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
exg-gwfgwe.f90
Go to the documentation of this file.
2  use kindmodule, only: dp, i4b, lgp
6  use simmodule, only: store_error
7  use simvariablesmodule, only: errmsg
16  use gwfmodule, only: gwfmodeltype
17  use gwemodule, only: gwemodeltype
18  use bndmodule, only: bndtype, getbndfromlist
19 
20  implicit none
21  public :: gwfgweexchangetype
22  public :: gwfgwe_cr
23 
25 
26  integer(I4B), pointer :: m1_idx => null() !< index into the list of base exchanges for model 1
27  integer(I4B), pointer :: m2_idx => null() !< index into the list of base exchanges for model 2
28 
29  contains
30 
31  procedure :: exg_df
32  procedure :: exg_ar
33  procedure :: exg_da
34  procedure, private :: set_model_pointers
35  procedure, private :: allocate_scalars
36  procedure, private :: gwfbnd2gwefmi
37  procedure, private :: gwfconn2gweconn
38  procedure, private :: link_connections
39 
40  end type gwfgweexchangetype
41 
42 contains
43 
44  !> @brief Create a new GWF to GWE exchange object
45  !<
46  subroutine gwfgwe_cr(filename, id, m1_id, m2_id)
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()
79  end subroutine gwfgwe_cr
80 
81  !> @brief Allocate and read
82  !<
83  subroutine set_model_pointers(this)
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
127  end subroutine set_model_pointers
128 
129  !> @brief Define the GwfGwe Exchange object
130  !<
131  subroutine exg_df(this)
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
177  end subroutine exg_df
178 
179  !> @brief Allocate and read
180  !<
181  subroutine exg_ar(this)
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)
309  end subroutine exg_ar
310 
311  !> @brief Link GWE connections to GWF connections or exchanges
312  !<
313  subroutine gwfconn2gweconn(this, gwfModel, gweModel)
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  !
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()
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()
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
436  end subroutine gwfconn2gweconn
437 
438  !> @brief Links a GWE connection to its GWF counterpart
439  !<
440  subroutine link_connections(this, gweConn, gwfConn)
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)
477  end subroutine link_connections
478 
479  !> @brief Deallocate memory
480  !<
481  subroutine exg_da(this)
482  ! -- modules
484  ! -- dummy
485  class(gwfgweexchangetype) :: this
486  !
487  call mem_deallocate(this%m1_idx)
488  call mem_deallocate(this%m2_idx)
489  end subroutine exg_da
490 
491  !> @brief Allocate GwfGwe exchange scalars
492  !<
493  subroutine allocate_scalars(this)
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
503  end subroutine allocate_scalars
504 
505  !> @brief Call routines in FMI that will set pointers to the necessary flow
506  !! data (SIMVALS and SIMTOMVR) stored within each GWF flow package
507  !<
508  subroutine gwfbnd2gwefmi(this)
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
554  end subroutine gwfbnd2gwefmi
555 
556 end module gwfgweexchangemodule
subroutine, public addbaseexchangetolist(list, exchange)
Add the exchange object (BaseExchangeType) to a list.
class(basemodeltype) function, pointer, public getbasemodelfromlist(list, idx)
Definition: BaseModel.f90:172
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 lenpackagename
maximum length of the package name
Definition: Constants.f90:23
Definition: Dis.f90:1
class(gwegweconnectiontype) function, pointer, public castasgwegweconnection(obj)
Cast to GweGweConnectionType.
Definition: gwe.f90:3
subroutine gwfbnd2gwefmi(this)
Call routines in FMI that will set pointers to the necessary flow data (SIMVALS and SIMTOMVR) stored ...
Definition: exg-gwfgwe.f90:509
subroutine gwfconn2gweconn(this, gwfModel, gweModel)
Link GWE connections to GWF connections or exchanges.
Definition: exg-gwfgwe.f90:314
subroutine set_model_pointers(this)
Allocate and read.
Definition: exg-gwfgwe.f90:84
subroutine allocate_scalars(this)
Allocate GwfGwe exchange scalars.
Definition: exg-gwfgwe.f90:494
subroutine exg_da(this)
Deallocate memory.
Definition: exg-gwfgwe.f90:482
subroutine, public gwfgwe_cr(filename, id, m1_id, m2_id)
Create a new GWF to GWE exchange object.
Definition: exg-gwfgwe.f90:47
subroutine link_connections(this, gweConn, gwfConn)
Links a GWE connection to its GWF counterpart.
Definition: exg-gwfgwe.f90:441
class(gwfgwfconnectiontype) function, pointer, public castasgwfgwfconnection(obj)
Cast to GwfGwfConnectionType.
This module contains the GwfGwfExchangeModule Module.
Definition: exg-gwfgwf.f90:10
class(gwfexchangetype) function, pointer, public getgwfexchangefromlist(list, idx)
@ brief Get exchange from list
Definition: gwf.f90:1
This module defines variable data types.
Definition: kind.f90:8
type(listtype), public basemodellist
Definition: mf6lists.f90:16
type(listtype), public baseexchangelist
Definition: mf6lists.f90:25
type(listtype), public baseconnectionlist
Definition: mf6lists.f90:28
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
character(len=maxcharlen) errmsg
error message string
integer(i4b), dimension(:), allocatable model_loc_idx
equals the local index into the basemodel list (-1 when not available)
integer(i4b) iout
file unit number for simulation output
class(spatialmodelconnectiontype) function, pointer, public get_smc_from_list(list, idx)
Get the connection from a list.
Highest level model type. All models extend this parent type.
Definition: BaseModel.f90:13
@ brief BndType
Structured grid discretization.
Definition: Dis.f90:23
Unstructured grid discretization.
Definition: Disu.f90:28
Vertex grid discretization.
Definition: Disv.f90:24
Connects a GWE model to other GWE models in space. Derives from NumericalExchangeType so the solution...
Connecting a GWF model to other models in space, implements NumericalExchangeType so the solution can...
Derived type for GwfExchangeType.
Definition: exg-gwfgwf.f90:47
Class to manage spatial connection of a model to one or more models of the same type....