41 integer(I4B),
pointer :: nr_connections => null()
44 logical(LGP) :: owns_exchange
48 integer(I4B),
pointer :: int_stencil_depth => null()
50 integer(I4B),
pointer :: exg_stencil_depth => null()
54 integer(I4B),
pointer :: neq => null()
56 real(dp),
dimension(:),
pointer,
contiguous :: rhs => null()
57 real(dp),
dimension(:),
pointer,
contiguous :: x => null()
58 integer(I4B),
dimension(:),
pointer,
contiguous :: active => null()
62 integer(I4B),
dimension(:),
pointer :: ipos_to_sln => null()
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
84 procedure, pass(this) :: spatialcon_ac
85 procedure, pass(this) :: spatialcon_cf
86 procedure, pass(this) :: spatialcon_fc
87 procedure, pass(this) :: spatialcon_da
95 procedure,
private, pass(this) :: setupgridconnection
96 procedure,
private, pass(this) :: getnrofconnections
97 procedure,
private, pass(this) :: allocatescalars
98 procedure,
private, pass(this) :: allocatearrays
116 character(len=*),
intent(in) :: name
122 this%prim_exchange => exchange
124 allocate (this%ig_builder)
125 allocate (this%halo_models)
126 allocate (this%halo_exchanges)
127 allocate (this%matrix)
128 call this%allocateScalars()
130 this%int_stencil_depth = 1
131 this%exg_stencil_depth = 1
132 this%nr_connections = 0
135 this%interface_model => null()
144 call this%halo_models%init()
145 call this%halo_exchanges%init()
148 this%exg_stencil_depth, .true.)
156 depth, is_root, mask)
159 integer(I4B) :: model_id
161 integer(I4B),
value :: depth
162 logical(LGP) :: is_root
163 integer(I4B),
optional :: mask
167 integer(I4B) :: neighbor_id
168 integer(I4B) :: model_mask
172 if (.not.
present(mask))
then
178 call models_at_depth%init()
182 call models_at_depth%push_back_unique(model_id)
185 if (this%prim_exchange%v_model1%id == this%owner%id)
then
186 neighbor_id = this%prim_exchange%v_model2%id
188 neighbor_id = this%prim_exchange%v_model1%id
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)
197 do i = 1, virtual_exchanges%Count()
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
208 if (neighbor_id > 0)
then
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)
221 call models_at_depth%destroy()
226 do n = 1, models_at_depth%size
227 call this%addModelNeighbors(models_at_depth%at(n), virtual_exchanges, &
228 depth, .false., model_id)
232 call models_at_depth%destroy()
246 this%nr_connections = this%getNrOfConnections()
247 call this%ig_builder%construct(this%owner, &
248 this%nr_connections, &
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
255 call this%ig_builder%addToRegionalModels(v_model)
257 call this%setupGridConnection()
259 this%neq = this%ig_builder%nrOfCells
260 call this%allocateArrays()
269 integer(I4B) :: iface_idx, glob_idx
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
289 this%interface_model%x => this%x
291 this%interface_model%memoryPath,
'X', &
293 this%interface_model%rhs => this%rhs
294 call mem_checkin(this%interface_model%rhs,
'RHS', &
295 this%interface_model%memoryPath,
'RHS', &
297 this%interface_model%ibound => this%active
298 call mem_checkin(this%interface_model%ibound,
'IBOUND', &
299 this%interface_model%memoryPath,
'IBOUND', &
312 call sparse%init(this%neq, this%neq, 7)
313 call this%interface_model%model_ac(sparse)
316 call this%createCoefficientMatrix(sparse)
317 call sparse%destroy()
320 matrix_base => this%matrix
321 call this%interface_model%model_mc(matrix_base)
322 call this%maskOwnerConnections()
335 integer(I4B) :: ipos, n, m, nloc, mloc, csr_idx
339 conn => this%interface_model%dis%con
342 if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner)
then
345 nloc = this%ig_builder%idxToGlobal(n)%index
347 do ipos = conn%ia(n) + 1, conn%ia(n + 1) - 1
349 if (.not. this%ig_builder%idxToGlobal(m)%v_model == this%owner)
then
352 mloc = this%ig_builder%idxToGlobal(m)%index
354 if (conn%mask(ipos) > 0)
then
356 csr_idx =
getcsrindex(nloc, mloc, this%owner%ia, this%owner%ja)
357 if (csr_idx == -1)
then
360 if (this%ig_builder%isPeriodic(nloc, mloc)) cycle
362 write (*, *)
'Error: cannot find cell connection in global system'
366 if (this%owner%dis%con%mask(csr_idx) > 0)
then
367 call this%owner%dis%con%set_mask(csr_idx, 0)
373 call conn%set_mask(ipos, 0)
383 subroutine spatialcon_ac(this, sparse)
387 integer(I4B) :: n, m, ipos
388 integer(I4B) :: icol_start, icol_end
389 integer(I4B) :: nglo, mglo
392 if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner)
then
397 nglo = this%ig_builder%idxToGlobal(n)%index + &
398 this%ig_builder%idxToGlobal(n)%v_model%moffset%get()
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)
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)
412 end subroutine spatialcon_ac
416 subroutine spatialcon_mc(this, matrix_sln)
421 integer(I4B) :: i, m, n, mglo, nglo, ipos, ipos_sln
422 logical(LGP) :: is_owned
424 allocate (this%ipos_to_sln(this%matrix%nja))
425 do i = 1, this%matrix%nja
426 this%ipos_to_sln(i) = -1
430 is_owned = (this%ig_builder%idxToGlobal(n)%v_model == this%owner)
431 if (.not. is_owned) cycle
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()
440 ipos_sln = matrix_sln%get_position(nglo, mglo)
441 if (ipos_sln == -1)
then
443 write (*, *)
'Error: cannot find cell connection in global system'
446 this%ipos_to_sln(ipos) = ipos_sln
451 end subroutine spatialcon_mc
456 subroutine spatialcon_cf(this, kiter)
458 integer(I4B),
intent(in) :: kiter
463 call this%matrix%zero_entries()
469 call this%interface_model%model_cf(kiter)
471 end subroutine spatialcon_cf
475 subroutine spatialcon_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
477 integer(I4B),
intent(in) :: kiter
479 real(DP),
dimension(:),
intent(inout) :: rhs_sln
480 integer(I4B),
optional,
intent(in) :: inwtflag
482 integer(I4B) :: n, nglo
483 integer(I4B) :: icol_start, icol_end, ipos
486 matrix_base => this%matrix
487 call this%interface_model%model_fc(kiter, matrix_base, inwtflag)
493 if (.not. this%ig_builder%idxToGlobal(n)%v_model == this%owner)
then
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)
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))
510 end subroutine spatialcon_fc
514 subroutine spatialcon_da(this)
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)
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)
539 end subroutine spatialcon_da
546 subroutine setupgridconnection(this)
551 call this%ig_builder%connectPrimaryExchange(this%prim_exchange)
554 call this%ig_builder%extendConnection()
557 call this%ig_builder%buildInterfaceMap()
558 this%interface_map => this%ig_builder%interfaceMap
560 end subroutine setupgridconnection
564 subroutine allocatescalars(this)
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)
573 end subroutine allocatescalars
577 subroutine allocatearrays(this)
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)
595 end subroutine allocatearrays
599 function getnrofconnections(this)
result(nrConns)
601 integer(I4B) :: nrConns
604 nrconns = this%prim_exchange%nexg
606 end function getnrofconnections
616 call this%matrix%init(sparse, this%memoryPath)
629 conex => this%prim_exchange
630 if (conex%ixt3d > 0)
then
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'
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'
652 subroutine cfg_dv(this, var_name, subcomp_name, map_type, &
653 sync_stages, exg_var_name)
655 character(len=*) :: var_name
656 character(len=*) :: subcomp_name
657 integer(I4B) :: map_type
658 integer(I4B),
dimension(:) :: sync_stages
659 character(len=*),
optional :: exg_var_name
662 class(*),
pointer :: obj
664 if (.not.
present(exg_var_name)) exg_var_name =
''
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
675 call this%iface_dist_vars%Add(obj)
683 class(*),
pointer,
intent(inout) :: obj
687 if (.not.
associated(obj))
return
700 type(
listtype),
intent(inout) :: list
703 class(*),
pointer :: obj
712 type(
listtype),
intent(inout) :: list
713 integer(I4B),
intent(in) :: idx
717 class(*),
pointer :: obj
718 obj => list%GetItem(idx)
This module contains simulation constants.
real(dp), parameter dzero
real constant zero
integer(i4b) function, public getcsrindex(i, j, ia, ja)
Return index for element i,j in CSR storage,.
Refactoring issues towards parallel:
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation methods.
subroutine, public ustop(stopmess, ioutlocal)
Stop the simulation.
subroutine, public store_error(msg, terminate)
Store an error message.
This module contains simulation variables.
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.
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...