27 integer(I4B),
pointer :: m1_idx => null()
28 integer(I4B),
pointer :: m2_idx => null()
29 character(len=LINELENGTH) :: filename
52 character(len=*),
intent(in) :: filename
53 integer(I4B),
intent(in) :: id
54 integer(I4B),
intent(in) :: m1_id
55 integer(I4B),
intent(in) :: m2_id
59 character(len=20) :: cint
63 baseexchange => exchange
68 write (cint,
'(i0)') id
69 exchange%name =
'GWF-GWT_'//trim(adjustl(cint))
70 exchange%memoryPath = exchange%name
71 exchange%filename = filename
74 call exchange%allocate_scalars()
81 call exchange%set_model_pointers()
111 if (.not.
associated(gwfmodel))
then
112 write (
errmsg,
'(3a)')
'Problem with GWF-GWT exchange ', trim(this%name), &
113 '. Specified GWF Model does not appear to be of the correct type.'
118 if (.not.
associated(gwtmodel))
then
119 write (
errmsg,
'(3a)')
'Problem with GWF-GWT exchange ', trim(this%name), &
120 '. Specified GWT Model does not appear to be of the correct type.'
125 gwtmodel%fmi%flows_from_file = .false.
129 gwtmodel%fmi%gwfbndlist => gwfmodel%bndlist
160 if (gwfmodel%idsoln >= gwtmodel%idsoln)
then
161 write (
errmsg,
'(3a)')
'Problem with GWF-GWT exchange ', trim(this%name), &
162 '. The GWF model must be solved by a different IMS than the GWT model. &
163 &Furthermore, the IMS specified for GWF must be listed in mfsim.nam &
164 &before the IMS for GWT.'
169 gwtmodel%fmi%gwfflowja => gwfmodel%flowja
171 'GWFFLOWJA', gwtmodel%fmi%memoryPath, &
172 'FLOWJA', gwfmodel%memoryPath)
177 if (gwtmodel%indsp > 0)
then
178 gwfmodel%npf%icalcspdis = 1
197 character(len=*),
parameter :: fmtdiserr = &
198 "('GWF and GWT Models do not have the same discretization for exchange&
200 & GWF Model has ', i0, ' user nodes and ', i0, ' reduced nodes.&
201 & GWT Model has ', i0, ' user nodes and ', i0, ' reduced nodes.&
202 & Ensure discretization packages, including IDOMAIN, are identical.')"
203 character(len=*),
parameter :: fmtidomerr = &
204 "('GWF and GWT Models do not have the same discretization for exchange&
206 & GWF Model and GWT Model have different IDOMAIN arrays.&
207 & Ensure discretization packages, including IDOMAIN, are identical.')"
224 if (gwtmodel%dis%nodes /= gwfmodel%dis%nodes .or. &
225 gwtmodel%dis%nodesuser /= gwfmodel%dis%nodesuser)
then
226 write (
errmsg, fmtdiserr) trim(this%name), &
227 gwfmodel%dis%nodesuser, &
228 gwfmodel%dis%nodes, &
229 gwtmodel%dis%nodesuser, &
235 select type (gwfdis => gwfmodel%dis)
237 select type (gwtdis => gwtmodel%dis)
239 if (.not. all(gwfdis%idomain == gwtdis%idomain))
then
240 write (
errmsg, fmtidomerr) trim(this%name)
245 select type (gwtdis => gwtmodel%dis)
247 if (.not. all(gwfdis%idomain == gwtdis%idomain))
then
248 write (
errmsg, fmtidomerr) trim(this%name)
253 select type (gwtdis => gwtmodel%dis)
255 if (.not. all(gwfdis%idomain == gwtdis%idomain))
then
256 write (
errmsg, fmtidomerr) trim(this%name)
263 gwtmodel%fmi%gwfhead => gwfmodel%x
265 'GWFHEAD', gwtmodel%fmi%memoryPath, &
266 'X', gwfmodel%memoryPath)
267 gwtmodel%fmi%gwfsat => gwfmodel%npf%sat
269 'GWFSAT', gwtmodel%fmi%memoryPath, &
270 'SAT', gwfmodel%npf%memoryPath)
271 gwtmodel%fmi%gwfspdis => gwfmodel%npf%spdis
273 'GWFSPDIS', gwtmodel%fmi%memoryPath, &
274 'SPDIS', gwfmodel%npf%memoryPath)
275 gwtmodel%fmi%igwfspdis = gwfmodel%npf%icalcspdis
279 if (gwtmodel%inmst > 0)
then
280 if (gwfmodel%insto > 0)
then
281 gwtmodel%fmi%gwfstrgss => gwfmodel%sto%strgss
282 gwtmodel%fmi%igwfstrgss = 1
283 if (gwfmodel%sto%iusesy == 1)
then
284 gwtmodel%fmi%gwfstrgsy => gwfmodel%sto%strgsy
285 gwtmodel%fmi%igwfstrgsy = 1
291 if (gwfmodel%inbuy > 0)
then
292 call gwfmodel%buy%set_concentration_pointer(gwtmodel%name, gwtmodel%x, &
297 if (gwfmodel%invsc > 0)
then
298 call gwfmodel%vsc%set_concentration_pointer(gwtmodel%name, gwtmodel%x, &
303 call this%gwfbnd2gwtfmi()
306 if (gwfmodel%inmvr /= 0)
then
307 gwtmodel%fmi%mvrbudobj => gwfmodel%mvr%budobj
311 call this%gwfconn2gwtconn(gwfmodel, gwtmodel)
327 class(*),
pointer :: objPtr => null()
332 integer(I4B) :: ic1, ic2, iex
333 integer(I4B) :: gwfConnIdx, gwfExIdx
334 logical(LGP) :: areEqual
340 if (.not.
associated(conn%owner, gwtmodel)) cycle gwtloop
345 gwtexg => gwtconn%gwtExchange
353 if (
associated(conn%owner, gwfmodel))
then
357 gwfexg => gwfconn%gwfExchange
367 if (gwfexg%v_model1%name /= gwtexg%gwfmodelname1) cycle
368 if (gwfexg%v_model2%name /= gwtexg%gwfmodelname2) cycle
370 areequal = (gwfexg%nexg == gwtexg%nexg)
372 areequal = all(gwfexg%nodem1 == gwtexg%nodem1)
373 areequal = areequal .and. all(gwfexg%nodem2 == gwtexg%nodem2)
377 write (
iout,
'(/6a)')
'Linking exchange ', &
378 trim(gwtexg%name),
' to ', trim(gwfexg%name), &
379 ' (using interface model) for GWT model ', &
382 call this%link_connections(gwtconn, gwfconn)
391 if (gwfconnidx == -1)
then
395 if (.not.
associated(gwfexg)) cycle gwfloopexg
397 if (
associated(gwfexg%model1, gwfmodel) .or. &
398 associated(gwfexg%model2, gwfmodel))
then
400 if (gwfexg%v_model1%name /= gwtexg%gwfmodelname1) cycle
401 if (gwfexg%v_model2%name /= gwtexg%gwfmodelname2) cycle
403 areequal = (gwfexg%nexg == gwtexg%nexg)
406 areequal = all(gwfexg%nodem1 == gwtexg%nodem1)
407 areequal = areequal .and. all(gwfexg%nodem2 == gwtexg%nodem2)
411 write (
iout,
'(/6a)')
'Linking exchange ', &
412 trim(gwtexg%name),
' to ', trim(gwfexg%name),
' for GWT model ', &
415 if (gwtconn%owns_exchange)
then
416 gwtexg%gwfsimvals => gwfexg%simvals
418 'GWFSIMVALS', gwtexg%memoryPath, &
419 'SIMVALS', gwfexg%memoryPath)
423 if (gwfexg%inmvr > 0)
then
424 if (gwtconn%owns_exchange)
then
426 call gwtexg%mvt%set_pointer_mvrbudobj(gwfexg%mvr%budobj)
430 if (
associated(gwfexg%model2, gwfmodel)) gwtconn%exgflowSign = -1
431 gwtconn%gwtInterfaceModel%fmi%flows_from_file = .false.
440 if (gwfconnidx == -1 .and. gwfexidx == -1)
then
442 write (errmsg, *)
'Cannot find GWF-GWF exchange when connecting'// &
443 ' GWT model ', trim(gwtmodel%name),
' with exchange ', &
444 trim(gwtexg%name),
' to GWF model ', trim(gwfmodel%name), &
445 '. Note: GWF-GWF and GWT-GWT need identical exchange data '// &
446 '(both in value and order) for the match to succeed.'
469 if (gwtconn%owns_exchange)
then
470 gwtconn%gwtExchange%gwfsimvals => gwfconn%gwfExchange%simvals
472 'GWFSIMVALS', gwtconn%gwtExchange%memoryPath, &
473 'SIMVALS', gwfconn%gwfExchange%memoryPath)
477 if (gwfconn%gwfExchange%inmvr > 0)
then
478 if (gwtconn%owns_exchange)
then
480 call gwtconn%gwtExchange%mvt%set_pointer_mvrbudobj( &
481 gwfconn%gwfExchange%mvr%budobj)
485 if (
associated(gwfconn%gwfExchange%model2, gwfconn%owner))
then
486 gwtconn%exgflowSign = -1
490 gwtconn%gwtInterfaceModel%fmi%flows_from_file = .false.
532 integer(I4B) :: ngwfpack, ip, iterm, imover
536 class(
bndtype),
pointer :: packobj => null()
554 ngwfpack = gwfmodel%bndlist%Count()
558 call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( &
560 packobj%memoryPath, packobj%input_mempath)
565 imover = packobj%imover
566 if (packobj%isadvpak /= 0) imover = 0
567 if (imover /= 0)
then
568 call gwtmodel%fmi%gwfpackages(iterm)%set_pointers( &
570 packobj%memoryPath, packobj%input_mempath)
subroutine, public addbaseexchangetolist(list, exchange)
Add the exchange object (BaseExchangeType) to a list.
class(basemodeltype) function, pointer, public getbasemodelfromlist(list, idx)
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.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
class(gwfgwfconnectiontype) function, pointer, public castasgwfgwfconnection(obj)
Cast to GwfGwfConnectionType.
This module contains the GwfGwfExchangeModule Module.
class(gwfexchangetype) function, pointer, public getgwfexchangefromlist(list, idx)
@ brief Get exchange from list
subroutine exg_da(this)
Deallocate memory.
subroutine gwfconn2gwtconn(this, gwfModel, gwtModel)
Link GWT connections to GWF connections or exchanges.
subroutine, public gwfgwt_cr(filename, id, m1_id, m2_id)
Create a new GWF to GWT exchange object.
subroutine link_connections(this, gwtConn, gwfConn)
Links a GWT connection to its GWF counterpart.
subroutine gwfbnd2gwtfmi(this)
Call routines in FMI that will set pointers to the necessary flow data.
subroutine allocate_scalars(this)
Allocate package scalars.
subroutine set_model_pointers(this)
Allocate and read.
class(gwtgwtconnectiontype) function, pointer, public castasgwtgwtconnection(obj)
Cast to GwtGwtConnectionType.
This module contains the GwtGwtExchangeModule Module.
This module defines variable data types.
type(listtype), public basemodellist
type(listtype), public baseexchangelist
type(listtype), public baseconnectionlist
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
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.
Structured grid discretization.
Unstructured grid discretization.
Vertex grid discretization.
Connecting a GWF model to other models in space, implements NumericalExchangeType so the solution can...
Derived type for GwfExchangeType.
Connects a GWT model to other GWT models in space. Derives from NumericalExchangeType so the solution...
Derived type for GwtExchangeType.
Class to manage spatial connection of a model to one or more models of the same type....