MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
SpatialModelConnection.f90
Go to the documentation of this file.
2  use kindmodule, only: i4b, dp, lgp
3  use sparsemodule, only: sparsematrix
5  use csrutilsmodule, only: getcsrindex
6  use simmodule, only: ustop
19  use listmodule, only: listtype
20  use stlvecintmodule, only: stlvecint
23 
24  implicit none
25  private
26  public :: cast_as_smc
27  public :: add_smc_to_list
28  public :: get_smc_from_list
29 
30  !> Class to manage spatial connection of a model to one
31  !! or more models of the same type. Spatial connection here
32  !! means that the model domains (spatial discretization) are
33  !! adjacent and connected via DisConnExchangeType object(s).
34  !! The connection itself is a Numerical Exchange as well,
35  !! and part of a Numerical Solution providing the amat and rhs
36  !< values for the exchange.
38 
39  class(numericalmodeltype), pointer :: owner => null() !< the model whose connection this is
40  class(numericalmodeltype), pointer :: interface_model => null() !< the interface model
41  integer(I4B), pointer :: nr_connections => null() !< total nr. of connected cells (primary)
42 
43  class(disconnexchangetype), pointer :: prim_exchange => null() !< the exchange for which the interface model is created
44  logical(LGP) :: owns_exchange !< there are two connections (in serial) for an exchange,
45  !! one of them needs to manage/own the exchange (e.g. clean up)
46  type(stlvecint), pointer :: halo_models !< models that are potentially in the halo of this interface
47  type(stlvecint), pointer :: halo_exchanges !< exchanges that are potentially part of the halo of this interface (includes primary)
48  integer(I4B), pointer :: int_stencil_depth => null() !< size of the computational stencil for the interior
49  !! default = 1, xt3d = 2, ...
50  integer(I4B), pointer :: exg_stencil_depth => null() !< size of the computational stencil at the interface
51  !! default = 1, xt3d = 2, ...
52 
53  ! The following variables are equivalent to those in Numerical Solution:
54  integer(I4B), pointer :: neq => null() !< nr. of equations in matrix system
55  class(sparsematrixtype), pointer :: matrix => null() !< system matrix for the interface
56  real(dp), dimension(:), pointer, contiguous :: rhs => null() !< rhs of interface system
57  real(dp), dimension(:), pointer, contiguous :: x => null() !< dependent variable of interface system
58  integer(I4B), dimension(:), pointer, contiguous :: active => null() !< cell status (c.f. ibound) of interface system
59 
60  ! these are not in the memory manager
61  class(gridconnectiontype), pointer :: ig_builder => null() !< facility to build the interface grid connection structure
62  integer(I4B), dimension(:), pointer :: ipos_to_sln => null() !< mapping between position in the interface matrix and the solution matrix
63  type(listtype) :: iface_dist_vars !< list with distributed variables for this interface
64  type(interfacemaptype), pointer :: interface_map => null() !< a map of the interface into models and exchanges
65 
66  contains
67 
68  ! public
69  procedure, pass(this) :: spatialconnection_ctor
70  generic :: construct => spatialconnection_ctor
71 
72  ! partly overriding NumericalExchangeType:
73  procedure :: exg_df => spatialcon_df
74  procedure :: exg_ar => spatialcon_ar
75  procedure :: exg_ac => spatialcon_ac
76  procedure :: exg_mc => spatialcon_mc
77  procedure :: exg_cf => spatialcon_cf
78  procedure :: exg_fc => spatialcon_fc
79  procedure :: exg_da => spatialcon_da
80 
81  ! protected
82  procedure, pass(this) :: spatialcon_df
83  procedure, pass(this) :: spatialcon_ar
84  procedure, pass(this) :: spatialcon_ac
85  procedure, pass(this) :: spatialcon_cf
86  procedure, pass(this) :: spatialcon_fc
87  procedure, pass(this) :: spatialcon_da
88  procedure, pass(this) :: spatialcon_setmodelptrs
89  procedure, pass(this) :: spatialcon_connect
90  procedure, pass(this) :: validateconnection
91  procedure, pass(this) :: cfg_dv
92  procedure, pass(this) :: createmodelhalo
93 
94  ! private
95  procedure, private, pass(this) :: setupgridconnection
96  procedure, private, pass(this) :: getnrofconnections
97  procedure, private, pass(this) :: allocatescalars
98  procedure, private, pass(this) :: allocatearrays
99  procedure, private, pass(this) :: createcoefficientmatrix
100  procedure, private, pass(this) :: maskownerconnections
101  procedure, private, pass(this) :: addmodelneighbors
102 
104 
105 contains ! module procedures
106 
107  !> @brief Construct the spatial connection base
108  !!
109  !! This constructor is typically called from a derived class.
110  !<
111  subroutine spatialconnection_ctor(this, model, exchange, name)
112  class(spatialmodelconnectiontype) :: this !< the connection
113  class(numericalmodeltype), intent(in), pointer :: model !< the model that owns the connection
114  class(disconnexchangetype), intent(in), pointer :: exchange !< the primary exchange from which
115  !! the connection is created
116  character(len=*), intent(in) :: name !< the connection name (for memory management mostly)
117 
118  this%name = name
119  this%memoryPath = create_mem_path(this%name)
120 
121  this%owner => model
122  this%prim_exchange => exchange
123 
124  allocate (this%ig_builder)
125  allocate (this%halo_models)
126  allocate (this%halo_exchanges)
127  allocate (this%matrix)
128  call this%allocateScalars()
129 
130  this%int_stencil_depth = 1
131  this%exg_stencil_depth = 1
132  this%nr_connections = 0
133 
134  ! this should be set in derived ctor
135  this%interface_model => null()
136 
137  end subroutine spatialconnection_ctor
138 
139  !> @brief Find all models that might participate in this interface
140  !<
141  subroutine createmodelhalo(this)
142  class(spatialmodelconnectiontype) :: this !< this connection
143 
144  call this%halo_models%init()
145  call this%halo_exchanges%init()
146 
147  call this%addModelNeighbors(this%owner%id, virtual_exchange_list, &
148  this%exg_stencil_depth, .true.)
149 
150  end subroutine createmodelhalo
151 
152  !> @brief Add neighbors and nbrs-of-nbrs to the model tree
153  !<
154  recursive subroutine addmodelneighbors(this, model_id, &
155  virtual_exchanges, &
156  depth, is_root, mask)
158  class(spatialmodelconnectiontype) :: this !< this connection
159  integer(I4B) :: model_id !< the model (id) to add neighbors for
160  type(listtype) :: virtual_exchanges !< list with all virtual exchanges
161  integer(I4B), value :: depth !< the maximal number of exchanges between
162  logical(LGP) :: is_root !< true when called for neighbor from primary exchange
163  integer(I4B), optional :: mask !< don't add this one as a neighbor
164  ! local
165  integer(I4B) :: i, n
166  class(virtualexchangetype), pointer :: v_exg
167  integer(I4B) :: neighbor_id
168  integer(I4B) :: model_mask
169  type(stlvecint) :: models_at_depth !< model ids at a certain depth, to
170  !! recurse on for nbrs-of-nbrs search
171 
172  if (.not. present(mask)) then
173  model_mask = 0
174  else
175  model_mask = mask
176  end if
177 
178  call models_at_depth%init()
179 
180  if (is_root) then
181  ! first layer in the recursive search
182  call models_at_depth%push_back_unique(model_id)
183 
184  ! fetch primary neighbor
185  if (this%prim_exchange%v_model1%id == this%owner%id) then
186  neighbor_id = this%prim_exchange%v_model2%id
187  else
188  neighbor_id = this%prim_exchange%v_model1%id
189  end if
190  ! add
191  call models_at_depth%push_back_unique(neighbor_id)
192  call this%halo_models%push_back_unique(neighbor_id)
193  call this%halo_exchanges%push_back_unique(this%prim_exchange%id)
194  else
195  ! find all direct neighbors of the model and add them,
196  ! avoiding duplicates
197  do i = 1, virtual_exchanges%Count()
198  neighbor_id = -1
199  v_exg => get_virtual_exchange_from_list(virtual_exchanges, i)
200  if (v_exg%v_model1%id == model_id) then
201  neighbor_id = v_exg%v_model2%id
202  else if (v_exg%v_model2%id == model_id) then
203  neighbor_id = v_exg%v_model1%id
204  end if
205 
206  ! check if there is a neighbor, and it is not masked
207  ! (to prevent back-and-forth connections)
208  if (neighbor_id > 0) then
209  ! check if masked
210  if (neighbor_id == model_mask) cycle
211  call models_at_depth%push_back_unique(neighbor_id)
212  call this%halo_models%push_back_unique(neighbor_id)
213  call this%halo_exchanges%push_back_unique(v_exg%id)
214  end if
215  end do
216  end if
217 
218  depth = depth - 1
219  if (depth == 0) then
220  ! and we're done with this branch
221  call models_at_depth%destroy()
222  return
223  end if
224 
225  ! now recurse on the neighbors up to the specified depth
226  do n = 1, models_at_depth%size
227  call this%addModelNeighbors(models_at_depth%at(n), virtual_exchanges, &
228  depth, .false., model_id)
229  end do
230 
231  ! we're done with the tree
232  call models_at_depth%destroy()
233 
234  end subroutine addmodelneighbors
235 
236  !> @brief Define this connection, this is where the
237  !! discretization (DISU) for the interface model is
238  !< created!
239  subroutine spatialcon_df(this)
240  class(spatialmodelconnectiontype) :: this !< this connection
241  ! local
242  integer(I4B) :: i
243  class(virtualmodeltype), pointer :: v_model
244 
245  ! create the grid connection data structure
246  this%nr_connections = this%getNrOfConnections()
247  call this%ig_builder%construct(this%owner, &
248  this%nr_connections, &
249  this%name)
250  this%ig_builder%internalStencilDepth = this%int_stencil_depth
251  this%ig_builder%exchangeStencilDepth = this%exg_stencil_depth
252  this%ig_builder%haloExchanges => this%halo_exchanges
253  do i = 1, this%halo_models%size
254  v_model => get_virtual_model(this%halo_models%at(i))
255  call this%ig_builder%addToRegionalModels(v_model)
256  end do
257  call this%setupGridConnection()
258 
259  this%neq = this%ig_builder%nrOfCells
260  call this%allocateArrays()
261 
262  end subroutine spatialcon_df
263 
264  !> @brief Allocate the connection,
265  !<
266  subroutine spatialcon_ar(this)
267  class(spatialmodelconnectiontype) :: this !< this connection
268  ! local
269  integer(I4B) :: iface_idx, glob_idx
270  class(gridconnectiontype), pointer :: gc
271 
272  ! fill mapping to global index (which can be
273  ! done now because moffset is set in sln_df)
274  gc => this%ig_builder
275  do iface_idx = 1, gc%nrOfCells
276  glob_idx = gc%idxToGlobal(iface_idx)%index + &
277  gc%idxToGlobal(iface_idx)%v_model%moffset%get()
278  gc%idxToGlobalIdx(iface_idx) = glob_idx
279  end do
280 
281  end subroutine spatialcon_ar
282 
283  !> @brief set model pointers to connection
284  !<
285  subroutine spatialcon_setmodelptrs(this)
286  class(spatialmodelconnectiontype) :: this !< this connection
287 
288  ! point x, ibound, and rhs to connection
289  this%interface_model%x => this%x
290  call mem_checkin(this%interface_model%x, 'X', &
291  this%interface_model%memoryPath, 'X', &
292  this%memoryPath)
293  this%interface_model%rhs => this%rhs
294  call mem_checkin(this%interface_model%rhs, 'RHS', &
295  this%interface_model%memoryPath, 'RHS', &
296  this%memoryPath)
297  this%interface_model%ibound => this%active
298  call mem_checkin(this%interface_model%ibound, 'IBOUND', &
299  this%interface_model%memoryPath, 'IBOUND', &
300  this%memoryPath)
301 
302  end subroutine spatialcon_setmodelptrs
303 
304  !> @brief map interface model connections to our sparse matrix,
305  !< analogously to what happens in sln_connect.
306  subroutine spatialcon_connect(this)
307  class(spatialmodelconnectiontype) :: this !< this connection
308  ! local
309  type(sparsematrix) :: sparse
310  class(matrixbasetype), pointer :: matrix_base
311 
312  call sparse%init(this%neq, this%neq, 7)
313  call this%interface_model%model_ac(sparse)
314 
315  ! create amat from sparse
316  call this%createCoefficientMatrix(sparse)
317  call sparse%destroy()
318 
319  ! map connections
320  matrix_base => this%matrix
321  call this%interface_model%model_mc(matrix_base)
322  call this%maskOwnerConnections()
323 
324  end subroutine spatialcon_connect
325 
326  !> @brief Mask the owner's connections
327  !!
328  !! Determine which connections are handled by the interface model
329  !! (using the connections object in its discretization) and
330  !< set their mask to zero for the owning model.
331  subroutine maskownerconnections(this)
332  use csrutilsmodule, only: getcsrindex
333  class(spatialmodelconnectiontype) :: this !< the connection
334  ! local
335  integer(I4B) :: ipos, n, m, nloc, mloc, csr_idx
336  type(connectionstype), pointer :: conn
337 
338  ! set the mask on connections that are calculated by the interface model
339  conn => this%interface_model%dis%con
340  do n = 1, conn%nodes
341  ! only for connections internal to the owning model
342  if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then
343  cycle
344  end if
345  nloc = this%ig_builder%idxToGlobal(n)%index
346 
347  do ipos = conn%ia(n) + 1, conn%ia(n + 1) - 1
348  m = conn%ja(ipos)
349  if (.not. this%ig_builder%idxToGlobal(m)%v_model == this%owner) then
350  cycle
351  end if
352  mloc = this%ig_builder%idxToGlobal(m)%index
353 
354  if (conn%mask(ipos) > 0) then
355  ! calculated by interface model, set local model's mask to zero
356  csr_idx = getcsrindex(nloc, mloc, this%owner%ia, this%owner%ja)
357  if (csr_idx == -1) then
358  ! this can only happen with periodic boundary conditions,
359  ! then there is no need to set the mask
360  if (this%ig_builder%isPeriodic(nloc, mloc)) cycle
361 
362  write (*, *) 'Error: cannot find cell connection in global system'
363  call ustop()
364  end if
365 
366  if (this%owner%dis%con%mask(csr_idx) > 0) then
367  call this%owner%dis%con%set_mask(csr_idx, 0)
368  else
369  ! edge case, this connection is already being calculated
370  ! so we ignore it here. This can happen in the overlap
371  ! between two different exchanges when a larger stencil
372  ! (XT3D) is applied.
373  call conn%set_mask(ipos, 0)
374  end if
375  end if
376  end do
377  end do
378 
379  end subroutine maskownerconnections
380 
381  !> @brief Add connections, handled by the interface model,
382  !< to the global system's sparse
383  subroutine spatialcon_ac(this, sparse)
384  class(spatialmodelconnectiontype) :: this !< this connection
385  type(sparsematrix), intent(inout) :: sparse !< sparse matrix to store the connections
386  ! local
387  integer(I4B) :: n, m, ipos
388  integer(I4B) :: icol_start, icol_end
389  integer(I4B) :: nglo, mglo
390 
391  do n = 1, this%neq
392  if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then
393  ! only add connections for own model to global matrix
394  cycle
395  end if
396 
397  nglo = this%ig_builder%idxToGlobal(n)%index + &
398  this%ig_builder%idxToGlobal(n)%v_model%moffset%get()
399 
400  icol_start = this%matrix%get_first_col_pos(n)
401  icol_end = this%matrix%get_last_col_pos(n)
402  do ipos = icol_start, icol_end
403  m = this%matrix%get_column(ipos)
404  if (m == n) cycle
405  mglo = this%ig_builder%idxToGlobal(m)%index + &
406  this%ig_builder%idxToGlobal(m)%v_model%moffset%get()
407  call sparse%addconnection(nglo, mglo, 1)
408  end do
409 
410  end do
411 
412  end subroutine spatialcon_ac
413 
414  !> @brief Creates the mapping from the local system
415  !< matrix to the global one
416  subroutine spatialcon_mc(this, matrix_sln)
417  use simmodule, only: ustop
418  class(spatialmodelconnectiontype) :: this !< this connection
419  class(matrixbasetype), pointer :: matrix_sln !< global matrix
420  ! local
421  integer(I4B) :: i, m, n, mglo, nglo, ipos, ipos_sln
422  logical(LGP) :: is_owned
423 
424  allocate (this%ipos_to_sln(this%matrix%nja))
425  do i = 1, this%matrix%nja
426  this%ipos_to_sln(i) = -1
427  end do
428 
429  do n = 1, this%neq
430  is_owned = (this%ig_builder%idxToGlobal(n)%v_model == this%owner)
431  if (.not. is_owned) cycle
432 
433  do ipos = this%matrix%ia(n), this%matrix%ia(n + 1) - 1
434  m = this%matrix%ja(ipos)
435  nglo = this%ig_builder%idxToGlobal(n)%index + &
436  this%ig_builder%idxToGlobal(n)%v_model%moffset%get()
437  mglo = this%ig_builder%idxToGlobal(m)%index + &
438  this%ig_builder%idxToGlobal(m)%v_model%moffset%get()
439 
440  ipos_sln = matrix_sln%get_position(nglo, mglo)
441  if (ipos_sln == -1) then
442  ! this should not be possible
443  write (*, *) 'Error: cannot find cell connection in global system'
444  call ustop()
445  end if
446  this%ipos_to_sln(ipos) = ipos_sln
447 
448  end do
449  end do
450 
451  end subroutine spatialcon_mc
452 
453  !> @brief Calculate (or adjust) matrix coefficients,
454  !! in this case those which are determined or affected
455  !< by the connection of a GWF model with its neighbors
456  subroutine spatialcon_cf(this, kiter)
457  class(spatialmodelconnectiontype) :: this !< this connection
458  integer(I4B), intent(in) :: kiter !< the iteration counter
459  ! local
460  integer(I4B) :: i
461 
462  ! reset interface system
463  call this%matrix%zero_entries()
464  do i = 1, this%neq
465  this%rhs(i) = 0.0_dp
466  end do
467 
468  ! calculate the interface model
469  call this%interface_model%model_cf(kiter)
470 
471  end subroutine spatialcon_cf
472 
473  !> @brief Formulate coefficients from interface model
474  !<
475  subroutine spatialcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
476  class(spatialmodelconnectiontype) :: this !< this connection
477  integer(I4B), intent(in) :: kiter !< the iteration counter
478  class(matrixbasetype), pointer :: matrix_sln !< the system matrix
479  real(DP), dimension(:), intent(inout) :: rhs_sln !< global right-hand-side
480  integer(I4B), optional, intent(in) :: inwtflag !< newton-raphson flag
481  ! local
482  integer(I4B) :: n, nglo
483  integer(I4B) :: icol_start, icol_end, ipos
484  class(matrixbasetype), pointer :: matrix_base
485 
486  matrix_base => this%matrix
487  call this%interface_model%model_fc(kiter, matrix_base, inwtflag)
488 
489  ! map back to solution matrix
490  do n = 1, this%neq
491  ! We only need the coefficients for our own model
492  ! (i.e. rows in the matrix that belong to this%owner):
493  if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner) then
494  cycle
495  end if
496 
497  nglo = this%ig_builder%idxToGlobal(n)%index + &
498  this%ig_builder%idxToGlobal(n)%v_model%moffset%get() - &
499  matrix_sln%get_row_offset()
500  rhs_sln(nglo) = rhs_sln(nglo) + this%rhs(n)
501 
502  icol_start = this%matrix%get_first_col_pos(n)
503  icol_end = this%matrix%get_last_col_pos(n)
504  do ipos = icol_start, icol_end
505  call matrix_sln%add_value_pos(this%ipos_to_sln(ipos), &
506  this%matrix%get_value_pos(ipos))
507  end do
508  end do
509 
510  end subroutine spatialcon_fc
511 
512  !> @brief Deallocation
513  !<
514  subroutine spatialcon_da(this)
515  class(spatialmodelconnectiontype) :: this !< this connection
516 
517  call mem_deallocate(this%neq)
518  call mem_deallocate(this%int_stencil_depth)
519  call mem_deallocate(this%exg_stencil_depth)
520  call mem_deallocate(this%nr_connections)
521 
522  call mem_deallocate(this%x)
523  call mem_deallocate(this%rhs)
524  call mem_deallocate(this%active)
525 
526  call this%halo_models%destroy()
527  call this%halo_exchanges%destroy()
528  deallocate (this%halo_models)
529  deallocate (this%halo_exchanges)
530  call this%matrix%destroy()
531  deallocate (this%matrix)
532 
533  call this%ig_builder%destroy()
534  call this%iface_dist_vars%Clear(destroy=.true.)
535  deallocate (this%ig_builder)
536  deallocate (this%interface_map)
537  deallocate (this%ipos_to_sln)
538 
539  end subroutine spatialcon_da
540 
541  !> @brief Creates the connection structure for the
542  !! interface grid, starting from primary exchanges,
543  !! then extending inward and outward, possibly across
544  !! model boundaries.
545  !<
546  subroutine setupgridconnection(this)
547  class(spatialmodelconnectiontype) :: this !< this connection
548  ! local
549 
550  ! connect cells from primary exchange
551  call this%ig_builder%connectPrimaryExchange(this%prim_exchange)
552 
553  ! now scan for nbr-of-nbrs and create final data structures
554  call this%ig_builder%extendConnection()
555 
556  ! construct the interface map
557  call this%ig_builder%buildInterfaceMap()
558  this%interface_map => this%ig_builder%interfaceMap
559 
560  end subroutine setupgridconnection
561 
562  !> @brief Allocation of scalars
563  !<
564  subroutine allocatescalars(this)
566  class(spatialmodelconnectiontype) :: this !< this connection
567 
568  call mem_allocate(this%neq, 'NEQ', this%memoryPath)
569  call mem_allocate(this%int_stencil_depth, 'INTSTDEPTH', this%memoryPath)
570  call mem_allocate(this%exg_stencil_depth, 'EXGSTDEPTH', this%memoryPath)
571  call mem_allocate(this%nr_connections, 'NROFCONNS', this%memoryPath)
572 
573  end subroutine allocatescalars
574 
575  !> @brief Allocation of arrays
576  !<
577  subroutine allocatearrays(this)
579  use constantsmodule, only: dzero
580  class(spatialmodelconnectiontype) :: this !< this connection
581  ! local
582  integer(I4B) :: i
583 
584  call mem_allocate(this%x, this%neq, 'X', this%memoryPath)
585  call mem_allocate(this%rhs, this%neq, 'RHS', this%memoryPath)
586  call mem_allocate(this%active, this%neq, 'IACTIVE', this%memoryPath)
587 
588  ! c.f. NumericalSolution
589  do i = 1, this%neq
590  this%x(i) = dzero
591  this%active(i) = 1 ! default is active
592  this%rhs(i) = dzero
593  end do
594 
595  end subroutine allocatearrays
596 
597  !> @brief Returns total nr. of primary connections
598  !<
599  function getnrofconnections(this) result(nrConns)
600  class(spatialmodelconnectiontype) :: this !< this connection
601  integer(I4B) :: nrConns
602  !local
603 
604  nrconns = this%prim_exchange%nexg
605 
606  end function getnrofconnections
607 
608  !> @brief Create connection's matrix (ia,ja,amat) from sparse
609  !<
610  subroutine createcoefficientmatrix(this, sparse)
611  use simmodule, only: ustop
612  class(spatialmodelconnectiontype) :: this !< this connection
613  type(sparsematrix), intent(inout) :: sparse !< the sparse matrix with the cell connections
614 
615  call sparse%sort()
616  call this%matrix%init(sparse, this%memoryPath)
617 
618  end subroutine createcoefficientmatrix
619 
620  !> @brief Validate this connection
621  !<
622  subroutine validateconnection(this)
623  use simvariablesmodule, only: errmsg
624  use simmodule, only: store_error
625  class(spatialmodelconnectiontype) :: this !< this connection
626  ! local
627  class(disconnexchangetype), pointer :: conEx => null()
628 
629  conex => this%prim_exchange
630  if (conex%ixt3d > 0) then
631  ! if XT3D, we need these angles:
632  if (conex%v_model1%con_ianglex%get() == 0) then
633  write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', &
634  trim(conex%name), ' but the discretization in model ', &
635  trim(conex%v_model1%name), ' has no ANGLDEGX specified'
636  call store_error(errmsg)
637  end if
638  if (conex%v_model2%con_ianglex%get() == 0) then
639  write (errmsg, '(a,a,a,a,a)') 'XT3D configured on the exchange ', &
640  trim(conex%name), ' but the discretization in model ', &
641  trim(conex%v_model2%name), ' has no ANGLDEGX specified'
642  call store_error(errmsg)
643  end if
644  end if
645 
646  end subroutine validateconnection
647 
648  !> @brief Add a variable from the interface model to be
649  !! synchronized at the configured stages by copying from
650  !! the source memory in the models/exchanges that are part
651  !< of this interface.
652  subroutine cfg_dv(this, var_name, subcomp_name, map_type, &
653  sync_stages, exg_var_name)
654  class(spatialmodelconnectiontype) :: this !< this connection
655  character(len=*) :: var_name !< name of variable, e.g. "K11"
656  character(len=*) :: subcomp_name !< subcomponent, e.g. "NPF"
657  integer(I4B) :: map_type !< type of variable map
658  integer(I4B), dimension(:) :: sync_stages !< stages to sync
659  character(len=*), optional :: exg_var_name !< needed for exchange variables, e.g. SIMVALS
660  ! local
661  type(distvartype), pointer :: dist_var => null()
662  class(*), pointer :: obj
663 
664  if (.not. present(exg_var_name)) exg_var_name = ''
665 
666  allocate (dist_var)
667  dist_var%var_name = var_name
668  dist_var%subcomp_name = subcomp_name
669  dist_var%comp_name = this%interface_model%name
670  dist_var%map_type = map_type
671  dist_var%sync_stages = sync_stages
672  dist_var%exg_var_name = exg_var_name
673 
674  obj => dist_var
675  call this%iface_dist_vars%Add(obj)
676 
677  end subroutine cfg_dv
678 
679  !> @brief Cast to SpatialModelConnectionType
680  !<
681  function cast_as_smc(obj) result(res)
682  implicit none
683  class(*), pointer, intent(inout) :: obj !< object to be cast
684  class(spatialmodelconnectiontype), pointer :: res !< the instance of SpatialModelConnectionType
685  !
686  res => null()
687  if (.not. associated(obj)) return
688  !
689  select type (obj)
690  class is (spatialmodelconnectiontype)
691  res => obj
692  end select
693  end function cast_as_smc
694 
695  !> @brief Add connection to a list
696  !<
697  subroutine add_smc_to_list(list, conn)
698  implicit none
699  ! -- dummy
700  type(listtype), intent(inout) :: list !< the list
701  class(spatialmodelconnectiontype), pointer, intent(in) :: conn !< the connection
702  ! -- local
703  class(*), pointer :: obj
704  !
705  obj => conn
706  call list%Add(obj)
707  end subroutine add_smc_to_list
708 
709  !> @brief Get the connection from a list
710  !<
711  function get_smc_from_list(list, idx) result(res)
712  type(listtype), intent(inout) :: list !< the list
713  integer(I4B), intent(in) :: idx !< the index of the connection
714  class(spatialmodelconnectiontype), pointer :: res !< the returned connection
715 
716  ! local
717  class(*), pointer :: obj
718  obj => list%GetItem(idx)
719  res => cast_as_smc(obj)
720  end function get_smc_from_list
721 
This module contains simulation constants.
Definition: Constants.f90:9
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b) function, public getcsrindex(i, j, ia, ja)
Return index for element i,j in CSR storage,.
Definition: CsrUtils.f90:13
Refactoring issues towards parallel:
subroutine destroy(this)
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
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
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
subroutine validateconnection(this)
Validate this connection.
subroutine spatialcon_connect(this)
map interface model connections to our sparse matrix,
class(spatialmodelconnectiontype) function, pointer, public get_smc_from_list(list, idx)
Get the connection from a list.
subroutine spatialcon_df(this)
Define this connection, this is where the discretization (DISU) for the interface model is.
subroutine spatialcon_setmodelptrs(this)
set model pointers to connection
subroutine cfg_dv(this, var_name, subcomp_name, map_type, sync_stages, exg_var_name)
Add a variable from the interface model to be synchronized at the configured stages by copying from t...
subroutine spatialconnection_ctor(this, model, exchange, name)
Construct the spatial connection base.
class(spatialmodelconnectiontype) function, pointer, public cast_as_smc(obj)
Cast to SpatialModelConnectionType.
subroutine, public add_smc_to_list(list, conn)
Add connection to a list.
recursive subroutine addmodelneighbors(this, model_id, virtual_exchanges, depth, is_root, mask)
Add neighbors and nbrs-of-nbrs to the model tree.
subroutine createcoefficientmatrix(this, sparse)
Add connections, handled by the interface model,.
subroutine createmodelhalo(this)
Find all models that might participate in this interface.
subroutine maskownerconnections(this)
Mask the owner's connections.
subroutine spatialcon_ar(this)
Allocate the connection,.
type(listtype), public virtual_exchange_list
class(virtualexchangetype) function, pointer, public get_virtual_exchange_from_list(list, idx)
class(virtualexchangetype) function, pointer, public get_virtual_exchange(exg_id)
Returns a virtual exchange with the specified id.
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...
A generic heterogeneous doubly-linked list.
Definition: List.f90:14
Class to manage spatial connection of a model to one or more models of the same type....
The Virtual Exchange is based on two Virtual Models and is therefore not always strictly local or rem...