59 character(len=LENMEMPATH) :: memorypath
60 integer(I4B) :: internalstencildepth
61 integer(I4B) :: exchangestencildepth
62 integer(I4B) :: icondir
67 integer(I4B),
pointer :: nrofboundarycells => null()
72 integer(I4B),
pointer :: nrofcells => null()
74 integer(I4B),
dimension(:),
pointer,
contiguous :: idxtoglobalidx => null()
77 integer(I4B),
dimension(:),
pointer :: region_to_iface_map => null()
78 integer(I4B),
dimension(:),
pointer :: regionalmodeloffset => null()
79 integer(I4B),
pointer :: indexcount => null()
82 integer(I4B),
dimension(:),
pointer :: connectionmask => null()
130 subroutine construct(this, model, nrOfPrimaries, connectionName)
133 integer(I4B) :: nrOfPrimaries
134 character(len=*) :: connectionName
141 call this%allocateScalars()
143 allocate (this%boundaryCells(nrofprimaries))
144 allocate (this%connectedCells(nrofprimaries))
145 allocate (this%idxToGlobal(2 * nrofprimaries))
148 call this%addToRegionalModels(v_model)
150 this%nrOfBoundaryCells = 0
152 this%internalStencilDepth = 1
153 this%exchangeStencilDepth = 1
155 this%haloExchanges => null()
165 integer(I4B) :: iconn
168 this%primaryExchange => primex
171 do iconn = 1, primex%nexg
172 call this%connectCell(primex%nodem1(iconn), primex%v_model1, &
173 primex%nodem2(iconn), primex%v_model2)
191 this%nrOfBoundaryCells = this%nrOfBoundaryCells + 1
192 if (this%nrOfBoundaryCells >
size(this%boundaryCells))
then
193 write (*, *)
'Error: nr of cell connections exceeds '// &
194 'capacity in grid connection, terminating...'
198 bnd_cell => this%boundaryCells(this%nrOfBoundaryCells)%cell
199 conn_cell => this%connectedCells(this%nrOfBoundaryCells)%cell
200 if (v_model1 == this%model)
then
201 bnd_cell%index = idx1
202 bnd_cell%v_model => v_model1
203 conn_cell%index = idx2
204 conn_cell%v_model => v_model2
205 else if (v_model2 == this%model)
then
206 bnd_cell%index = idx2
207 bnd_cell%v_model => v_model2
208 conn_cell%index = idx1
209 conn_cell%v_model => v_model1
211 write (*, *)
'Error: unable to connect cells outside the model'
223 class(*),
pointer :: vm_obj
226 if (.not. this%regionalModels%ContainsObject(vm_obj))
then
227 call this%regionalModels%Add(vm_obj)
244 integer(I4B) :: remoteDepth, localDepth
245 integer(I4B) :: icell
246 integer(I4B) :: imod, regionSize, offset
251 remotedepth = this%exchangeStencilDepth
252 localdepth = 2 * this%internalStencilDepth - 1
253 if (localdepth < remotedepth)
then
254 localdepth = remotedepth
259 do icell = 1, this%nrOfBoundaryCells
260 call this%addNeighbors(this%boundaryCells(icell), localdepth, &
261 this%connectedCells(icell)%cell, .true.)
264 do icell = 1, this%nrOfBoundaryCells
265 call this%addNeighbors(this%connectedCells(icell), remotedepth, &
266 this%boundaryCells(icell)%cell, .false.)
270 allocate (this%regionalModelOffset(this%regionalModels%Count()))
273 do imod = 1, this%regionalModels%Count()
275 regionsize = regionsize + v_model%dis_nodes%get()
276 this%regionalModelOffset(imod) = offset
277 offset = offset + v_model%dis_nodes%get()
280 allocate (this%region_to_iface_map(regionsize))
281 this%region_to_iface_map = -1
283 call this%buildConnections()
292 integer(I4B) :: i, icell, iconn
293 integer(I4B),
dimension(:),
allocatable :: nnz
295 integer(I4B) :: ierror
298 character(len=LINELENGTH) :: warnmsg
303 do icell = 1, this%nrOfBoundaryCells
304 call this%registerInterfaceCells(this%boundaryCells(icell))
306 do icell = 1, this%nrOfBoundaryCells
307 call this%registerInterfaceCells(this%connectedCells(icell))
309 this%nrOfCells = this%indexCount
312 call this%compressGlobalMap()
315 do i = 1, this%regionalModels%Count()
317 if (vm%dis_icondir%get() == 0) this%icondir = 0
320 if (this%icondir == 0 .and. this%model%dis%icondir > 0)
then
321 write (warnmsg,
'(3a)')
'Exchange ', trim(this%primaryExchange%name), &
322 " will not use vertex and/or cell coordinate data because not all &
323 &connected models have those data specified"
328 call this%sortInterfaceGrid()
331 call mem_allocate(this%idxToGlobalIdx, this%nrOfCells, &
332 'IDXTOGLOBALIDX', this%memoryPath)
336 allocate (nnz(this%nrOfCells))
338 call sparse%init(this%nrOfCells, this%nrOfCells, nnz)
342 call this%makePrimaryConnections(sparse)
344 do icell = 1, this%nrOfBoundaryCells
345 call this%connectNeighborCells(this%boundaryCells(icell), sparse)
348 do icell = 1, this%nrOfBoundaryCells
349 call this%connectNeighborCells(this%connectedCells(icell), sparse)
353 allocate (this%connections)
354 conn => this%connections
355 call conn%allocate_scalars(this%memoryPath)
356 conn%nodes = this%nrOfCells
357 conn%nja = sparse%nnz
358 conn%njas = (conn%nja - conn%nodes) / 2
359 call conn%allocate_arrays()
360 do iconn = 1, conn%njas
361 conn%anglex(iconn) = -999.
365 call sparse%filliaja(conn%ia, conn%ja, ierror)
366 if (ierror /= 0)
then
367 write (*, *)
'Error filling ia/ja in GridConnection: terminating...'
370 call fillisym(conn%nodes, conn%nja, conn%ia, conn%ja, conn%isym)
371 call filljas(conn%nodes, conn%nja, conn%ia, conn%ja, conn%isym, conn%jas)
372 call sparse%destroy()
376 call this%fillConnectionDataInternal()
377 call this%fillConnectionDataFromExchanges()
380 call this%createConnectionMask()
386 recursive subroutine addneighbors(this, cellNbrs, depth, mask, interior)
390 integer(I4B),
intent(inout) :: depth
392 logical(LGP) :: interior
395 integer(I4B) :: ipos, ipos_start, ipos_end
396 integer(I4B) :: nbridx, inbr
397 integer(I4B) :: newdepth
400 cell => cellnbrs%cell
410 ipos_start = cell%v_model%con_ia%get(cell%index) + 1
411 ipos_end = cell%v_model%con_ia%get(cell%index + 1) - 1
412 do ipos = ipos_start, ipos_end
413 nbridx = cell%v_model%con_ja%get(ipos)
414 call this%addNeighborCell(cellnbrs, nbridx, cellnbrs%cell%v_model, mask)
418 call this%addRemoteNeighbors(cellnbrs, mask)
421 do inbr = 1, cellnbrs%nrOfNbrs
424 if (interior .and. cellnbrs%cell%v_model == this%model)
then
425 if (.not. cellnbrs%neighbors(inbr)%cell%v_model == this%model)
then
428 newdepth = newdepth - 1
432 call this%addNeighbors(cellnbrs%neighbors(inbr), newdepth, &
433 cellnbrs%cell, interior)
445 integer(I4B) :: ix, iexg
450 do ix = 1, this%haloExchanges%size
453 v_m1 => v_exchange%v_model1
454 v_m2 => v_exchange%v_model2
457 if (cellnbrs%cell%v_model == v_m1)
then
458 do iexg = 1, v_exchange%nexg%get()
459 if (v_exchange%nodem1%get(iexg) == cellnbrs%cell%index)
then
461 call this%addNeighborCell( &
462 cellnbrs, v_exchange%nodem2%get(iexg), v_m2, mask)
467 if (cellnbrs%cell%v_model == v_m2)
then
468 do iexg = 1, v_exchange%nexg%get()
469 if (v_exchange%nodem2%get(iexg) == cellnbrs%cell%index)
then
471 call this%addNeighborCell( &
472 cellnbrs, v_exchange%nodem1%get(iexg), v_m1, mask)
486 integer(I4B),
intent(in) :: newNbrIdx
490 if (
present(mask))
then
491 if (newnbridx == mask%index .and. mask%v_model == v_nbr_model)
then
496 call cellnbrs%addNbrCell(newnbridx, v_nbr_model)
506 integer(I4B) :: offset, inbr
507 integer(I4B) :: regionidx
508 integer(I4B) :: ifaceidx
510 offset = this%get_regional_offset(cellwithnbrs%cell%v_model)
511 regionidx = offset + cellwithnbrs%cell%index
512 ifaceidx = this%getInterfaceIndex(cellwithnbrs%cell)
513 if (ifaceidx == -1)
then
514 this%indexCount = this%indexCount + 1
515 ifaceidx = this%indexCount
516 call this%addToGlobalMap(ifaceidx, cellwithnbrs%cell)
517 this%region_to_iface_map(regionidx) = ifaceidx
521 do inbr = 1, cellwithnbrs%nrOfNbrs
522 call this%registerInterfaceCells(cellwithnbrs%neighbors(inbr))
531 integer(I4B),
intent(in) :: ifaceIdx
534 integer(I4B) :: i, currentSize, newSize
538 currentsize =
size(this%idxToGlobal)
539 if (ifaceidx > currentsize)
then
540 newsize = nint(1.5 * currentsize)
541 allocate (tempmap(newsize))
542 do i = 1, currentsize
543 tempmap(i) = this%idxToGlobal(i)
546 deallocate (this%idxToGlobal)
547 this%idxToGlobal => tempmap
550 this%idxToGlobal(ifaceidx) = cell
561 if (
size(this%idxToGlobal) > this%nrOfCells)
then
562 allocate (tempmap(this%nrOfCells))
563 tempmap(1:this%nrOfCells) = this%idxToGlobal(1:this%nrOfCells)
564 deallocate (this%idxToGlobal)
565 allocate (this%idxToGlobal(this%nrOfCells))
566 this%idxToGlobal(1:this%nrOfCells) = tempmap(1:this%nrOfCells)
578 integer(I4B),
dimension(:),
allocatable :: newToOldIdx
579 integer(I4B),
dimension(:),
allocatable :: oldToNewIdx
580 integer(I4B) :: idxOld
582 type(
globalcelltype),
dimension(:),
allocatable :: sortedGlobalMap
583 integer(I4B),
dimension(:),
allocatable :: sortedRegionMap
584 logical(LGP) :: z_only
587 z_only = (this%icondir == 0)
590 newtooldidx = (/(i, i=1,
size(this%idxToGlobal))/)
591 call quicksortgrid(newtooldidx,
size(newtooldidx), this%idxToGlobal, z_only)
594 allocate (oldtonewidx(
size(newtooldidx)))
595 do i = 1,
size(oldtonewidx)
596 oldtonewidx(newtooldidx(i)) = i
600 allocate (sortedglobalmap(
size(this%idxToGlobal)))
601 do i = 1,
size(newtooldidx)
602 sortedglobalmap(i) = this%idxToGlobal(newtooldidx(i))
604 do i = 1,
size(newtooldidx)
605 this%idxToGlobal(i) = sortedglobalmap(i)
607 deallocate (sortedglobalmap)
610 allocate (sortedregionmap(
size(this%region_to_iface_map)))
611 do i = 1,
size(sortedregionmap)
612 if (this%region_to_iface_map(i) /= -1)
then
613 idxold = this%region_to_iface_map(i)
614 sortedregionmap(i) = oldtonewidx(idxold)
616 sortedregionmap(i) = -1
619 do i = 1,
size(sortedregionmap)
620 this%region_to_iface_map(i) = sortedregionmap(i)
622 deallocate (sortedregionmap)
632 integer(I4B) :: icell
633 integer(I4B) :: ifaceIdx, ifaceIdxNbr
635 do icell = 1, this%nrOfBoundaryCells
636 ifaceidx = this%getInterfaceIndex(this%boundaryCells(icell)%cell)
637 ifaceidxnbr = this%getInterfaceIndex(this%connectedCells(icell)%cell)
640 call sparse%addconnection(ifaceidx, ifaceidx, 1)
641 call sparse%addconnection(ifaceidxnbr, ifaceidxnbr, 1)
644 call sparse%addconnection(ifaceidx, ifaceidxnbr, 1)
645 call sparse%addconnection(ifaceidxnbr, ifaceidx, 1)
658 integer(I4B) :: ifaceidx, ifaceidxnbr
661 ifaceidx = this%getInterfaceIndex(cell%cell)
662 do inbr = 1, cell%nrOfNbrs
663 ifaceidxnbr = this%getInterfaceIndex(cell%neighbors(inbr)%cell)
665 call sparse%addconnection(ifaceidxnbr, ifaceidxnbr, 1)
666 call sparse%addconnection(ifaceidx, ifaceidxnbr, 1)
667 call sparse%addconnection(ifaceidxnbr, ifaceidx, 1)
670 call this%connectNeighborCells(cell%neighbors(inbr), sparse)
682 integer(I4B) :: n, m, ipos, isym, ipos_orig, isym_orig
686 conn => this%connections
689 do ipos = conn%ia(n) + 1, conn%ia(n + 1) - 1
693 isym = conn%jas(ipos)
694 ncell => this%idxToGlobal(n)
695 mcell => this%idxToGlobal(m)
696 if (ncell%v_model == mcell%v_model)
then
702 ipos_orig =
getcsrindex(ncell%index, mcell%index, &
703 v_m%con_ia%get_array(), v_m%con_ja%get_array())
705 if (ipos_orig == 0)
then
708 if (this%isPeriodic(ncell%index, mcell%index)) cycle
711 write (*, *)
'Error: cannot find cell connection in model grid'
715 isym_orig = v_m%con_jas%get(ipos_orig)
716 conn%hwva(isym) = v_m%con_hwva%get(isym_orig)
717 conn%ihc(isym) = v_m%con_ihc%get(isym_orig)
718 if (ncell%index < mcell%index)
then
719 conn%cl1(isym) = v_m%con_cl1%get(isym_orig)
720 conn%cl2(isym) = v_m%con_cl2%get(isym_orig)
721 conn%anglex(isym) = v_m%con_anglex%get(isym_orig)
723 conn%cl1(isym) = v_m%con_cl2%get(isym_orig)
724 conn%cl2(isym) = v_m%con_cl1%get(isym_orig)
725 conn%anglex(isym) = mod(v_m%con_anglex%get(isym_orig) +
dpi,
dtwopi)
739 integer(I4B) :: inx, iexg
740 integer(I4B) :: ipos, isym
741 integer(I4B) :: nOffset, mOffset, nIfaceIdx, mIfaceIdx
746 conn => this%connections
748 do inx = 1, this%haloExchanges%size
751 v_m1 => v_exg%v_model1
752 v_m2 => v_exg%v_model2
754 if (v_exg%ianglex%get() > 0)
then
758 noffset = this%get_regional_offset(v_m1)
759 moffset = this%get_regional_offset(v_m2)
760 do iexg = 1, v_exg%nexg%get()
761 nifaceidx = this%region_to_iface_map(noffset + v_exg%nodem1%get(iexg))
762 mifaceidx = this%region_to_iface_map(moffset + v_exg%nodem2%get(iexg))
765 if (nifaceidx == -1 .or. mifaceidx == -1)
then
769 ipos = conn%getjaindex(nifaceidx, mifaceidx)
776 isym = conn%jas(ipos)
780 if (nifaceidx < mifaceidx)
then
781 conn%cl1(isym) = v_exg%cl1%get(iexg)
782 conn%cl2(isym) = v_exg%cl2%get(iexg)
783 if (v_exg%ianglex%get() > 0)
then
784 conn%anglex(isym) = &
785 v_exg%auxvar%get(v_exg%ianglex%get(), iexg) *
dpio180
788 conn%cl1(isym) = v_exg%cl2%get(iexg)
789 conn%cl2(isym) = v_exg%cl1%get(iexg)
790 if (v_exg%ianglex%get() > 0)
then
791 conn%anglex(isym) = mod(v_exg%auxvar%get(v_exg%ianglex%get(), iexg) &
792 + 180.0_dp, 360.0_dp) *
dpio180
795 conn%hwva(isym) = v_exg%hwva%get(iexg)
796 conn%ihc(isym) = v_exg%ihc%get(iexg)
812 integer(I4B) :: icell, inbr, n, ipos
813 integer(I4B) :: level, newMask
817 do ipos = 1, this%connections%nja
818 call this%connections%set_mask(ipos, 0)
824 do icell = 1, this%nrOfBoundaryCells
825 call this%setMaskOnConnection(this%boundaryCells(icell), &
826 this%connectedCells(icell), level)
830 call this%setMaskOnConnection(this%connectedCells(icell), &
831 this%boundaryCells(icell), level)
835 do icell = 1, this%nrOfBoundaryCells
836 cell => this%boundaryCells(icell)
837 do inbr = 1, cell%nrOfNbrs
838 nbrcell => this%boundaryCells(icell)%neighbors(inbr)
840 call this%maskInternalConnections(this%boundaryCells(icell), &
841 this%boundaryCells(icell)% &
842 neighbors(inbr), level)
849 do n = 1, this%connections%nodes
851 call this%connections%set_mask(this%connections%ia(n), 0)
853 do ipos = this%connections%ia(n) + 1, this%connections%ia(n + 1) - 1
855 if (this%connections%mask(ipos) > 0)
then
856 if (this%connections%mask(ipos) < this%internalStencilDepth + 1)
then
861 call this%connections%set_mask(ipos, newmask)
873 integer(I4B),
intent(in) :: level
875 integer(I4B) :: inbr, newlevel
879 if (cell%cell%v_model == this%model .and. &
880 nbrcell%cell%v_model == this%model)
then
882 call this%setMaskOnConnection(cell, nbrcell, level)
883 call this%setMaskOnConnection(nbrcell, cell, level)
888 do inbr = 1, nbrcell%nrOfNbrs
889 call this%maskInternalConnections(nbrcell, &
890 nbrcell%neighbors(inbr), &
903 integer(I4B),
intent(in) :: level
905 integer(I4B) :: ifaceIdx, ifaceIdxNbr
906 integer(I4B) :: iposdiag, ipos
907 integer(I4B) :: currentLevel
909 ifaceidx = this%getInterfaceIndex(cell%cell)
910 ifaceidxnbr = this%getInterfaceIndex(nbrcell%cell)
913 iposdiag = this%connections%getjaindex(ifaceidx, ifaceidx)
914 currentlevel = this%connections%mask(iposdiag)
915 if (currentlevel == 0 .or. level < currentlevel)
then
916 call this%connections%set_mask(iposdiag, level)
919 ipos = this%connections%getjaindex(ifaceidx, ifaceidxnbr)
920 currentlevel = this%connections%mask(ipos)
921 if (currentlevel == 0 .or. level < currentlevel)
then
922 call this%connections%set_mask(ipos, level)
932 integer(I4B) :: iface_idx
934 integer(I4B) :: offset, region_idx
936 offset = this%get_regional_offset(cell%v_model)
937 region_idx = offset + cell%index
938 iface_idx = this%region_to_iface_map(region_idx)
946 integer(I4B) :: index
948 integer(I4B) :: iface_idx
950 integer(I4B) :: offset, region_idx
952 offset = this%get_regional_offset(v_model)
953 region_idx = offset + index
954 iface_idx = this%region_to_iface_map(region_idx)
963 integer(I4B) :: offset
969 do im = 1, this%regionalModels%Count()
971 if (vm == v_model)
then
972 offset = this%regionalModelOffset(im)
985 call mem_allocate(this%nrOfBoundaryCells,
'NRBNDCELLS', this%memoryPath)
986 call mem_allocate(this%indexCount,
'IDXCOUNT', this%memoryPath)
987 call mem_allocate(this%nrOfCells,
'NRCELLS', this%memoryPath)
1000 integer(I4B) :: icell, nrOfCells, idx
1002 real(DP) :: xglo, yglo
1005 nrofcells = this%nrOfCells
1006 disu%nodes = nrofcells
1008 disu%icondir = this%icondir
1009 disu%nodesuser = nrofcells
1010 disu%nja = this%connections%nja
1012 call disu%allocate_arrays()
1015 call disu%allocate_arrays_mem()
1018 do icell = 1, nrofcells
1019 idx = this%idxToGlobal(icell)%index
1020 disu%top(icell) = -huge(1.0_dp)
1021 disu%bot(icell) = -huge(1.0_dp)
1022 disu%area(icell) = -huge(1.0_dp)
1026 disu%con => this%connections
1027 disu%njas = disu%con%njas
1029 if (this%icondir > 0)
then
1031 do icell = 1, nrofcells
1032 idx = this%idxToGlobal(icell)%index
1033 v_model => this%idxToGlobal(icell)%v_model
1038 v_model%dis_yc%get(idx), &
1039 v_model%dis_xorigin%get(), &
1040 v_model%dis_yorigin%get(), &
1041 v_model%dis_angrot%get(), &
1045 disu%cellxy(1, icell) = xglo
1046 disu%xc(icell) = xglo
1047 disu%cellxy(2, icell) = yglo
1048 disu%yc(icell) = yglo
1073 integer(I4B) :: i, j, iloc, jloc
1074 integer(I4B) :: im, ix, mid, n
1075 integer(I4B) :: ipos, ipos_model
1077 type(
stlvecint) :: src_idx_tmp, tgt_idx_tmp, sign_tmp
1082 integer(I4B),
dimension(:),
pointer,
contiguous :: ia_ptr, ja_ptr
1084 allocate (this%interfaceMap)
1085 imap => this%interfaceMap
1088 call model_ids%init()
1089 do i = 1, this%nrOfCells
1090 call model_ids%push_back_unique(this%idxToGlobal(i)%v_model%id)
1094 call imap%init(model_ids%size, this%haloExchanges%size)
1097 do im = 1, model_ids%size
1098 mid = model_ids%at(im)
1099 imap%model_ids(im) = mid
1101 imap%model_names(im) = vm%name
1102 call src_idx_tmp%init()
1103 call tgt_idx_tmp%init()
1106 do i = 1, this%nrOfCells
1107 if (mid == this%idxToGlobal(i)%v_model%id)
then
1108 call src_idx_tmp%push_back(this%idxToGlobal(i)%index)
1109 call tgt_idx_tmp%push_back(i)
1114 allocate (imap%node_maps(im)%src_idx(src_idx_tmp%size))
1115 allocate (imap%node_maps(im)%tgt_idx(tgt_idx_tmp%size))
1116 do i = 1, src_idx_tmp%size
1117 imap%node_maps(im)%src_idx(i) = src_idx_tmp%at(i)
1118 imap%node_maps(im)%tgt_idx(i) = tgt_idx_tmp%at(i)
1121 call src_idx_tmp%destroy()
1122 call tgt_idx_tmp%destroy()
1125 call src_idx_tmp%init()
1126 call tgt_idx_tmp%init()
1129 do i = 1, this%nrOfCells
1130 if (mid /= this%idxToGlobal(i)%v_model%id) cycle
1131 do ipos = this%connections%ia(i), this%connections%ia(i + 1) - 1
1132 j = this%connections%ja(ipos)
1133 if (mid /= this%idxToGlobal(j)%v_model%id) cycle
1136 iloc = this%idxToGlobal(i)%index
1137 jloc = this%idxToGlobal(j)%index
1138 ia_ptr => this%idxToGlobal(i)%v_model%con_ia%get_array()
1139 ja_ptr => this%idxToGlobal(i)%v_model%con_ja%get_array()
1140 ipos_model =
getcsrindex(iloc, jloc, ia_ptr, ja_ptr)
1141 call src_idx_tmp%push_back(ipos_model)
1142 call tgt_idx_tmp%push_back(ipos)
1147 allocate (imap%conn_maps(im)%src_idx(src_idx_tmp%size))
1148 allocate (imap%conn_maps(im)%tgt_idx(tgt_idx_tmp%size))
1149 do i = 1, src_idx_tmp%size
1150 imap%conn_maps(im)%src_idx(i) = src_idx_tmp%at(i)
1151 imap%conn_maps(im)%tgt_idx(i) = tgt_idx_tmp%at(i)
1154 call src_idx_tmp%destroy()
1155 call tgt_idx_tmp%destroy()
1159 call model_ids%destroy()
1162 do ix = 1, this%haloExchanges%size
1167 v_model1 => v_exg%v_model1
1168 v_model2 => v_exg%v_model2
1170 imap%exchange_ids(ix) = v_exg%id
1171 imap%exchange_names(ix) = v_exg%name
1173 call src_idx_tmp%init()
1174 call tgt_idx_tmp%init()
1175 call sign_tmp%init()
1177 do n = 1, v_exg%nexg%get()
1178 i = this%getInterfaceIndex(v_exg%nodem1%get(n), v_model1)
1179 j = this%getInterfaceIndex(v_exg%nodem2%get(n), v_model2)
1180 if (i == -1 .or. j == -1) cycle
1181 ipos = this%connections%getjaindex(i, j)
1189 call src_idx_tmp%push_back(n)
1190 call tgt_idx_tmp%push_back(ipos)
1191 call sign_tmp%push_back(1)
1194 call src_idx_tmp%push_back(n)
1195 call tgt_idx_tmp%push_back(this%connections%isym(ipos))
1196 call sign_tmp%push_back(-1)
1199 allocate (imap%exchange_maps(ix)%src_idx(src_idx_tmp%size))
1200 allocate (imap%exchange_maps(ix)%tgt_idx(tgt_idx_tmp%size))
1201 allocate (imap%exchange_maps(ix)%sign(sign_tmp%size))
1202 do i = 1, src_idx_tmp%size
1203 imap%exchange_maps(ix)%src_idx(i) = src_idx_tmp%at(i)
1204 imap%exchange_maps(ix)%tgt_idx(i) = tgt_idx_tmp%at(i)
1205 imap%exchange_maps(ix)%sign(i) = sign_tmp%at(i)
1208 call src_idx_tmp%destroy()
1209 call tgt_idx_tmp%destroy()
1210 call sign_tmp%destroy()
1216 imap%prim_exg_idx = -1
1217 do i = 1, imap%nr_exchanges
1218 if (imap%exchange_names(i) == this%primaryExchange%name)
then
1219 imap%prim_exg_idx = i
1258 deallocate (this%idxToGlobal)
1259 deallocate (this%boundaryCells)
1260 deallocate (this%connectedCells)
1270 integer(I4B),
intent(in) :: n
1271 integer(I4B),
intent(in) :: m
1274 integer(I4B) :: icell
1277 do icell = 1, this%nrOfBoundaryCells
1278 if (.not. this%boundaryCells(icell)%cell%v_model == &
1279 this%connectedCells(icell)%cell%v_model)
then
1284 if (this%boundaryCells(icell)%cell%index == n)
then
1285 if (this%connectedCells(icell)%cell%index == m)
then
1291 if (this%boundaryCells(icell)%cell%index == m)
then
1292 if (this%connectedCells(icell)%cell%index == n)
then
subroutine, public dis_transform_xy(x, y, xorigin, yorigin, angrot, xglo, yglo)
Get global (x, y) coordinates from cell-local coordinates.
class(basemodeltype) function, pointer, public getbasemodelfromlist(list, idx)
subroutine, public fillisym(neq, nja, ia, ja, isym)
Function to fill the isym array.
subroutine, public filljas(neq, nja, ia, ja, isym, jas)
Function to fill the jas array.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenmodelname
maximum length of the model name
real(dp), parameter dtwopi
real constant
real(dp), parameter dpi
real constant
real(dp), parameter dpio180
real constant
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
integer(i4b) function, public getcsrindex(i, j, ia, ja)
Return index for element i,j in CSR storage,.
Refactoring issues towards parallel:
recursive subroutine addneighbors(this, cellNbrs, depth, mask, interior)
recursive subroutine maskinternalconnections(this, cell, nbrCell, level)
Recursively mask connections, increasing the level as we go.
integer(i4b), parameter initnrneighbors
subroutine sortinterfacegrid(this)
Soft cell ids in the interface grid such that.
subroutine getdiscretization(this, disu)
Sets the discretization (DISU) after all preprocessing by this grid connection has been done,...
subroutine addtoregionalmodels(this, v_model)
Add a model to a list of all regional models.
subroutine createconnectionmask(this)
Create the connection masks.
subroutine connectcell(this, idx1, v_model1, idx2, v_model2)
Connect neighboring cells at the interface by storing them in the boundary cell and connected cell ar...
subroutine buildconnections(this)
Builds a sparse matrix holding all cell connections,.
integer(i4b) function get_regional_offset(this, v_model)
Get the offset for a regional model.
subroutine addtoglobalmap(this, ifaceIdx, cell)
Add entry to lookup table, inflating when necessary.
subroutine fillconnectiondatafromexchanges(this)
Fill connection data (ihc, cl1, ...) for.
subroutine setmaskonconnection(this, cell, nbrCell, level)
Set a mask on the connection from a cell to its neighbor, (and not the transposed!...
subroutine addneighborcell(this, cellNbrs, newNbrIdx, v_nbr_model, mask)
Add neighboring cell to tree structure.
subroutine allocatescalars(this)
Allocate scalar data.
subroutine extendconnection(this)
Extend the connection topology to deal with higher levels of connectivity (neighbors-of-neighbors,...
subroutine construct(this, model, nrOfPrimaries, connectionName)
Construct the GridConnection and allocate the data structures for the primary connections.
recursive subroutine registerinterfacecells(this, cellWithNbrs)
Recursively set interface cell indexes and.
subroutine makeprimaryconnections(this, sparse)
Add primary connections to the sparse data structure.
subroutine connectprimaryexchange(this, primEx)
Make connections for the primary exchange.
subroutine compressglobalmap(this)
Compress lookup table to get rid of unused entries.
recursive subroutine connectneighborcells(this, cell, sparse)
Recursively add higher order connections (from cells neighboring the primarily connected cells) to th...
integer(i4b) function getinterfaceindexbyindexmodel(this, index, v_model)
Get interface index from a model pointer and the local index.
subroutine addremoteneighbors(this, cellNbrs, mask)
Add cell neighbors across models using the stored exchange data structures.
logical function isperiodic(this, n, m)
Test if the connection between nodes within.
integer(i4b) function getinterfaceindexbycell(this, cell)
Get interface index from global cell.
subroutine fillconnectiondatainternal(this)
Fill connection data (ihc, cl1, ...) for.
subroutine buildinterfacemap(this)
Build interface map object for outside use.
subroutine, public quicksortgrid(array, arraySize, idxToGlobal, z_only)
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_warning(msg, substring)
Store warning message.
subroutine, public store_error(msg, terminate)
Store an error message.
class(virtualexchangetype) function, pointer, public get_virtual_exchange(exg_id)
Returns a virtual exchange with the specified id.
class(virtualmodeltype) function, pointer, public get_virtual_model_from_list(model_list, idx)
Highest level model type. All models extend this parent type.
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...
Unstructured grid discretization.
This class is used to construct the connections object for the interface model's spatial discretizati...
A generic heterogeneous doubly-linked list.
The Virtual Exchange is based on two Virtual Models and is therefore not always strictly local or rem...