tem_adapt_dump_newMesh Subroutine

public subroutine tem_adapt_dump_newMesh(levelDesc, tree, proc)

This routine prepares the ground work for dumping the adapted mesh to disk. The new treeIDs which were created while adaptive refinement are sorted within the levelDescriptor elem type, and then passed to the dump_treelmesh routine for dumping.

will be written for that

Arguments

Type IntentOptional Attributes Name
type(tem_levelDesc_type), intent(inout) :: levelDesc(:)
type(treelmesh_type), intent(inout) :: tree
type(tem_comm_env_type), intent(in) :: proc

Calls

proc~~tem_adapt_dump_newmesh~~CallsGraph proc~tem_adapt_dump_newmesh tem_adapt_dump_newMesh interface~append~11 append proc~tem_adapt_dump_newmesh->interface~append~11 interface~init~24 init proc~tem_adapt_dump_newmesh->interface~init~24 interface~positionofval~5 positionofval proc~tem_adapt_dump_newmesh->interface~positionofval~5 mpi_allreduce mpi_allreduce proc~tem_adapt_dump_newmesh->mpi_allreduce proc~dump_treelmesh dump_treelmesh proc~tem_adapt_dump_newmesh->proc~dump_treelmesh proc~tem_directchildren tem_directChildren proc~tem_adapt_dump_newmesh->proc~tem_directchildren proc~tem_levelof tem_LevelOf proc~tem_adapt_dump_newmesh->proc~tem_levelof proc~append_ga_dynlong append_ga_dynlong interface~append~11->proc~append_ga_dynlong proc~append_ga_dynlong_vec append_ga_dynlong_vec interface~append~11->proc~append_ga_dynlong_vec proc~init_ga2d_real init_ga2d_real interface~init~24->proc~init_ga2d_real proc~posofval_label posofval_label interface~positionofval~5->proc~posofval_label mpi_exscan mpi_exscan proc~dump_treelmesh->mpi_exscan mpi_file_close mpi_file_close proc~dump_treelmesh->mpi_file_close mpi_file_open mpi_file_open proc~dump_treelmesh->mpi_file_open mpi_file_set_view mpi_file_set_view proc~dump_treelmesh->mpi_file_set_view mpi_file_write_all mpi_file_write_all proc~dump_treelmesh->mpi_file_write_all mpi_type_commit mpi_type_commit proc~dump_treelmesh->mpi_type_commit mpi_type_contiguous mpi_type_contiguous proc~dump_treelmesh->mpi_type_contiguous mpi_type_free mpi_type_free proc~dump_treelmesh->mpi_type_free mpi_type_size mpi_type_size proc~dump_treelmesh->mpi_type_size proc~check_mpi_error check_mpi_error proc~dump_treelmesh->proc~check_mpi_error proc~dump_tem_global dump_tem_global proc~dump_treelmesh->proc~dump_tem_global proc~tem_create_endiansuffix tem_create_EndianSuffix proc~dump_treelmesh->proc~tem_create_endiansuffix

Source Code

  subroutine tem_adapt_dump_newMesh(levelDesc, tree, proc )
    ! ---------------------------------------------------------------------------
    type(tem_levelDesc_type), intent(inout) :: levelDesc(:)
    type(treelmesh_type)    , intent(inout) :: tree
    type(tem_comm_env_type) , intent(in)    :: proc
    ! ---------------------------------------------------------------------------
    ! A temporary list of TreeIDs
    type( grw_longArray_type )  :: loc_treeID
    type( treelmesh_type )      :: newTree
    integer(kind=long_k) :: children(8)
    integer :: iElem, iChild
    integer :: elemPos, level
    integer :: iErr
    ! ---------------------------------------------------------------------------
    call init( me     = loc_treeID, length = tree%nElems )

    ! We loop over all the elements of OLD/ORIGINAL mesh
    ! this nElems will be updated later and has to be stored
    ! for this routine
    ! If an element was sacrificed, its 8 children are appended
    ! at its original position in the tree to preserve the space filling curve
    do iElem = 1, tree%nElems
      level   = tem_levelOf(tree%treeID(iElem) )
      elemPos = PositionOfVal( me  = levelDesc(level)%elem%tID,                &
        &                      val = tree%treeID(iElem) )
      if( .not. levelDesc(level)%elem%property%val(elemPos) == prp_chgElems ) then
        call append( me  = loc_treeID,           &
                     val = tree%treeID(iElem) )
      else
        children = tem_directChildren( tree%treeID(iElem) )
        do iChild = 1, 8
          call append( me  = loc_treeID,          &
            &          val = children(iChild) )
        end do
      end if
    end do
! @todo: The children need to be added recursively, and a separate routine
!! will be written for that
! @todo: A separate routine for coarsening needs to be implemented

    ! Initialize the newTree and inherit some data from old
    allocate( newTree%treeID          (loc_treeID%nVals) )
    allocate( newTree%Part_First      (loc_treeID%nVals) )
    allocate( newTree%Part_Last       (loc_treeID%nVals) )
    allocate( newTree%ElemPropertyBits(loc_treeID%nVals) )
    allocate( newTree%pathList        (loc_treeID%nVals) )

    newTree%treeID = loc_treeID%val
    newTree%nElems = loc_treeID%nVals
    newTree%global = tree%global

    ! Now dump the mesh to disk
    !KJ: This needs to be re-thought as where and when to do it
    call MPI_ALLREDUCE( loc_treeID%nVals, newTree%global%nElems, 1, MPI_INTEGER, &
      &                 MPI_SUM, proc%comm, iErr )
    call dump_treelmesh( me = newTree )

  end subroutine tem_adapt_dump_newMesh