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 call this%gwfInterfaceModel%model_df()
166 this%gwfInterfaceModel%npf%ik22 = this%gwfModel%npf%ik22
167 this%gwfInterfaceModel%npf%ik33 = this%gwfModel%npf%ik33
168 this%gwfInterfaceModel%npf%iwetdry = this%gwfModel%npf%iwetdry
169 this%gwfInterfaceModel%npf%iangle1 = this%gwfModel%npf%iangle1
170 this%gwfInterfaceModel%npf%iangle2 = this%gwfModel%npf%iangle2
171 this%gwfInterfaceModel%npf%iangle3 = this%gwfModel%npf%iangle3
173 call this%cfg_dist_vars()
175 if (this%gwfInterfaceModel%npf%ixt3d > 0)
then
176 this%gwfInterfaceModel%npf%iangle1 = 1
177 this%gwfInterfaceModel%npf%iangle2 = 1
178 this%gwfInterfaceModel%npf%iangle3 = 1
182 do i = 1,
size(this%gwfInterfaceModel%npf%angle1)
183 this%gwfInterfaceModel%npf%angle1 = 0.0_dp
185 do i = 1,
size(this%gwfInterfaceModel%npf%angle2)
186 this%gwfInterfaceModel%npf%angle2 = 0.0_dp
188 do i = 1,
size(this%gwfInterfaceModel%npf%angle3)
189 this%gwfInterfaceModel%npf%angle3 = 0.0_dp
193 call this%spatialcon_setmodelptrs()
196 call this%spatialcon_connect()
205 call this%cfg_dv(
'X',
'',
sync_nds, &
207 call this%cfg_dv(
'IBOUND',
'',
sync_nds, &
214 if (this%gwfInterfaceModel%npf%iangle1 == 1)
then
217 if (this%gwfInterfaceModel%npf%iangle2 == 1)
then
220 if (this%gwfInterfaceModel%npf%iangle3 == 1)
then
223 if (this%gwfInterfaceModel%npf%iwetdry == 1)
then
229 if (this%gwfInterfaceModel%inbuy > 0)
then
241 this%iXt3dOnExchange = this%gwfExchange%ixt3d
242 if (this%iXt3dOnExchange > 0)
then
243 this%exg_stencil_depth = 2
244 if (this%gwfModel%npf%ixt3d > 0)
then
245 this%int_stencil_depth = 2
258 call mem_allocate(this%iXt3dOnExchange,
'IXT3DEXG', this%memoryPath)
272 call this%validateConnection()
275 call this%spatialcon_ar()
278 call this%gwfInterfaceModel%model_ar()
281 if (this%owns_exchange)
then
282 if (this%gwfExchange%inmvr > 0)
then
283 call this%gwfExchange%mvr%mvr_ar()
285 if (this%gwfExchange%inobs > 0)
then
286 call this%gwfExchange%obs%obs_ar()
298 if (this%owns_exchange)
then
299 call this%gwfExchange%exg_rp()
311 if (this%owns_exchange)
then
312 call this%gwfExchange%exg_ad()
319 integer(I4B),
intent(in) :: kiter
321 call this%SpatialModelConnectionType%spatialcon_cf(kiter)
324 if (this%owns_exchange)
then
325 if (this%gwfExchange%inmvr > 0)
then
326 call this%gwfExchange%mvr%xmvr_cf()
336 integer(I4B),
intent(in) :: kiter
338 real(DP),
dimension(:),
intent(inout) :: rhs_sln
339 integer(I4B),
optional,
intent(in) :: inwtflag
342 call this%SpatialModelConnectionType%spatialcon_fc( &
343 kiter, matrix_sln, rhs_sln, inwtflag)
347 if (this%owns_exchange)
then
348 if (this%gwfExchange%inmvr > 0)
then
349 call this%gwfExchange%mvr%mvr_fc()
366 call this%SpatialModelConnectionType%validateConnection()
367 call this%validateGwfExchange()
371 write (
errmsg,
'(a)')
'Errors occurred while processing exchange(s)'
390 class(*),
pointer :: modelPtr
394 logical(LGP) :: compatible
396 gwfex => this%gwfExchange
399 if (gwfex%ingnc /= 0 .and. gwfex%ixt3d /= 0)
then
400 write (
errmsg,
'(2a)')
'Ghost node correction not supported '// &
401 'combined with XT3D for exchange ', trim(gwfex%name)
405 write (
errmsg,
'(2a)')
'Ghost node correction not supported '// &
406 'in parallel run for exchange ', trim(gwfex%name)
411 if (.not. gwfex%v_model1%is_local)
return
412 if (.not. gwfex%v_model2%is_local)
return
414 modelptr => this%gwfExchange%model1
416 modelptr => this%gwfExchange%model2
419 if ((gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy == 0) .or. &
420 (gwfmodel1%inbuy == 0 .and. gwfmodel2%inbuy > 0))
then
421 write (
errmsg,
'(2a)')
'Buoyancy package should be enabled/disabled '// &
422 'simultaneously in models connected with the '// &
423 'interface model for exchange ', &
429 if (gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy > 0)
then
431 if (this%iXt3dOnExchange > 0)
then
432 write (
errmsg,
'(2a)')
'Connecting models with BUY package not '// &
433 'allowed with XT3D enabled on exchange ', &
440 buy1 => gwfmodel1%buy
441 buy2 => gwfmodel2%buy
442 if (buy1%iform /= buy2%iform) compatible = .false.
443 if (buy1%denseref /= buy2%denseref) compatible = .false.
444 if (buy1%nrhospecies /= buy2%nrhospecies) compatible = .false.
445 if (.not. all(buy1%drhodc == buy2%drhodc)) compatible = .false.
446 if (.not. all(buy1%crhoref == buy2%crhoref)) compatible = .false.
447 if (.not. all(buy1%cauxspeciesname == buy2%cauxspeciesname))
then
451 if (.not. compatible)
then
452 write (
errmsg,
'(6a)')
'Buoyancy packages in model ', &
453 trim(gwfex%model1%name),
' and ', &
454 trim(gwfex%model2%name), &
455 ' should be equivalent to construct an '// &
456 ' interface model for exchange ', &
471 logical(LGP) :: isOpen
476 call this%gwfInterfaceModel%model_da()
477 deallocate (this%gwfInterfaceModel)
479 call this%spatialcon_da()
481 inquire (this%iout, opened=isopen)
487 if (this%owns_exchange)
then
488 call this%gwfExchange%exg_da()
499 integer(I4B),
intent(inout) :: icnvg
500 integer(I4B),
intent(in) :: isuppress_output
501 integer(I4B),
intent(in) :: isolnid
503 call this%gwfInterfaceModel%model_cq(icnvg, isuppress_output)
505 call this%setFlowToExchange()
507 call this%setFlowToModel()
513 if (this%gwfModel%npf%icalcspdis == 1)
then
514 call this%setNpfEdgeProps()
521 if (this%owns_exchange)
then
522 call this%gwfExchange%gwf_gwf_add_to_flowja()
537 if (this%owns_exchange)
then
538 gwfex => this%gwfExchange
539 map => this%interface_map%exchange_maps(this%interface_map%prim_exg_idx)
542 do i = 1,
size(map%src_idx)
543 if (map%sign(i) < 0) cycle
544 gwfex%simvals(map%src_idx(i)) = &
545 this%gwfInterfaceModel%flowja(map%tgt_idx(i))
556 integer(I4B) :: n, m, ipos, iposLoc
557 integer(I4B) :: nLoc, mLoc
562 imcon => this%gwfInterfaceModel%dis%con
563 toglobal => this%ig_builder%idxToGlobal
566 if (.not. toglobal(n)%v_model == this%owner)
then
571 nloc = toglobal(n)%index
573 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
574 if (imcon%mask(ipos) < 1) cycle
577 mloc = toglobal(m)%index
578 if (toglobal(m)%v_model == this%owner)
then
581 iposloc =
getcsrindex(nloc, mloc, this%gwfModel%ia, this%gwfModel%ja)
584 this%gwfModel%flowja(iposloc) = this%gwfInterfaceModel%flowja(ipos)
597 integer(I4B) :: n, m, ipos, isym
598 integer(I4B) :: nLoc, mLoc
603 real(DP) :: nx, ny, nz
604 real(DP) :: cx, cy, cz
615 imdis => this%gwfInterfaceModel%dis
616 imcon => this%gwfInterfaceModel%dis%con
617 imnpf => this%gwfInterfaceModel%npf
618 toglobal => this%ig_builder%idxToGlobal
621 if (imnpf%ixt3d > 0)
then
622 nozee = imnpf%xt3d%nozee
629 if (.not. toglobal(n)%v_model == this%owner)
then
634 nloc = toglobal(n)%index
636 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
637 if (imcon%mask(ipos) < 1)
then
643 mloc = toglobal(m)%index
645 if (.not. toglobal(m)%v_model == this%owner)
then
647 isym = imcon%jas(ipos)
648 ihc = imcon%ihc(isym)
649 area = imcon%hwva(isym)
650 satthick = imnpf%calcSatThickness(n, m, ihc)
651 rrate = this%gwfInterfaceModel%flowja(ipos)
653 call imdis%connection_normal(n, m, ihc, nx, ny, nz, ipos)
654 call imdis%connection_vector(n, m, nozee, imnpf%sat(n), imnpf%sat(m), &
655 ihc, cx, cy, cz, conlen)
659 if (nz > 0) rrate = -rrate
661 area = area * satthick
668 dist = conlen * cl / (imcon%cl1(isym) + imcon%cl2(isym))
669 call this%gwfModel%npf%set_edge_properties(nloc, ihc, rrate, area, &
681 integer(I4B),
intent(inout) :: icnvg
682 integer(I4B),
intent(in) :: isuppress_output
683 integer(I4B),
intent(in) :: isolnid
688 if (this%owns_exchange)
then
689 call this%gwfExchange%exg_bd(icnvg, isuppress_output, isolnid)
703 if (this%owns_exchange)
then
704 call this%gwfExchange%exg_ot()
713 class(*),
pointer,
intent(inout) :: obj
717 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....