MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
GwfGwfConnection.f90
Go to the documentation of this file.
2  use kindmodule, only: i4b, dp, lgp
3  use constantsmodule, only: dzero, done, dem6, lenvarname, &
5  use csrutilsmodule, only: getcsrindex
6  use sparsemodule, only: sparsematrix
8  use simmodule, only: ustop
16  use gwfnpfmodule, only: gwfnpftype
17  use gwfbuymodule, only: gwfbuytype
18  use basedismodule, only: disbasetype
22  use simstagesmodule
24 
25  implicit none
26  private
27 
28  public :: castasgwfgwfconnection
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
48  procedure :: gwfgwfconnection_ctor
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 
75  end type gwfgwfconnectiontype
76 
77 contains
78 
79  !> @brief Basic construction of the connection
80  !<
81  subroutine gwfgwfconnection_ctor(this, model, gwfEx)
83  use inputoutputmodule, only: openfile
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)
531  use indexmapmodule
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 
726 end 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
Definition: Constants.f90:109
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 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.
Definition: exg-gwfgwf.f90:10
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
Definition: gwf.f90:1
class(gwfmodeltype) function, pointer, public castasgwfmodel(model)
Cast to GWF model.
Definition: gwf.f90:1333
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
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:312
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.
Definition: SimVariables.f90:9
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.
Definition: exg-gwfgwf.f90:47
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....