43 integer(I4B),
pointer :: ixt3donexchange => null()
45 integer(I4B) :: iout = 0
89 character(len=LINELENGTH) :: fname
90 character(len=LENCOMPONENTNAME) :: name
91 class(*),
pointer :: objPtr
92 logical(LGP) :: write_ifmodel_listfile = .false.
99 if (gwfex%v_model1%is_local .and. gwfex%v_model2%is_local)
then
100 this%owns_exchange = (gwfex%v_model1 == model)
102 this%owns_exchange = .true.
105 if (gwfex%v_model1 == model)
then
106 write (name,
'(a,i0)')
'GWFCON1_', gwfex%id
108 write (name,
'(a,i0)')
'GWFCON2_', gwfex%id
112 if (write_ifmodel_listfile)
then
113 fname = trim(name)//
'.im.lst'
114 call openfile(this%iout, 0, fname,
'LIST', filstat_opt=
'REPLACE')
115 write (this%iout,
'(4a)')
'Creating GWF-GWF connection for model ', &
116 trim(this%gwfModel%name),
' from exchange ', &
121 call this%SpatialModelConnectionType%spatialConnection_ctor(model, &
125 call this%allocateScalars()
127 this%typename =
'GWF-GWF'
130 call this%setGridExtent()
132 allocate (this%gwfInterfaceModel)
133 this%interface_model => this%gwfInterfaceModel
145 character(len=LENCOMPONENTNAME) :: imName
149 call this%spatialcon_df()
154 if (this%prim_exchange%v_model1 == this%owner)
then
155 write (imname,
'(a,i0)')
'GWFIM1_', this%gwfExchange%id
157 write (imname,
'(a,i0)')
'GWFIM2_', this%gwfExchange%id
159 call this%gwfInterfaceModel%gwfifm_cr(imname, this%iout, this%ig_builder)
160 call this%gwfInterfaceModel%set_idsoln(this%gwfModel%idsoln)
161 this%gwfInterfaceModel%npf%satomega = this%gwfModel%npf%satomega
162 this%gwfInterfaceModel%npf%ixt3d = this%iXt3dOnExchange
163 this%gwfInterfaceModel%npf%icellavg = this%gwfExchange%icellavg
164 call this%gwfInterfaceModel%model_df()
167 this%gwfInterfaceModel%npf%ik22 = this%gwfModel%npf%ik22
168 this%gwfInterfaceModel%npf%ik33 = this%gwfModel%npf%ik33
169 this%gwfInterfaceModel%npf%iwetdry = this%gwfModel%npf%iwetdry
170 this%gwfInterfaceModel%npf%iangle1 = this%gwfModel%npf%iangle1
171 this%gwfInterfaceModel%npf%iangle2 = this%gwfModel%npf%iangle2
172 this%gwfInterfaceModel%npf%iangle3 = this%gwfModel%npf%iangle3
174 call this%cfg_dist_vars()
176 if (this%gwfInterfaceModel%npf%ixt3d > 0)
then
177 this%gwfInterfaceModel%npf%iangle1 = 1
178 this%gwfInterfaceModel%npf%iangle2 = 1
179 this%gwfInterfaceModel%npf%iangle3 = 1
183 do i = 1,
size(this%gwfInterfaceModel%npf%angle1)
184 this%gwfInterfaceModel%npf%angle1(i) = 0.0_dp
186 do i = 1,
size(this%gwfInterfaceModel%npf%angle2)
187 this%gwfInterfaceModel%npf%angle2(i) = 0.0_dp
189 do i = 1,
size(this%gwfInterfaceModel%npf%angle3)
190 this%gwfInterfaceModel%npf%angle3(i) = 0.0_dp
194 call this%spatialcon_setmodelptrs()
197 call this%spatialcon_connect()
206 call this%cfg_dv(
'X',
'',
sync_nds, &
208 call this%cfg_dv(
'IBOUND',
'',
sync_nds, &
215 if (this%gwfInterfaceModel%npf%iangle1 == 1)
then
218 if (this%gwfInterfaceModel%npf%iangle2 == 1)
then
221 if (this%gwfInterfaceModel%npf%iangle3 == 1)
then
224 if (this%gwfInterfaceModel%npf%iwetdry == 1)
then
230 if (this%gwfInterfaceModel%inbuy > 0)
then
242 this%iXt3dOnExchange = this%gwfExchange%ixt3d
243 if (this%iXt3dOnExchange > 0)
then
244 this%exg_stencil_depth = 2
245 if (this%gwfModel%npf%ixt3d > 0)
then
246 this%int_stencil_depth = 2
259 call mem_allocate(this%iXt3dOnExchange,
'IXT3DEXG', this%memoryPath)
273 call this%validateConnection()
276 call this%spatialcon_ar()
279 call this%gwfInterfaceModel%model_ar()
282 if (this%owns_exchange)
then
283 if (this%gwfExchange%inmvr > 0)
then
284 call this%gwfExchange%mvr%mvr_ar()
286 if (this%gwfExchange%inobs > 0)
then
287 call this%gwfExchange%obs%obs_ar()
299 if (this%owns_exchange)
then
300 call this%gwfExchange%exg_rp()
312 if (this%owns_exchange)
then
313 call this%gwfExchange%exg_ad()
320 integer(I4B),
intent(in) :: kiter
322 call this%SpatialModelConnectionType%spatialcon_cf(kiter)
325 if (this%owns_exchange)
then
326 if (this%gwfExchange%inmvr > 0)
then
327 call this%gwfExchange%mvr%xmvr_cf()
337 integer(I4B),
intent(in) :: kiter
339 real(DP),
dimension(:),
intent(inout) :: rhs_sln
340 integer(I4B),
optional,
intent(in) :: inwtflag
343 call this%SpatialModelConnectionType%spatialcon_fc( &
344 kiter, matrix_sln, rhs_sln, inwtflag)
348 if (this%owns_exchange)
then
349 if (this%gwfExchange%inmvr > 0)
then
350 call this%gwfExchange%mvr%mvr_fc()
367 call this%SpatialModelConnectionType%validateConnection()
368 call this%validateGwfExchange()
372 write (
errmsg,
'(a)')
'Errors occurred while processing exchange(s)'
391 class(*),
pointer :: modelPtr
395 logical(LGP) :: compatible
397 gwfex => this%gwfExchange
400 if (gwfex%ingnc /= 0 .and. gwfex%ixt3d /= 0)
then
401 write (
errmsg,
'(2a)')
'Ghost node correction not supported '// &
402 'combined with XT3D for exchange ', trim(gwfex%name)
406 write (
errmsg,
'(2a)')
'Ghost node correction not supported '// &
407 'in parallel run for exchange ', trim(gwfex%name)
412 if (.not. gwfex%v_model1%is_local)
return
413 if (.not. gwfex%v_model2%is_local)
return
415 modelptr => this%gwfExchange%model1
417 modelptr => this%gwfExchange%model2
420 if ((gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy == 0) .or. &
421 (gwfmodel1%inbuy == 0 .and. gwfmodel2%inbuy > 0))
then
422 write (
errmsg,
'(2a)')
'Buoyancy package should be enabled/disabled '// &
423 'simultaneously in models connected with the '// &
424 'interface model for exchange ', &
430 if (gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy > 0)
then
432 if (this%iXt3dOnExchange > 0)
then
433 write (
errmsg,
'(2a)')
'Connecting models with BUY package not '// &
434 'allowed with XT3D enabled on exchange ', &
441 buy1 => gwfmodel1%buy
442 buy2 => gwfmodel2%buy
443 if (buy1%iform /= buy2%iform) compatible = .false.
444 if (buy1%denseref /= buy2%denseref) compatible = .false.
445 if (buy1%nrhospecies /= buy2%nrhospecies) compatible = .false.
446 if (.not. all(buy1%drhodc == buy2%drhodc)) compatible = .false.
447 if (.not. all(buy1%crhoref == buy2%crhoref)) compatible = .false.
448 if (.not. all(buy1%cauxspeciesname == buy2%cauxspeciesname))
then
452 if (.not. compatible)
then
453 write (
errmsg,
'(6a)')
'Buoyancy packages in model ', &
454 trim(gwfex%model1%name),
' and ', &
455 trim(gwfex%model2%name), &
456 ' should be equivalent to construct an '// &
457 ' interface model for exchange ', &
472 logical(LGP) :: isOpen
477 call this%gwfInterfaceModel%model_da()
478 deallocate (this%gwfInterfaceModel)
480 call this%spatialcon_da()
482 inquire (this%iout, opened=isopen)
488 if (this%owns_exchange)
then
489 call this%gwfExchange%exg_da()
500 integer(I4B),
intent(inout) :: icnvg
501 integer(I4B),
intent(in) :: isuppress_output
502 integer(I4B),
intent(in) :: isolnid
504 call this%gwfInterfaceModel%model_cq(icnvg, isuppress_output)
506 call this%setFlowToExchange()
508 call this%setFlowToModel()
514 if (this%gwfModel%npf%icalcspdis == 1)
then
515 call this%setNpfEdgeProps()
522 if (this%owns_exchange)
then
523 call this%gwfExchange%gwf_gwf_add_to_flowja()
538 if (this%owns_exchange)
then
539 gwfex => this%gwfExchange
540 map => this%interface_map%exchange_maps(this%interface_map%prim_exg_idx)
543 do i = 1,
size(map%src_idx)
544 if (map%sign(i) < 0) cycle
545 gwfex%simvals(map%src_idx(i)) = &
546 this%gwfInterfaceModel%flowja(map%tgt_idx(i))
557 integer(I4B) :: n, m, ipos, iposLoc
558 integer(I4B) :: nLoc, mLoc
563 imcon => this%gwfInterfaceModel%dis%con
564 toglobal => this%ig_builder%idxToGlobal
567 if (.not. toglobal(n)%v_model == this%owner)
then
572 nloc = toglobal(n)%index
574 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
575 if (imcon%mask(ipos) < 1) cycle
578 mloc = toglobal(m)%index
579 if (toglobal(m)%v_model == this%owner)
then
582 iposloc =
getcsrindex(nloc, mloc, this%gwfModel%ia, this%gwfModel%ja)
585 this%gwfModel%flowja(iposloc) = this%gwfInterfaceModel%flowja(ipos)
598 integer(I4B) :: n, m, ipos, isym
599 integer(I4B) :: nLoc, mLoc
604 real(DP) :: nx, ny, nz
605 real(DP) :: cx, cy, cz
616 imdis => this%gwfInterfaceModel%dis
617 imcon => this%gwfInterfaceModel%dis%con
618 imnpf => this%gwfInterfaceModel%npf
619 toglobal => this%ig_builder%idxToGlobal
622 if (imnpf%ixt3d > 0)
then
623 nozee = imnpf%xt3d%nozee
630 if (.not. toglobal(n)%v_model == this%owner)
then
635 nloc = toglobal(n)%index
637 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
638 if (imcon%mask(ipos) < 1)
then
644 mloc = toglobal(m)%index
646 if (.not. toglobal(m)%v_model == this%owner)
then
648 isym = imcon%jas(ipos)
649 ihc = imcon%ihc(isym)
650 area = imcon%hwva(isym)
651 satthick = imnpf%calcSatThickness(n, m, ihc)
652 rrate = this%gwfInterfaceModel%flowja(ipos)
654 call imdis%connection_normal(n, m, ihc, nx, ny, nz, ipos)
655 call imdis%connection_vector(n, m, nozee, imnpf%sat(n), imnpf%sat(m), &
656 ihc, cx, cy, cz, conlen)
660 if (nz > 0) rrate = -rrate
662 area = area * satthick
669 dist = conlen * cl / (imcon%cl1(isym) + imcon%cl2(isym))
670 call this%gwfModel%npf%set_edge_properties(nloc, ihc, rrate, area, &
682 integer(I4B),
intent(inout) :: icnvg
683 integer(I4B),
intent(in) :: isuppress_output
684 integer(I4B),
intent(in) :: isolnid
689 if (this%owns_exchange)
then
690 call this%gwfExchange%exg_bd(icnvg, isuppress_output, isolnid)
704 if (this%owns_exchange)
then
705 call this%gwfExchange%exg_ot()
714 class(*),
pointer,
intent(inout) :: obj
718 if (.not.
associated(obj))
return
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lencomponentname
maximum length of a component name
integer(i4b), parameter lenvarname
maximum length of a variable name
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
integer(i4b) function, public getcsrindex(i, j, ia, ja)
Return index for element i,j in CSR storage,.
integer(i4b), parameter, public sync_nds
synchronize over nodes
Refactoring issues towards parallel:
subroutine cfg_dist_vars(this)
Configure distributed variables for this interface model.
subroutine gwfgwfcon_cf(this, kiter)
subroutine gwfgwfcon_ad(this)
Advance this connection.
subroutine setflowtoexchange(this)
Set the flows (flowja from interface model) to the.
subroutine gwfgwfcon_cq(this, icnvg, isuppress_output, isolnid)
Calculate intra-cell flows The calculation will be dispatched to the interface model,...
subroutine gwfgwfcon_bd(this, icnvg, isuppress_output, isolnid)
Calculate the budget terms for this connection, this is dispatched to the GWF-GWF exchange.
class(gwfgwfconnectiontype) function, pointer, public castasgwfgwfconnection(obj)
Cast to GwfGwfConnectionType.
subroutine setnpfedgeprops(this)
Set flowja as edge properties in the model,.
subroutine validategwfexchange(this)
Validate the exchange, intercepting those cases where two models have to be connected with an interfa...
subroutine allocatescalars(this)
allocation of scalars in the connection
subroutine gwfgwfcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
Write the calculated coefficients into the global.
subroutine setgridextent(this)
Set the required size of the interface grid from.
subroutine gwfgwfcon_rp(this)
Read time varying data when required.
subroutine gwfgwfcon_ar(this)
Allocate and read the connection.
subroutine gwfgwfcon_df(this)
Define the connection.
subroutine validateconnection(this)
Validate this connection This is called before proceeding to construct the interface model.
subroutine setflowtomodel(this)
Set the flows (flowja from the interface model) to.
subroutine gwfgwfconnection_ctor(this, model, gwfEx)
Basic construction of the connection.
subroutine gwfgwfcon_ot(this)
Write output for exchange (and calls.
subroutine gwfgwfcon_da(this)
Deallocate all resources.
This module contains the GwfGwfExchangeModule Module.
class(gwfexchangetype) function, pointer, public getgwfexchangefromlist(list, idx)
@ brief Get exchange from list
class(gwfexchangetype) function, pointer, public castasgwfexchange(obj)
@ brief Cast polymorphic object as exchange
class(gwfmodeltype) function, pointer, public castasgwfmodel(model)
Cast to GWF model.
This module defines variable data types.
This module contains simulation methods.
subroutine, public ustop(stopmess, ioutlocal)
Stop the simulation.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
integer(i4b), parameter, public stg_bfr_exg_ad
before exchange advance (per solution)
integer(i4b), parameter, public stg_bfr_exg_cf
before exchange calculate (per solution)
integer(i4b), parameter, public stg_bfr_con_ar
before connection allocate read
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) simulation_mode
Data structure to hold a global cell identifier, using a pointer to the model and its local cell.
Exchange based on connection between discretizations of DisBaseType. The data specifies the connectio...
This class is used to construct the connections object for the interface model's spatial discretizati...
Connecting a GWF model to other models in space, implements NumericalExchangeType so the solution can...
Derived type for GwfExchangeType.
The GWF Interface Model is a utility to calculate the solution's exchange coefficients from the inter...
Class to manage spatial connection of a model to one or more models of the same type....