gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

BLOCKS: Rewrite 2D neighbor pointers update in derefine_block().

Browse Source 
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
1 changed files with 51 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

171
src/blocks.F90
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