tem_create_tree_from_sub Subroutine

public subroutine tem_create_tree_from_sub(intree, subtree, newtree, keep_props)

Create newtree out of intree by restricting to the elements of subtree.

The new mesh will have no properties

Arguments

Type IntentOptional Attributes Name
type(treelmesh_type), intent(in) :: intree

The tree on which the subtree is defined.
type(tem_subTree_type), intent(in) :: subtree

Subtree describing the part of the mesh to create a new mesh from.
type(treelmesh_type), intent(out) :: newtree

Resulting new tree with the elements selected by subtree from newtree.
logical, intent(in), optional :: keep_props

Flag to indicate whether to keep properties from intree also in newtree.

If this is true, the properties will be copied from the intree to the newtree. An actual copy is done, as we can not rely on the pointer targets in intree to exist further on. Default is .false., which means all properties will be dropped and newtree will have no properties at all.

Calls

proc~~tem_create_tree_from_sub~~CallsGraph proc~tem_create_tree_from_sub tem_create_tree_from_sub proc~tem_prop_countelems tem_prop_countelems proc~tem_create_tree_from_sub->proc~tem_prop_countelems mpi_bcast mpi_bcast proc~tem_create_tree_from_sub->mpi_bcast mpi_allgather mpi_allgather proc~tem_create_tree_from_sub->mpi_allgather proc~gather_property gather_property proc~tem_create_tree_from_sub->proc~gather_property mpi_exscan mpi_exscan proc~tem_create_tree_from_sub->mpi_exscan mpi_allreduce mpi_allreduce proc~tem_prop_countelems->mpi_allreduce proc~gather_property->mpi_exscan

Contents

Source Code

tem_create_tree_from_sub

Source Code

  subroutine tem_create_tree_from_sub(intree, subtree, newtree, keep_props)
    !> The tree on which the subtree is defined.
    type(treelmesh_type), intent(in) :: intree

    !> Subtree describing the part of the mesh to create a new mesh from.
    type(tem_subtree_type), intent(in) :: subtree

    !> Resulting new tree with the elements selected by subtree from newtree.
    type(treelmesh_type), intent(out) :: newtree

    !> Flag to indicate whether to keep properties from intree also in newtree.
    !!
    !! If this is true, the properties will be copied from the intree to the
    !! newtree. An actual copy is done, as we can not rely on the pointer
    !! targets in intree to exist further on.
    !! Default is `.false.`, which means all properties will be dropped and
    !! newtree will have no properties at all.
    logical, optional, intent(in) :: keep_props

    logical :: withprop

    integer(kind=long_k) :: nNewElems
    integer :: iProp
    integer :: iError

    withprop = .false.
    if (present(keep_props)) withprop = keep_props

    newtree%global%maxlevel = intree%global%maxlevel
    newtree%global%minlevel = intree%global%minlevel
    newtree%global%origin = intree%global%origin
    newtree%global%BoundingCubeLength = intree%global%BoundingCubeLength

    if (subtree%useGlobalMesh) then

      ! Copy complete tree, but ignore properties.
      newtree = intree

      nullify(newtree%global%property)
      nullify(newtree%property)

    else

      newtree%nelems = subtree%nElems
      nullify(newtree%global%property)
      nullify(newtree%property)
      newtree%global%comm = subtree%global%comm
      newtree%global%nparts = subtree%global%nparts
      newtree%global%myPart = subtree%global%myPart
      allocate(newtree%treeID(newtree%nelems))
      allocate(newtree%ElemPropertyBits(newtree%nelems))
      allocate(newtree%Part_First(newtree%global%nparts))
      allocate(newtree%Part_Last(newtree%global%nparts))
      newtree%treeID = intree%treeID(subtree%map2global)
      if (withprop) then
        newtree%ElemPropertyBits = intree%ElemPropertyBits(subtree%map2global)
      else
        newtree%ElemPropertyBits = 0_long_k
      end if
      nNewElems = int(newtree%nElems, kind=long_k)
      ! Overall number of elements in the new mesh and offsets.
      call MPI_Exscan(nNewelems, newtree%ElemOffset, 1, long_k_mpi, &
        &             MPI_SUM, newtree%global%comm, iError          )
      newtree%global%nElems = newtree%ElemOffset+nNewElems
      call MPI_Bcast( newtree%global%nElems, 1, long_k_mpi, &
        &             newtree%global%nParts-1,              &
        &             newtree%global%comm, iError           )

      call MPI_Allgather( newtree%treeID(1), 1, long_k_mpi,  &
        &                 newtree%Part_First, 1, long_k_mpi, &
        &                 newtree%global%comm, iError        )

      call MPI_Allgather( newtree%treeID(newtree%nElems), 1, long_k_mpi, &
        &                 newtree%Part_Last, 1, long_k_mpi,              &
        &                 newtree%global%comm, iError                    )

    end if

    if (withprop) then
      newtree%global%nProperties = intree%global%nProperties
      allocate(newtree%global%property(newtree%global%nProperties))
      allocate(newtree%property(newtree%global%nProperties))
      newtree%global%property = intree%global%property
      do iProp=1,newtree%global%nProperties
        ! In the new mesh there may be a different number of elements with
        ! this property, recount them and update the header information
        ! accordingly.
        call tem_prop_countelems( me               = newtree%global            &
          &                                                 %Property(iProp),  &
          &                       elempropertybits = newtree%Elempropertybits, &
          &                       comm             = newtree%global%comm       )
        ! Now create the process local information on the property.
        call gather_Property( Property = newtree%Property(iProp),        &
          &                   Header   = newtree%global%Property(iProp), &
          &                   BitField = newtree%ElemPropertyBits,       &
          &                   comm     = newtree%global%comm             )
      end do
    else
      newtree%global%nProperties = 0
      allocate(newtree%global%property(0))
      allocate(newtree%property(0))
    end if

  end subroutine tem_create_tree_from_sub