BLOCKS: Rewrite 2D neighbor' pointers update in derefine_block().
This update of 2D neighbor' pointers for derefined block iterates over corners instead of updating each neighbor's pointer explicitely. It updates both, edge and corner neighbor pointers of connected neighbors at once. Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
939f3106cb
commit
ebed23ef71
189
src/blocks.F90
189
src/blocks.F90
@ -2222,164 +2222,57 @@ module blocks
|
|||||||
end do ! jp = 1, nsides
|
end do ! jp = 1, nsides
|
||||||
#endif /* NDIMS == 2 */
|
#endif /* NDIMS == 2 */
|
||||||
|
|
||||||
! update neighbor's edge pointers
|
! update neighbor pointers of the neighbor blocks
|
||||||
!
|
!
|
||||||
#if NDIMS == 2
|
#if NDIMS == 2
|
||||||
! corner (1,1)
|
do jp = 1, nsides
|
||||||
! X
|
jr = 3 - jp
|
||||||
if (associated(pmeta%edges(1,1,1)%ptr)) then
|
do ip = 1, nsides
|
||||||
pneigh => pmeta%edges(1,1,1)%ptr
|
ir = 3 - ip
|
||||||
pneigh%edges(1,2,1)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(2,2,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(1,1,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,1,2)%ptr
|
|
||||||
pneigh%edges(2,1,2)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(2,2,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
|
|
||||||
! child (2,1)
|
!--- update neighbor's edge pointers ---
|
||||||
! X
|
|
||||||
if (associated(pmeta%edges(2,1,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,1,1)%ptr
|
|
||||||
pneigh%edges(2,2,1)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(1,2,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(2,1,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,1,2)%ptr
|
|
||||||
pneigh%edges(1,1,2)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(1,2,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
|
|
||||||
! child (1,2)
|
|
||||||
! X
|
|
||||||
if (associated(pmeta%edges(1,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,1)%ptr
|
|
||||||
pneigh%edges(1,1,1)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(2,1,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(1,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(1,2,2)%ptr
|
|
||||||
pneigh%edges(2,2,2)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(2,1,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
|
|
||||||
! child (2,2)
|
|
||||||
! X
|
|
||||||
if (associated(pmeta%edges(2,2,1)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,1)%ptr
|
|
||||||
pneigh%edges(2,1,1)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(1,1,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
! Y
|
|
||||||
if (associated(pmeta%edges(2,2,2)%ptr)) then
|
|
||||||
pneigh => pmeta%edges(2,2,2)%ptr
|
|
||||||
pneigh%edges(1,2,2)%ptr => pmeta
|
|
||||||
if (pneigh%level > pmeta%level) pneigh%edges(1,1,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
#endif /* NDIMS == 2 */
|
|
||||||
|
|
||||||
! update neighbor's corner pointers
|
|
||||||
!
|
!
|
||||||
#if NDIMS == 2
|
! along X-direction
|
||||||
! corner (1,1)
|
!
|
||||||
pchild => pmeta%child(1)%ptr
|
pneigh => pmeta%edges(ip,jp,1)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
|
pneigh%edges(ip,jr,1)%ptr => pmeta
|
||||||
|
if (pneigh%level > pmeta%level) pneigh%edges(ir,jr,1)%ptr => pmeta
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
if (associated(pchild%corners(1,1)%ptr)) then
|
! along Y-direction
|
||||||
pneigh => pchild%corners(1,1)%ptr
|
!
|
||||||
pneigh%corners(2,2)%ptr => pmeta
|
pneigh => pmeta%edges(ip,jp,2)%ptr
|
||||||
end if
|
if (associated(pneigh)) then
|
||||||
if (associated(pchild%corners(2,1)%ptr)) then
|
pneigh%edges(ir,jp,2)%ptr => pmeta
|
||||||
pneigh => pchild%corners(2,1)%ptr
|
if (pneigh%level > pmeta%level) pneigh%edges(ir,jr,2)%ptr => pmeta
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(4)%ptr%id) then
|
|
||||||
pneigh%corners(1,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(1,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(1,2)%ptr
|
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(4)%ptr%id) then
|
|
||||||
pneigh%corners(2,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
end if
|
||||||
|
|
||||||
! corner (2,1)
|
!--- update neighbor's corner pointers ---
|
||||||
pchild => pmeta%child(2)%ptr
|
!
|
||||||
|
! neighbor corner linked to the parent's corner
|
||||||
|
!
|
||||||
|
pneigh => pmeta%corners(ip,jp)%ptr
|
||||||
|
if (associated(pneigh)) pneigh%corners(ir,jr)%ptr => pmeta
|
||||||
|
|
||||||
if (associated(pchild%corners(1,1)%ptr)) then
|
! nullify neighbor corners pointing to parent's edges
|
||||||
pneigh => pchild%corners(1,1)%ptr
|
!
|
||||||
if (pneigh%level == pchild%level) then
|
! along X-direction
|
||||||
if (pneigh%id /= pmeta%child(3)%ptr%id) then
|
!
|
||||||
pneigh%corners(2,2)%ptr => pmeta
|
pneigh => pmeta%edges(ir,jp,1)%ptr
|
||||||
end if
|
if (associated(pneigh)) then
|
||||||
end if
|
if (pneigh%level > pmeta%level) nullify(pneigh%corners(ip,jr)%ptr)
|
||||||
end if
|
end if ! pneigh associated
|
||||||
if (associated(pchild%corners(2,1)%ptr)) then
|
|
||||||
pneigh => pchild%corners(2,1)%ptr
|
|
||||||
pneigh%corners(1,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(2,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(2,2)%ptr
|
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(3)%ptr%id) then
|
|
||||||
pneigh%corners(1,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
|
|
||||||
! corner (1,2)
|
! along Y-direction
|
||||||
pchild => pmeta%child(3)%ptr
|
!
|
||||||
|
pneigh => pmeta%edges(ip,jr,2)%ptr
|
||||||
|
if (associated(pneigh)) then
|
||||||
|
if (pneigh%level > pmeta%level) nullify(pneigh%corners(ir,jp)%ptr)
|
||||||
|
end if ! pneigh associated
|
||||||
|
|
||||||
if (associated(pchild%corners(1,1)%ptr)) then
|
end do ! ip = 1, nsides
|
||||||
pneigh => pchild%corners(1,1)%ptr
|
end do ! jp = 1, nsides
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(2)%ptr%id) then
|
|
||||||
pneigh%corners(2,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(1,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(1,2)%ptr
|
|
||||||
pneigh%corners(2,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(2,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(2,2)%ptr
|
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(2)%ptr%id) then
|
|
||||||
pneigh%corners(1,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
|
|
||||||
! corner (2,2)
|
|
||||||
pchild => pmeta%child(4)%ptr
|
|
||||||
|
|
||||||
if (associated(pchild%corners(2,1)%ptr)) then
|
|
||||||
pneigh => pchild%corners(2,1)%ptr
|
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(1)%ptr%id) then
|
|
||||||
pneigh%corners(1,2)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(1,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(1,2)%ptr
|
|
||||||
if (pneigh%level == pchild%level) then
|
|
||||||
if (pneigh%id /= pmeta%child(1)%ptr%id) then
|
|
||||||
pneigh%corners(2,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
if (associated(pchild%corners(2,2)%ptr)) then
|
|
||||||
pneigh => pchild%corners(2,2)%ptr
|
|
||||||
pneigh%corners(1,1)%ptr => pmeta
|
|
||||||
end if
|
|
||||||
#endif /* NDIMS == 2 */
|
#endif /* NDIMS == 2 */
|
||||||
|
|
||||||
! iterate over dimensions, sides, and faces
|
! iterate over dimensions, sides, and faces
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user