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:
Grzegorz Kowal 2014-07-22 03:51:00 -03:00
parent 939f3106cb
commit ebed23ef71

View File

@ -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