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 pointer explicitely. It
updates both, edge and corner neighbor pointers at once.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2014-07-22 03:44:28 -03:00
parent 2b9513e776
commit 939f3106cb

View File

@ -2117,7 +2117,10 @@ module blocks
! local variables ! local variables
! !
integer :: i, j, k, l, p integer :: l , p , q
integer :: i , j , k
integer :: ip, jp, kp
integer :: ir, jr, kr
! local saved variables ! local saved variables
! !
@ -2161,144 +2164,62 @@ module blocks
end if end if
! update edge neighbor pointers of the parent ! update neighbor pointers of the parent block
! !
#if NDIMS == 2 #if NDIMS == 2
! child (1,1) do jp = 1, nsides
pchild => pmeta%child(1)%ptr jr = 3 - jp
! X do ip = 1, nsides
if (associated(pchild%edges(1,1,1)%ptr)) then ir = 3 - ip
pneigh => pchild%edges(1,1,1)%ptr
if (pneigh%id == pmeta%child(3)%ptr%id) then
pmeta%edges(1,1,1)%ptr => pmeta
else
pmeta%edges(1,1,1)%ptr => pchild%edges(1,1,1)%ptr
end if
end if
! Y
if (associated(pchild%edges(1,1,2)%ptr)) then
pneigh => pchild%edges(1,1,2)%ptr
if (pneigh%id == pmeta%child(2)%ptr%id) then
pmeta%edges(1,1,2)%ptr => pmeta
else
pmeta%edges(1,1,2)%ptr => pchild%edges(1,1,2)%ptr
end if
end if
! child (2,1) ! calculate the child index
pchild => pmeta%child(2)%ptr
! X
if (associated(pchild%edges(2,1,1)%ptr)) then
pneigh => pchild%edges(2,1,1)%ptr
if (pneigh%id == pmeta%child(4)%ptr%id) then
pmeta%edges(2,1,1)%ptr => pmeta
else
pmeta%edges(2,1,1)%ptr => pchild%edges(2,1,1)%ptr
end if
end if
! Y
if (associated(pchild%edges(2,1,2)%ptr)) then
pneigh => pchild%edges(2,1,2)%ptr
if (pneigh%id == pmeta%child(1)%ptr%id) then
pmeta%edges(2,1,2)%ptr => pmeta
else
pmeta%edges(2,1,2)%ptr => pchild%edges(2,1,2)%ptr
end if
end if
! child (1,2)
pchild => pmeta%child(3)%ptr
! X
if (associated(pchild%edges(1,2,1)%ptr)) then
pneigh => pchild%edges(1,2,1)%ptr
if (pneigh%id == pmeta%child(1)%ptr%id) then
pmeta%edges(1,2,1)%ptr => pmeta
else
pmeta%edges(1,2,1)%ptr => pchild%edges(1,2,1)%ptr
end if
end if
! Y
if (associated(pchild%edges(1,2,2)%ptr)) then
pneigh => pchild%edges(1,2,2)%ptr
if (pneigh%id == pmeta%child(4)%ptr%id) then
pmeta%edges(1,2,2)%ptr => pmeta
else
pmeta%edges(1,2,2)%ptr => pchild%edges(1,2,2)%ptr
end if
end if
! child (2,2)
pchild => pmeta%child(4)%ptr
! X
if (associated(pchild%edges(2,2,1)%ptr)) then
pneigh => pchild%edges(2,2,1)%ptr
if (pneigh%id == pmeta%child(2)%ptr%id) then
pmeta%edges(2,2,1)%ptr => pmeta
else
pmeta%edges(2,2,1)%ptr => pchild%edges(2,2,1)%ptr
end if
end if
! Y
if (associated(pchild%edges(2,2,2)%ptr)) then
pneigh => pchild%edges(2,2,2)%ptr
if (pneigh%id == pmeta%child(3)%ptr%id) then
pmeta%edges(2,2,2)%ptr => pmeta
else
pmeta%edges(2,2,2)%ptr => pchild%edges(2,2,2)%ptr
end if
end if
#endif /* NDIMS == 2 */
! update corner neighbor pointers of the parent
! !
#if NDIMS == 2 p = 2 * (jp - 1) + ip
! corner (1,1)
pchild => pmeta%child(1)%ptr
if (associated(pchild%corners(1,1)%ptr)) then ! associate pchild with the proper child
pneigh => pchild%corners(1,1)%ptr !
if (pneigh%id == pmeta%child(4)%ptr%id) then pchild => pmeta%child(p)%ptr
pmeta%corners(1,1)%ptr => pmeta
!--- update edge neighbor pointers ---
!
! along X-direction
!
pneigh => pchild%edges(ip,jp,1)%ptr
if (associated(pneigh)) then
q = 2 * (jr - 1) + ip
if (pneigh%id == pmeta%child(q)%ptr%id) then
pmeta%edges(ip,jp,1)%ptr => pmeta
else else
pmeta%corners(1,1)%ptr => pchild%corners(1,1)%ptr pmeta%edges(ip,jp,1)%ptr => pneigh
end if
end if end if
end if ! pneigh associated
! corner (2,1) ! along Y-direction
pchild => pmeta%child(2)%ptr !
pneigh => pchild%edges(ip,jp,2)%ptr
if (associated(pchild%corners(2,1)%ptr)) then if (associated(pneigh)) then
pneigh => pchild%corners(2,1)%ptr q = 2 * (jp - 1) + ir
if (pneigh%id == pmeta%child(3)%ptr%id) then if (pneigh%id == pmeta%child(q)%ptr%id) then
pmeta%corners(2,1)%ptr => pmeta pmeta%edges(ip,jp,2)%ptr => pmeta
else else
pmeta%corners(2,1)%ptr => pchild%corners(2,1)%ptr pmeta%edges(ip,jp,2)%ptr => pneigh
end if
end if end if
end if ! pneigh associated
! corner (1,2) !--- update corner neighbor pointers ---
pchild => pmeta%child(3)%ptr !
pneigh => pchild%corners(ip,jp)%ptr
if (associated(pchild%corners(1,2)%ptr)) then if (associated(pneigh)) then
pneigh => pchild%corners(1,2)%ptr q = 2 * (jr - 1) + ir
if (pneigh%id == pmeta%child(2)%ptr%id) then if (pneigh%id == pmeta%child(q)%ptr%id) then
pmeta%corners(1,2)%ptr => pmeta pmeta%corners(ip,jp)%ptr => pmeta
else else
pmeta%corners(1,2)%ptr => pchild%corners(1,2)%ptr pmeta%corners(ip,jp)%ptr => pneigh
end if
end if end if
end if ! pneigh associated
! corner (2,2) end do ! ip = 1, nsides
pchild => pmeta%child(4)%ptr end do ! jp = 1, nsides
if (associated(pchild%corners(2,2)%ptr)) then
pneigh => pchild%corners(2,2)%ptr
if (pneigh%id == pmeta%child(1)%ptr%id) then
pmeta%corners(2,2)%ptr => pmeta
else
pmeta%corners(2,2)%ptr => pchild%corners(2,2)%ptr
end if
end if
#endif /* NDIMS == 2 */ #endif /* NDIMS == 2 */
! update neighbor's edge pointers ! update neighbor's edge pointers