MODFLOW 6 version 6.9.0.dev0
USGS Modular Hydrologic Model
Loading...
Searching...
No Matches
GwfGwfConnection.f90
Go to the documentation of this file.
2 use kindmodule, only: i4b, dp, lgp
8 use simmodule, only: ustop
16 use gwfnpfmodule, only: gwfnpftype
17 use gwfbuymodule, only: gwfbuytype
18 use basedismodule, only: disbasetype
24
25 implicit none
26 private
27
29
30 !> Connecting a GWF model to other models in space, implements
31 !! NumericalExchangeType so the solution can used this object to determine
32 !! the coefficients for the coupling between two adjacent models.
33 !!
34 !! Two connections are created per exchange between model1 and model2:
35 !! one to manage the coefficients in the matrix rows for model1, and
36 !! the other to do the same for model2.
37 !<
39
40 class(gwfmodeltype), pointer :: gwfmodel => null() !< the model for which this connection exists
41 class(gwfexchangetype), pointer :: gwfexchange => null() !< the primary exchange, cast to its concrete type
42 class(gwfinterfacemodeltype), pointer :: gwfinterfacemodel => null() !< the interface model
43 integer(I4B), pointer :: ixt3donexchange => null() !< run XT3D on the interface,
44 !! 0 = don't, 1 = matrix, 2 = rhs
45 integer(I4B) :: iout = 0 !< the list file for the interface model
46
47 contains
49 generic, public :: construct => gwfgwfconnection_ctor
50
51 ! overriding NumericalExchangeType
52 procedure :: exg_df => gwfgwfcon_df
53 procedure :: exg_ar => gwfgwfcon_ar
54 procedure :: exg_rp => gwfgwfcon_rp
55 procedure :: exg_ad => gwfgwfcon_ad
56 procedure :: exg_cf => gwfgwfcon_cf
57 procedure :: exg_fc => gwfgwfcon_fc
58 procedure :: exg_da => gwfgwfcon_da
59 procedure :: exg_cq => gwfgwfcon_cq
60 procedure :: exg_bd => gwfgwfcon_bd
61 procedure :: exg_ot => gwfgwfcon_ot
62
63 ! overriding 'protected'
64 procedure :: validateconnection
65
66 ! local stuff
67 procedure, private :: cfg_dist_vars
68 procedure, private :: allocatescalars
69 procedure, private :: setgridextent
70 procedure, private :: validategwfexchange
71 procedure, private :: setflowtoexchange
72 procedure, private :: setflowtomodel
73 procedure, private :: setnpfedgeprops
74
76
77contains
78
79 !> @brief Basic construction of the connection
80 !<
81 subroutine gwfgwfconnection_ctor(this, model, gwfEx)
84 class(gwfgwfconnectiontype) :: this !< the connection
85 class(numericalmodeltype), pointer :: model !< the model owning this connection,
86 !! this must of course be a GwfModelType
87 class(disconnexchangetype), pointer :: gwfEx !< the exchange the interface model is created for
88 ! local
89 character(len=LINELENGTH) :: fname
90 character(len=LENCOMPONENTNAME) :: name
91 class(*), pointer :: objPtr
92 logical(LGP) :: write_ifmodel_listfile = .false.
93
94 objptr => model
95 this%gwfModel => castasgwfmodel(objptr)
96 objptr => gwfex
97 this%gwfExchange => castasgwfexchange(objptr)
98
99 if (gwfex%v_model1%is_local .and. gwfex%v_model2%is_local) then
100 this%owns_exchange = (gwfex%v_model1 == model)
101 else
102 this%owns_exchange = .true.
103 end if
104
105 if (gwfex%v_model1 == model) then
106 write (name, '(a,i0)') 'GWFCON1_', gwfex%id
107 else
108 write (name, '(a,i0)') 'GWFCON2_', gwfex%id
109 end if
110
111 ! .lst file for interface model
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 ', &
117 trim(gwfex%name)
118 end if
119
120 ! first call base constructor
121 call this%SpatialModelConnectionType%spatialConnection_ctor(model, &
122 gwfex, &
123 name)
124
125 call this%allocateScalars()
126
127 this%typename = 'GWF-GWF'
128
129 ! determine the required size of the interface grid
130 call this%setGridExtent()
131
132 allocate (this%gwfInterfaceModel)
133 this%interface_model => this%gwfInterfaceModel
134
135 end subroutine gwfgwfconnection_ctor
136
137 !> @brief Define the connection
138 !!
139 !! This sets up the GridConnection (for creating the
140 !! interface grid), creates and defines the interface
141 !< model
142 subroutine gwfgwfcon_df(this)
143 class(gwfgwfconnectiontype) :: this !< this connection
144 ! local
145 character(len=LENCOMPONENTNAME) :: imName !< the interface model's name
146 integer(I4B) :: i
147
148 ! this sets up the GridConnection
149 call this%spatialcon_df()
150
151 ! Now grid conn is defined, we create the interface model
152 ! here, and the remainder of this routine is define.
153 ! we basically follow the logic that is present in sln_df()
154 if (this%prim_exchange%v_model1 == this%owner) then
155 write (imname, '(a,i0)') 'GWFIM1_', this%gwfExchange%id
156 else
157 write (imname, '(a,i0)') 'GWFIM2_', this%gwfExchange%id
158 end if
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()
165
166 ! Take these settings from the owning model
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
173
174 call this%cfg_dist_vars()
175
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
180 end if
181
182 ! set defaults
183 do i = 1, size(this%gwfInterfaceModel%npf%angle1)
184 this%gwfInterfaceModel%npf%angle1(i) = 0.0_dp
185 end do
186 do i = 1, size(this%gwfInterfaceModel%npf%angle2)
187 this%gwfInterfaceModel%npf%angle2(i) = 0.0_dp
188 end do
189 do i = 1, size(this%gwfInterfaceModel%npf%angle3)
190 this%gwfInterfaceModel%npf%angle3(i) = 0.0_dp
191 end do
192
193 ! point X, RHS, IBOUND to connection
194 call this%spatialcon_setmodelptrs()
195
196 ! connect interface model to spatial connection
197 call this%spatialcon_connect()
198
199 end subroutine gwfgwfcon_df
200
201 !> @brief Configure distributed variables for this interface model
202 !<
203 subroutine cfg_dist_vars(this)
204 class(gwfgwfconnectiontype) :: this !< the connection
205
206 call this%cfg_dv('X', '', sync_nds, &
208 call this%cfg_dv('IBOUND', '', sync_nds, &
210 call this%cfg_dv('XOLD', '', sync_nds, (/stg_bfr_exg_ad, stg_bfr_exg_cf/))
211 call this%cfg_dv('ICELLTYPE', 'NPF', sync_nds, (/stg_bfr_con_ar/))
212 call this%cfg_dv('K11', 'NPF', sync_nds, (/stg_bfr_con_ar/))
213 call this%cfg_dv('K22', 'NPF', sync_nds, (/stg_bfr_con_ar/))
214 call this%cfg_dv('K33', 'NPF', sync_nds, (/stg_bfr_con_ar/))
215 if (this%gwfInterfaceModel%npf%iangle1 == 1) then
216 call this%cfg_dv('ANGLE1', 'NPF', sync_nds, (/stg_bfr_con_ar/))
217 end if
218 if (this%gwfInterfaceModel%npf%iangle2 == 1) then
219 call this%cfg_dv('ANGLE2', 'NPF', sync_nds, (/stg_bfr_con_ar/))
220 end if
221 if (this%gwfInterfaceModel%npf%iangle3 == 1) then
222 call this%cfg_dv('ANGLE3', 'NPF', sync_nds, (/stg_bfr_con_ar/))
223 end if
224 if (this%gwfInterfaceModel%npf%iwetdry == 1) then
225 call this%cfg_dv('WETDRY', 'NPF', sync_nds, (/stg_bfr_con_ar/))
226 end if
227 call this%cfg_dv('TOP', 'DIS', sync_nds, (/stg_bfr_con_ar/))
228 call this%cfg_dv('BOT', 'DIS', sync_nds, (/stg_bfr_con_ar/))
229 call this%cfg_dv('AREA', 'DIS', sync_nds, (/stg_bfr_con_ar/))
230 if (this%gwfInterfaceModel%inbuy > 0) then
231 call this%cfg_dv('DENSE', 'BUY', sync_nds, (/stg_bfr_exg_cf/))
232 end if
233
234 end subroutine cfg_dist_vars
235
236 !> @brief Set the required size of the interface grid from
237 !< the configuration
238 subroutine setgridextent(this)
239 class(gwfgwfconnectiontype) :: this !< the connection
240 ! local
241
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
247 end if
248 end if
249
250 end subroutine setgridextent
251
252 !> @brief allocation of scalars in the connection
253 !<
254 subroutine allocatescalars(this)
256 class(gwfgwfconnectiontype) :: this !< the connection
257 ! local
258
259 call mem_allocate(this%iXt3dOnExchange, 'IXT3DEXG', this%memoryPath)
260
261 end subroutine allocatescalars
262
263 !> @brief Allocate and read the connection
264 !<
265 subroutine gwfgwfcon_ar(this)
267 class(gwfgwfconnectiontype) :: this !< this connection
268 ! local
269
270 ! check if we can construct an interface model
271 ! NB: only makes sense after the models' allocate&read have been
272 ! called, which is why we do it here
273 call this%validateConnection()
274
275 ! allocate and read base
276 call this%spatialcon_ar()
277
278 ! ... and now the interface model
279 call this%gwfInterfaceModel%model_ar()
280
281 ! AR the movers and obs through the exchange
282 if (this%owns_exchange) then
283 if (this%gwfExchange%inmvr > 0) then
284 call this%gwfExchange%mvr%mvr_ar()
285 end if
286 if (this%gwfExchange%inobs > 0) then
287 call this%gwfExchange%obs%obs_ar()
288 end if
289 end if
290
291 end subroutine gwfgwfcon_ar
292
293 !> @brief Read time varying data when required
294 !<
295 subroutine gwfgwfcon_rp(this)
296 class(gwfgwfconnectiontype) :: this !< this connection
297
298 ! Call exchange rp routines
299 if (this%owns_exchange) then
300 call this%gwfExchange%exg_rp()
301 end if
302 end subroutine gwfgwfcon_rp
303
304 !> @brief Advance this connection
305 !<
306 subroutine gwfgwfcon_ad(this)
307 class(gwfgwfconnectiontype) :: this !< this connection
308
309 ! this triggers the BUY density calculation
310 !if (this%gwfInterfaceModel%inbuy > 0) call this%gwfInterfaceModel%buy%buy_ad()
311
312 if (this%owns_exchange) then
313 call this%gwfExchange%exg_ad()
314 end if
315
316 end subroutine gwfgwfcon_ad
317
318 subroutine gwfgwfcon_cf(this, kiter)
319 class(gwfgwfconnectiontype) :: this !< this connection
320 integer(I4B), intent(in) :: kiter !< the iteration counter
321
322 call this%SpatialModelConnectionType%spatialcon_cf(kiter)
323
324 ! CF the movers through the exchange
325 if (this%owns_exchange) then
326 if (this%gwfExchange%inmvr > 0) then
327 call this%gwfExchange%mvr%xmvr_cf()
328 end if
329 end if
330
331 end subroutine gwfgwfcon_cf
332
333 !> @brief Write the calculated coefficients into the global
334 !< system matrix and the rhs
335 subroutine gwfgwfcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
336 class(gwfgwfconnectiontype) :: this !< this connection
337 integer(I4B), intent(in) :: kiter !< the iteration counter
338 class(matrixbasetype), pointer :: matrix_sln !< global system matrix coefficients
339 real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side
340 integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag
341 ! local
342
343 call this%SpatialModelConnectionType%spatialcon_fc( &
344 kiter, matrix_sln, rhs_sln, inwtflag)
345
346 ! FC the movers through the exchange; we cannot call
347 ! exg_fc() directly because it calculates matrix terms
348 if (this%owns_exchange) then
349 if (this%gwfExchange%inmvr > 0) then
350 call this%gwfExchange%mvr%mvr_fc()
351 end if
352 end if
353
354 end subroutine gwfgwfcon_fc
355
356 !> @brief Validate this connection
357 !! This is called before proceeding to construct
358 !! the interface model
359 !<
360 subroutine validateconnection(this)
361 use simvariablesmodule, only: errmsg
362 use simmodule, only: count_errors
363 class(gwfgwfconnectiontype) :: this !< this connection
364 ! local
365
366 ! base validation (geometry/spatial)
367 call this%SpatialModelConnectionType%validateConnection()
368 call this%validateGwfExchange()
369
370 ! abort on errors
371 if (count_errors() > 0) then
372 write (errmsg, '(a)') 'Errors occurred while processing exchange(s)'
373 call ustop(errmsg)
374 end if
375
376 end subroutine validateconnection
377
378 !> @brief Validate the exchange, intercepting those
379 !! cases where two models have to be connected with an interface
380 !! model, where the individual configurations don't allow this
381 !!
382 !! Stops with error message on config mismatch
383 !<
384 subroutine validategwfexchange(this)
386 use simmodule, only: store_error
387 use gwfnpfmodule, only: gwfnpftype
388 class(gwfgwfconnectiontype) :: this !< this connection
389 ! local
390 class(gwfexchangetype), pointer :: gwfEx
391 class(*), pointer :: modelPtr
392 class(gwfmodeltype), pointer :: gwfModel1
393 class(gwfmodeltype), pointer :: gwfModel2
394 type(gwfbuytype), pointer :: buy1, buy2
395 logical(LGP) :: compatible
396
397 gwfex => this%gwfExchange
398
399 ! GNC not allowed
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)
403 call store_error(errmsg)
404 end if
405 if (gwfex%ingnc /= 0 .and. simulation_mode == 'PARALLEL') then
406 write (errmsg, '(2a)') 'Ghost node correction not supported '// &
407 'in parallel run for exchange ', trim(gwfex%name)
408 call store_error(errmsg)
409 end if
410
411 ! we cannot validate the remainder (yet) in parallel mode
412 if (.not. gwfex%v_model1%is_local) return
413 if (.not. gwfex%v_model2%is_local) return
414
415 modelptr => this%gwfExchange%model1
416 gwfmodel1 => castasgwfmodel(modelptr)
417 modelptr => this%gwfExchange%model2
418 gwfmodel2 => castasgwfmodel(modelptr)
419
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 ', &
425 trim(gwfex%name)
426 call store_error(errmsg)
427
428 end if
429
430 if (gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy > 0) then
431 ! does not work with XT3D
432 if (this%iXt3dOnExchange > 0) then
433 write (errmsg, '(2a)') 'Connecting models with BUY package not '// &
434 'allowed with XT3D enabled on exchange ', &
435 trim(gwfex%name)
436 call store_error(errmsg)
437 end if
438
439 ! check compatibility of buoyancy
440 compatible = .true.
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
449 compatible = .false.
450 end if
451
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 ', &
458 trim(gwfex%name)
459 call store_error(errmsg)
460 end if
461
462 end if
463
464 end subroutine validategwfexchange
465
466 !> @brief Deallocate all resources
467 !<
468 subroutine gwfgwfcon_da(this)
469 use kindmodule, only: lgp
470 class(gwfgwfconnectiontype) :: this !< this connection
471 ! local
472 logical(LGP) :: isOpen
473
474 ! scalars
475 call mem_deallocate(this%iXt3dOnExchange)
476
477 call this%gwfInterfaceModel%model_da()
478 deallocate (this%gwfInterfaceModel)
479
480 call this%spatialcon_da()
481
482 inquire (this%iout, opened=isopen)
483 if (isopen) then
484 close (this%iout)
485 end if
486
487 ! we need to deallocate the baseexchange we own:
488 if (this%owns_exchange) then
489 call this%gwfExchange%exg_da()
490 end if
491
492 end subroutine gwfgwfcon_da
493
494 !> @brief Calculate intra-cell flows
495 !! The calculation will be dispatched to the interface
496 !! model, and then mapped back to real-world cell ids.
497 !<
498 subroutine gwfgwfcon_cq(this, icnvg, isuppress_output, isolnid)
499 class(gwfgwfconnectiontype) :: this !< this connection
500 integer(I4B), intent(inout) :: icnvg !< convergence flag
501 integer(I4B), intent(in) :: isuppress_output !< suppress output when =1
502 integer(I4B), intent(in) :: isolnid !< solution id
503
504 call this%gwfInterfaceModel%model_cq(icnvg, isuppress_output)
505
506 call this%setFlowToExchange()
507
508 call this%setFlowToModel()
509
510 !cdl Could we allow GwfExchange to do this instead, using
511 ! simvals?
512 ! if needed, we add the edge properties to the model's NPF
513 ! package for its spdis calculation:
514 if (this%gwfModel%npf%icalcspdis == 1) then
515 call this%setNpfEdgeProps()
516 end if
517
518 ! Add exchange flows to each model flowja diagonal. This used
519 ! to be done in setNpfEdgeProps, but there was a sign issue
520 ! and flowja was only updated if icalcspdis was 1 (it should
521 ! always be updated.
522 if (this%owns_exchange) then
523 call this%gwfExchange%gwf_gwf_add_to_flowja()
524 end if
525
526 end subroutine gwfgwfcon_cq
527
528 !> @brief Set the flows (flowja from interface model) to the
529 !< simvals in the exchange, leaving the budget calcution in there
530 subroutine setflowtoexchange(this)
532 class(gwfgwfconnectiontype) :: this !< this connection
533 ! local
534 integer(I4B) :: i
535 class(gwfexchangetype), pointer :: gwfEx
536 type(indexmapsgntype), pointer :: map
537
538 if (this%owns_exchange) then
539 gwfex => this%gwfExchange
540 map => this%interface_map%exchange_maps(this%interface_map%prim_exg_idx)
541
542 ! use (half of) the exchange map in reverse:
543 do i = 1, size(map%src_idx)
544 if (map%sign(i) < 0) cycle ! simvals is defined from exg%m1 => exg%m2
545 gwfex%simvals(map%src_idx(i)) = &
546 this%gwfInterfaceModel%flowja(map%tgt_idx(i))
547 end do
548 end if
549
550 end subroutine setflowtoexchange
551
552 !> @brief Set the flows (flowja from the interface model) to
553 !< to the model, update the budget
554 subroutine setflowtomodel(this)
555 class(gwfgwfconnectiontype) :: this !< this connection
556 ! local
557 integer(I4B) :: n, m, ipos, iposLoc
558 integer(I4B) :: nLoc, mLoc
559 type(connectionstype), pointer :: imCon !< interface model connections
560 type(globalcelltype), dimension(:), pointer :: toGlobal !< map interface index to global cell
561
562 ! for readability
563 imcon => this%gwfInterfaceModel%dis%con
564 toglobal => this%ig_builder%idxToGlobal
565
566 do n = 1, this%neq
567 if (.not. toglobal(n)%v_model == this%owner) then
568 ! only add flows to own model
569 cycle
570 end if
571
572 nloc = toglobal(n)%index
573
574 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
575 if (imcon%mask(ipos) < 1) cycle ! skip this connection, it's masked so not determined by us
576
577 m = imcon%ja(ipos)
578 mloc = toglobal(m)%index
579 if (toglobal(m)%v_model == this%owner) then
580
581 ! internal, need to set flowja for n-m
582 iposloc = getcsrindex(nloc, mloc, this%gwfModel%ia, this%gwfModel%ja)
583
584 ! update flowja with correct value
585 this%gwfModel%flowja(iposloc) = this%gwfInterfaceModel%flowja(ipos)
586
587 end if
588 end do
589 end do
590
591 end subroutine setflowtomodel
592
593 !> @brief Set flowja as edge properties in the model,
594 !< so it can be used for e.g. specific discharge calculation
595 subroutine setnpfedgeprops(this)
596 class(gwfgwfconnectiontype) :: this !< this connection
597 ! local
598 integer(I4B) :: n, m, ipos, isym
599 integer(I4B) :: nLoc, mLoc
600 integer(I4B) :: ihc
601 real(DP) :: rrate
602 real(DP) :: area
603 real(DP) :: satThick
604 real(DP) :: nx, ny, nz
605 real(DP) :: cx, cy, cz
606 real(DP) :: conLen
607 real(DP) :: dist
608 real(DP) :: cl
609 logical :: nozee
610 type(connectionstype), pointer :: imCon !< interface model connections
611 class(gwfnpftype), pointer :: imNpf !< interface model npf package
612 class(disbasetype), pointer :: imDis !< interface model discretization
613 type(globalcelltype), dimension(:), pointer :: toGlobal !< map interface index to global cell
614
615 ! for readability
616 imdis => this%gwfInterfaceModel%dis
617 imcon => this%gwfInterfaceModel%dis%con
618 imnpf => this%gwfInterfaceModel%npf
619 toglobal => this%ig_builder%idxToGlobal
620
621 nozee = .false.
622 if (imnpf%ixt3d > 0) then
623 nozee = imnpf%xt3d%nozee
624 end if
625
626 ! loop over flowja in the interface model and set edge properties
627 ! for flows crossing the boundary, and set flowja for internal
628 ! flows affected by the connection.
629 do n = 1, this%neq
630 if (.not. toglobal(n)%v_model == this%owner) then
631 ! only add flows to own model
632 cycle
633 end if
634
635 nloc = toglobal(n)%index
636
637 do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
638 if (imcon%mask(ipos) < 1) then
639 ! skip this connection, it's masked so not determined by us
640 cycle
641 end if
642
643 m = imcon%ja(ipos)
644 mloc = toglobal(m)%index
645
646 if (.not. toglobal(m)%v_model == this%owner) then
647 ! boundary connection, set edge properties
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)
653
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)
657
658 if (ihc == 0) then
659 ! check if n is below m
660 if (nz > 0) rrate = -rrate
661 else
662 area = area * satthick
663 end if
664
665 cl = imcon%cl1(isym)
666 if (m < n) then
667 cl = imcon%cl2(isym)
668 end if
669 dist = conlen * cl / (imcon%cl1(isym) + imcon%cl2(isym))
670 call this%gwfModel%npf%set_edge_properties(nloc, ihc, rrate, area, &
671 nx, ny, dist)
672 end if
673 end do
674 end do
675
676 end subroutine setnpfedgeprops
677
678 !> @brief Calculate the budget terms for this connection, this is
679 !! dispatched to the GWF-GWF exchange
680 subroutine gwfgwfcon_bd(this, icnvg, isuppress_output, isolnid)
681 class(gwfgwfconnectiontype) :: this !< this connection
682 integer(I4B), intent(inout) :: icnvg !< convergence flag
683 integer(I4B), intent(in) :: isuppress_output !< suppress output when =1
684 integer(I4B), intent(in) :: isolnid !< solution id
685 ! local
686
687 ! call exchange budget routine, also calls bd
688 ! for movers.
689 if (this%owns_exchange) then
690 call this%gwfExchange%exg_bd(icnvg, isuppress_output, isolnid)
691 end if
692
693 end subroutine gwfgwfcon_bd
694
695 !> @brief Write output for exchange (and calls
696 !< save on the budget)
697 subroutine gwfgwfcon_ot(this)
698 class(gwfgwfconnectiontype) :: this !< this connection
699 ! local
700
701 ! Call exg_ot() here as it handles all output processing
702 ! based on gwfExchange%simvals(:), which was correctly
703 ! filled from gwfgwfcon
704 if (this%owns_exchange) then
705 call this%gwfExchange%exg_ot()
706 end if
707
708 end subroutine gwfgwfcon_ot
709
710 !> @brief Cast to GwfGwfConnectionType
711 !<
712 function castasgwfgwfconnection(obj) result(res)
713 implicit none
714 class(*), pointer, intent(inout) :: obj !< object to be cast
715 class(gwfgwfconnectiontype), pointer :: res !< the GwfGwfConnection
716
717 res => null()
718 if (.not. associated(obj)) return
719
720 select type (obj)
721 class is (gwfgwfconnectiontype)
722 res => obj
723 end select
724 end function castasgwfgwfconnection
725
726end module gwfgwfconnectionmodule
This module contains simulation constants.
Definition Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition Constants.f90:45
integer(i4b), parameter lencomponentname
maximum length of a component name
Definition Constants.f90:18
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition Constants.f90:17
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
Definition Constants.f90:65
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition Constants.f90:27
real(dp), parameter done
real constant 1
Definition Constants.f90:76
integer(i4b) function, public getcsrindex(i, j, ia, ja)
Return index for element i,j in CSR storage,.
Definition CsrUtils.f90:13
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 gwfgwfconnection_ctor(this, model, gwfex)
Basic construction of the connection.
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 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.
Definition gwf.f90:1368
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
This module defines variable data types.
Definition kind.f90:8
This module contains simulation methods.
Definition Sim.f90:10
subroutine, public ustop(stopmess, ioutlocal)
Stop the simulation.
Definition Sim.f90:313
subroutine, public store_error(msg, terminate)
Store an error message.
Definition Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition Sim.f90:59
integer(i4b), parameter, public stg_bfr_exg_ad
before exchange advance (per solution)
Definition SimStages.f90:21
integer(i4b), parameter, public stg_bfr_exg_cf
before exchange calculate (per solution)
Definition SimStages.f90:22
integer(i4b), parameter, public stg_bfr_con_ar
before connection allocate read
Definition SimStages.f90:17
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....