Balance2to1_QuadTreeMesh2D Subroutine

public subroutine Balance2to1_QuadTreeMesh2D(this)

Enforce the 2:1 balance condition: no leaf face may separate elements differing by more than one refinement level. Iterates to a fixed point - in each sweep, any leaf whose equal-or-larger neighbour is a leaf two or more levels coarser triggers refinement of that coarser neighbour; refinement can ripple, so sweeps repeat until nothing changes. The leaf set is rebuilt on return.

Arguments

TypeIntentOptionalAttributesName
class(QuadTreeMesh2D), intent(inout) :: this

Contents


Source Code

  subroutine Balance2to1_QuadTreeMesh2D(this)
    !! Enforce the 2:1 balance condition: no leaf face may separate elements differing by more
    !! than one refinement level. Iterates to a fixed point - in each sweep, any leaf whose
    !! equal-or-larger neighbour is a leaf two or more levels coarser triggers refinement of that
    !! coarser neighbour; refinement can ripple, so sweeps repeat until nothing changes. The leaf
    !! set is rebuilt on return.
    implicit none
    class(QuadTreeMesh2D),intent(inout) :: this
    ! Local
    integer :: li,s,node,nbr,ns,nf,nSnap
    integer,allocatable :: snap(:)
    logical :: changed

    do
      changed = .false.
      nSnap = this%nLeaves
      allocate(snap(1:nSnap))
      snap(1:nSnap) = this%leaf(1:nSnap)

      do li = 1,nSnap
        node = snap(li)
        if(this%child(1,node) /= 0) cycle ! refined earlier in this sweep
        do s = 1,4
          call this%FaceNeighbor(node,s,nbr,ns,nf)
          if(nbr /= 0) then
            if(this%child(1,nbr) == 0 .and. this%level(nbr) <= this%level(node)-2) then
              call this%RefineNode(nbr)
              changed = .true.
            endif
          endif
        enddo
      enddo

      deallocate(snap)
      call this%RebuildLeaves()
      if(.not. changed) exit
    enddo

  endsubroutine Balance2to1_QuadTreeMesh2D