MODFLOW 6  version 6.7.0.dev0
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  call this%gwfInterfaceModel%model_df()
164 
165  ! Take these settings from the owning model
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
172 
173  call this%cfg_dist_vars()
174 
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
179  end if
180 
181  ! set defaults
182  do i = 1, size(this%gwfInterfaceModel%npf%angle1)
183  this%gwfInterfaceModel%npf%angle1 = 0.0_dp
184  end do
185  do i = 1, size(this%gwfInterfaceModel%npf%angle2)
186  this%gwfInterfaceModel%npf%angle2 = 0.0_dp
187  end do
188  do i = 1, size(this%gwfInterfaceModel%npf%angle3)
189  this%gwfInterfaceModel%npf%angle3 = 0.0_dp
190  end do
191 
192  ! point X, RHS, IBOUND to connection
193  call this%spatialcon_setmodelptrs()
194 
195  ! connect interface model to spatial connection
196  call this%spatialcon_connect()
197 
198  end subroutine gwfgwfcon_df
199 
200  !> @brief Configure distributed variables for this interface model
201  !<
202  subroutine cfg_dist_vars(this)
203  class(gwfgwfconnectiontype) :: this !< the connection
204 
205  call this%cfg_dv('X', '', sync_nds, &
207  call this%cfg_dv('IBOUND', '', sync_nds, &
209  call this%cfg_dv('XOLD', '', sync_nds, (/stg_bfr_exg_ad, stg_bfr_exg_cf/))
210  call this%cfg_dv('ICELLTYPE', 'NPF', sync_nds, (/stg_bfr_con_ar/))
211  call this%cfg_dv('K11', 'NPF', sync_nds, (/stg_bfr_con_ar/))
212  call this%cfg_dv('K22', 'NPF', sync_nds, (/stg_bfr_con_ar/))
213  call this%cfg_dv('K33', 'NPF', sync_nds, (/stg_bfr_con_ar/))
214  if (this%gwfInterfaceModel%npf%iangle1 == 1) then
215  call this%cfg_dv('ANGLE1', 'NPF', sync_nds, (/stg_bfr_con_ar/))
216  end if
217  if (this%gwfInterfaceModel%npf%iangle2 == 1) then
218  call this%cfg_dv('ANGLE2', 'NPF', sync_nds, (/stg_bfr_con_ar/))
219  end if
220  if (this%gwfInterfaceModel%npf%iangle3 == 1) then
221  call this%cfg_dv('ANGLE3', 'NPF', sync_nds, (/stg_bfr_con_ar/))
222  end if
223  if (this%gwfInterfaceModel%npf%iwetdry == 1) then
224  call this%cfg_dv('WETDRY', 'NPF', sync_nds, (/stg_bfr_con_ar/))
225  end if
226  call this%cfg_dv('TOP', 'DIS', sync_nds, (/stg_bfr_con_ar/))
227  call this%cfg_dv('BOT', 'DIS', sync_nds, (/stg_bfr_con_ar/))
228  call this%cfg_dv('AREA', 'DIS', sync_nds, (/stg_bfr_con_ar/))
229  if (this%gwfInterfaceModel%inbuy > 0) then
230  call this%cfg_dv('DENSE', 'BUY', sync_nds, (/stg_bfr_exg_cf/))
231  end if
232 
233  end subroutine cfg_dist_vars
234 
235  !> @brief Set the required size of the interface grid from
236  !< the configuration
237  subroutine setgridextent(this)
238  class(gwfgwfconnectiontype) :: this !< the connection
239  ! local
240 
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
246  end if
247  end if
248 
249  end subroutine setgridextent
250 
251  !> @brief allocation of scalars in the connection
252  !<
253  subroutine allocatescalars(this)
255  class(gwfgwfconnectiontype) :: this !< the connection
256  ! local
257 
258  call mem_allocate(this%iXt3dOnExchange, 'IXT3DEXG', this%memoryPath)
259 
260  end subroutine allocatescalars
261 
262  !> @brief Allocate and read the connection
263  !<
264  subroutine gwfgwfcon_ar(this)
266  class(gwfgwfconnectiontype) :: this !< this connection
267  ! local
268 
269  ! check if we can construct an interface model
270  ! NB: only makes sense after the models' allocate&read have been
271  ! called, which is why we do it here
272  call this%validateConnection()
273 
274  ! allocate and read base
275  call this%spatialcon_ar()
276 
277  ! ... and now the interface model
278  call this%gwfInterfaceModel%model_ar()
279 
280  ! AR the movers and obs through the exchange
281  if (this%owns_exchange) then
282  if (this%gwfExchange%inmvr > 0) then
283  call this%gwfExchange%mvr%mvr_ar()
284  end if
285  if (this%gwfExchange%inobs > 0) then
286  call this%gwfExchange%obs%obs_ar()
287  end if
288  end if
289 
290  end subroutine gwfgwfcon_ar
291 
292  !> @brief Read time varying data when required
293  !<
294  subroutine gwfgwfcon_rp(this)
295  class(gwfgwfconnectiontype) :: this !< this connection
296 
297  ! Call exchange rp routines
298  if (this%owns_exchange) then
299  call this%gwfExchange%exg_rp()
300  end if
301  end subroutine gwfgwfcon_rp
302 
303  !> @brief Advance this connection
304  !<
305  subroutine gwfgwfcon_ad(this)
306  class(gwfgwfconnectiontype) :: this !< this connection
307 
308  ! this triggers the BUY density calculation
309  !if (this%gwfInterfaceModel%inbuy > 0) call this%gwfInterfaceModel%buy%buy_ad()
310 
311  if (this%owns_exchange) then
312  call this%gwfExchange%exg_ad()
313  end if
314 
315  end subroutine gwfgwfcon_ad
316 
317  subroutine gwfgwfcon_cf(this, kiter)
318  class(gwfgwfconnectiontype) :: this !< this connection
319  integer(I4B), intent(in) :: kiter !< the iteration counter
320 
321  call this%SpatialModelConnectionType%spatialcon_cf(kiter)
322 
323  ! CF the movers through the exchange
324  if (this%owns_exchange) then
325  if (this%gwfExchange%inmvr > 0) then
326  call this%gwfExchange%mvr%xmvr_cf()
327  end if
328  end if
329 
330  end subroutine gwfgwfcon_cf
331 
332  !> @brief Write the calculated coefficients into the global
333  !< system matrix and the rhs
334  subroutine gwfgwfcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
335  class(gwfgwfconnectiontype) :: this !< this connection
336  integer(I4B), intent(in) :: kiter !< the iteration counter
337  class(matrixbasetype), pointer :: matrix_sln !< global system matrix coefficients
338  real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side
339  integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag
340  ! local
341 
342  call this%SpatialModelConnectionType%spatialcon_fc( &
343  kiter, matrix_sln, rhs_sln, inwtflag)
344 
345  ! FC the movers through the exchange; we cannot call
346  ! exg_fc() directly because it calculates matrix terms
347  if (this%owns_exchange) then
348  if (this%gwfExchange%inmvr > 0) then
349  call this%gwfExchange%mvr%mvr_fc()
350  end if
351  end if
352 
353  end subroutine gwfgwfcon_fc
354 
355  !> @brief Validate this connection
356  !! This is called before proceeding to construct
357  !! the interface model
358  !<
359  subroutine validateconnection(this)
360  use simvariablesmodule, only: errmsg
361  use simmodule, only: count_errors
362  class(gwfgwfconnectiontype) :: this !< this connection
363  ! local
364 
365  ! base validation (geometry/spatial)
366  call this%SpatialModelConnectionType%validateConnection()
367  call this%validateGwfExchange()
368 
369  ! abort on errors
370  if (count_errors() > 0) then
371  write (errmsg, '(a)') 'Errors occurred while processing exchange(s)'
372  call ustop()
373  end if
374 
375  end subroutine validateconnection
376 
377  !> @brief Validate the exchange, intercepting those
378  !! cases where two models have to be connected with an interface
379  !! model, where the individual configurations don't allow this
380  !!
381  !! Stops with error message on config mismatch
382  !<
383  subroutine validategwfexchange(this)
385  use simmodule, only: store_error
386  use gwfnpfmodule, only: gwfnpftype
387  class(gwfgwfconnectiontype) :: this !< this connection
388  ! local
389  class(gwfexchangetype), pointer :: gwfEx
390  class(*), pointer :: modelPtr
391  class(gwfmodeltype), pointer :: gwfModel1
392  class(gwfmodeltype), pointer :: gwfModel2
393  type(gwfbuytype), pointer :: buy1, buy2
394  logical(LGP) :: compatible
395 
396  gwfex => this%gwfExchange
397 
398  ! GNC not allowed
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)
402  call store_error(errmsg)
403  end if
404  if (gwfex%ingnc /= 0 .and. simulation_mode == 'PARALLEL') then
405  write (errmsg, '(2a)') 'Ghost node correction not supported '// &
406  'in parallel run for exchange ', trim(gwfex%name)
407  call store_error(errmsg)
408  end if
409 
410  ! we cannot validate the remainder (yet) in parallel mode
411  if (.not. gwfex%v_model1%is_local) return
412  if (.not. gwfex%v_model2%is_local) return
413 
414  modelptr => this%gwfExchange%model1
415  gwfmodel1 => castasgwfmodel(modelptr)
416  modelptr => this%gwfExchange%model2
417  gwfmodel2 => castasgwfmodel(modelptr)
418 
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 ', &
424  trim(gwfex%name)
425  call store_error(errmsg)
426 
427  end if
428 
429  if (gwfmodel1%inbuy > 0 .and. gwfmodel2%inbuy > 0) then
430  ! does not work with XT3D
431  if (this%iXt3dOnExchange > 0) then
432  write (errmsg, '(2a)') 'Connecting models with BUY package not '// &
433  'allowed with XT3D enabled on exchange ', &
434  trim(gwfex%name)
435  call store_error(errmsg)
436  end if
437 
438  ! check compatibility of buoyancy
439  compatible = .true.
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
448  compatible = .false.
449  end if
450 
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 ', &
457  trim(gwfex%name)
458  call store_error(errmsg)
459  end if
460 
461  end if
462 
463  end subroutine validategwfexchange
464 
465  !> @brief Deallocate all resources
466  !<
467  subroutine gwfgwfcon_da(this)
468  use kindmodule, only: lgp
469  class(gwfgwfconnectiontype) :: this !< this connection
470  ! local
471  logical(LGP) :: isOpen
472 
473  ! scalars
474  call mem_deallocate(this%iXt3dOnExchange)
475 
476  call this%gwfInterfaceModel%model_da()
477  deallocate (this%gwfInterfaceModel)
478 
479  call this%spatialcon_da()
480 
481  inquire (this%iout, opened=isopen)
482  if (isopen) then
483  close (this%iout)
484  end if
485 
486  ! we need to deallocate the baseexchange we own:
487  if (this%owns_exchange) then
488  call this%gwfExchange%exg_da()
489  end if
490 
491  end subroutine gwfgwfcon_da
492 
493  !> @brief Calculate intra-cell flows
494  !! The calculation will be dispatched to the interface
495  !! model, and then mapped back to real-world cell ids.
496  !<
497  subroutine gwfgwfcon_cq(this, icnvg, isuppress_output, isolnid)
498  class(gwfgwfconnectiontype) :: this !< this connection
499  integer(I4B), intent(inout) :: icnvg !< convergence flag
500  integer(I4B), intent(in) :: isuppress_output !< suppress output when =1
501  integer(I4B), intent(in) :: isolnid !< solution id
502 
503  call this%gwfInterfaceModel%model_cq(icnvg, isuppress_output)
504 
505  call this%setFlowToExchange()
506 
507  call this%setFlowToModel()
508 
509  !cdl Could we allow GwfExchange to do this instead, using
510  ! simvals?
511  ! if needed, we add the edge properties to the model's NPF
512  ! package for its spdis calculation:
513  if (this%gwfModel%npf%icalcspdis == 1) then
514  call this%setNpfEdgeProps()
515  end if
516 
517  ! Add exchange flows to each model flowja diagonal. This used
518  ! to be done in setNpfEdgeProps, but there was a sign issue
519  ! and flowja was only updated if icalcspdis was 1 (it should
520  ! always be updated.
521  if (this%owns_exchange) then
522  call this%gwfExchange%gwf_gwf_add_to_flowja()
523  end if
524 
525  end subroutine gwfgwfcon_cq
526 
527  !> @brief Set the flows (flowja from interface model) to the
528  !< simvals in the exchange, leaving the budget calcution in there
529  subroutine setflowtoexchange(this)
530  use indexmapmodule
531  class(gwfgwfconnectiontype) :: this !< this connection
532  ! local
533  integer(I4B) :: i
534  class(gwfexchangetype), pointer :: gwfEx
535  type(indexmapsgntype), pointer :: map
536 
537  if (this%owns_exchange) then
538  gwfex => this%gwfExchange
539  map => this%interface_map%exchange_maps(this%interface_map%prim_exg_idx)
540 
541  ! use (half of) the exchange map in reverse:
542  do i = 1, size(map%src_idx)
543  if (map%sign(i) < 0) cycle ! simvals is defined from exg%m1 => exg%m2
544  gwfex%simvals(map%src_idx(i)) = &
545  this%gwfInterfaceModel%flowja(map%tgt_idx(i))
546  end do
547  end if
548 
549  end subroutine setflowtoexchange
550 
551  !> @brief Set the flows (flowja from the interface model) to
552  !< to the model, update the budget
553  subroutine setflowtomodel(this)
554  class(gwfgwfconnectiontype) :: this !< this connection
555  ! local
556  integer(I4B) :: n, m, ipos, iposLoc
557  integer(I4B) :: nLoc, mLoc
558  type(connectionstype), pointer :: imCon !< interface model connections
559  type(globalcelltype), dimension(:), pointer :: toGlobal !< map interface index to global cell
560 
561  ! for readability
562  imcon => this%gwfInterfaceModel%dis%con
563  toglobal => this%ig_builder%idxToGlobal
564 
565  do n = 1, this%neq
566  if (.not. toglobal(n)%v_model == this%owner) then
567  ! only add flows to own model
568  cycle
569  end if
570 
571  nloc = toglobal(n)%index
572 
573  do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
574  if (imcon%mask(ipos) < 1) cycle ! skip this connection, it's masked so not determined by us
575 
576  m = imcon%ja(ipos)
577  mloc = toglobal(m)%index
578  if (toglobal(m)%v_model == this%owner) then
579 
580  ! internal, need to set flowja for n-m
581  iposloc = getcsrindex(nloc, mloc, this%gwfModel%ia, this%gwfModel%ja)
582 
583  ! update flowja with correct value
584  this%gwfModel%flowja(iposloc) = this%gwfInterfaceModel%flowja(ipos)
585 
586  end if
587  end do
588  end do
589 
590  end subroutine setflowtomodel
591 
592  !> @brief Set flowja as edge properties in the model,
593  !< so it can be used for e.g. specific discharge calculation
594  subroutine setnpfedgeprops(this)
595  class(gwfgwfconnectiontype) :: this !< this connection
596  ! local
597  integer(I4B) :: n, m, ipos, isym
598  integer(I4B) :: nLoc, mLoc
599  integer(I4B) :: ihc
600  real(DP) :: rrate
601  real(DP) :: area
602  real(DP) :: satThick
603  real(DP) :: nx, ny, nz
604  real(DP) :: cx, cy, cz
605  real(DP) :: conLen
606  real(DP) :: dist
607  real(DP) :: cl
608  logical :: nozee
609  type(connectionstype), pointer :: imCon !< interface model connections
610  class(gwfnpftype), pointer :: imNpf !< interface model npf package
611  class(disbasetype), pointer :: imDis !< interface model discretization
612  type(globalcelltype), dimension(:), pointer :: toGlobal !< map interface index to global cell
613 
614  ! for readability
615  imdis => this%gwfInterfaceModel%dis
616  imcon => this%gwfInterfaceModel%dis%con
617  imnpf => this%gwfInterfaceModel%npf
618  toglobal => this%ig_builder%idxToGlobal
619 
620  nozee = .false.
621  if (imnpf%ixt3d > 0) then
622  nozee = imnpf%xt3d%nozee
623  end if
624 
625  ! loop over flowja in the interface model and set edge properties
626  ! for flows crossing the boundary, and set flowja for internal
627  ! flows affected by the connection.
628  do n = 1, this%neq
629  if (.not. toglobal(n)%v_model == this%owner) then
630  ! only add flows to own model
631  cycle
632  end if
633 
634  nloc = toglobal(n)%index
635 
636  do ipos = imcon%ia(n) + 1, imcon%ia(n + 1) - 1
637  if (imcon%mask(ipos) < 1) then
638  ! skip this connection, it's masked so not determined by us
639  cycle
640  end if
641 
642  m = imcon%ja(ipos)
643  mloc = toglobal(m)%index
644 
645  if (.not. toglobal(m)%v_model == this%owner) then
646  ! boundary connection, set edge properties
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)
652 
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)
656 
657  if (ihc == 0) then
658  ! check if n is below m
659  if (nz > 0) rrate = -rrate
660  else
661  area = area * satthick
662  end if
663 
664  cl = imcon%cl1(isym)
665  if (m < n) then
666  cl = imcon%cl2(isym)
667  end if
668  dist = conlen * cl / (imcon%cl1(isym) + imcon%cl2(isym))
669  call this%gwfModel%npf%set_edge_properties(nloc, ihc, rrate, area, &
670  nx, ny, dist)
671  end if
672  end do
673  end do
674 
675  end subroutine setnpfedgeprops
676 
677  !> @brief Calculate the budget terms for this connection, this is
678  !! dispatched to the GWF-GWF exchange
679  subroutine gwfgwfcon_bd(this, icnvg, isuppress_output, isolnid)
680  class(gwfgwfconnectiontype) :: this !< this connection
681  integer(I4B), intent(inout) :: icnvg !< convergence flag
682  integer(I4B), intent(in) :: isuppress_output !< suppress output when =1
683  integer(I4B), intent(in) :: isolnid !< solution id
684  ! local
685 
686  ! call exchange budget routine, also calls bd
687  ! for movers.
688  if (this%owns_exchange) then
689  call this%gwfExchange%exg_bd(icnvg, isuppress_output, isolnid)
690  end if
691 
692  end subroutine gwfgwfcon_bd
693 
694  !> @brief Write output for exchange (and calls
695  !< save on the budget)
696  subroutine gwfgwfcon_ot(this)
697  class(gwfgwfconnectiontype) :: this !< this connection
698  ! local
699 
700  ! Call exg_ot() here as it handles all output processing
701  ! based on gwfExchange%simvals(:), which was correctly
702  ! filled from gwfgwfcon
703  if (this%owns_exchange) then
704  call this%gwfExchange%exg_ot()
705  end if
706 
707  end subroutine gwfgwfcon_ot
708 
709  !> @brief Cast to GwfGwfConnectionType
710  !<
711  function castasgwfgwfconnection(obj) result(res)
712  implicit none
713  class(*), pointer, intent(inout) :: obj !< object to be cast
714  class(gwfgwfconnectiontype), pointer :: res !< the GwfGwfConnection
715 
716  res => null()
717  if (.not. associated(obj)) return
718 
719  select type (obj)
720  class is (gwfgwfconnectiontype)
721  res => obj
722  end select
723  end function castasgwfgwfconnection
724 
725 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:1332
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....