hecmw_adapt_get_new_cell_info.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
!C
!C***
!C*** hecmw_adapt_GET_NEW_CELL_INFO
!C***
!C
!C    get new CELL info.
!C
subroutine hecmw_adapt_get_new_cell_info (hecMESH)
 
  use hecmw_util
  implicit real*8 (a-h,o-z)
 
  integer(kind=kint), dimension(:), allocatable :: IW1
  type (hecmwST_local_mesh) :: hecMESH
 
  allocate (iw1(hecmesh%n_elem))
  do neib= 1, hecmesh%n_neighbor_pe
    icou= 0
    neib0= hecmesh%neighbor_pe(neib)
    do icel= 1, hecmesh%n_elem
      ic1= hecmesh%elem_ID(2*icel)
      if (ic1.eq.neib0 .and. hecmesh%adapt_type(icel).ne.0) then
        is= hecmesh%adapt_children_index(icel-1) + 1
        ie= hecmesh%adapt_children_index(icel)
        ics= hecmesh%adapt_children_local(is)
        if (hecmesh%when_i_was_refined_elem(ics).eq.                &
            &          hecmesh%n_adapt) then
          do k= is, ie
            if (hecmesh%adapt_children_item(2*k-1).ne.0) then
              icou = icou + 1
              iw1(icou)= hecmesh%adapt_children_item(2*k-1)
            endif
          enddo
        endif
      endif
    enddo
 
    icou= 0
    do icel= 1, hecmesh%n_elem
      ic1= hecmesh%elem_ID(2*icel)
      ic2= hecmesh%when_i_was_refined_elem(icel)
      if (ic1.eq.neib0 .and. ic2.eq.hecmesh%n_adapt) then
        icou= icou + 1
        hecmesh%elem_ID(2*icel-1)= iw1(icou)
      endif
    enddo
  enddo
 
  deallocate (iw1)
 
end subroutine hecmw_adapt_get_new_cell_info