gather_isafety Subroutine

private subroutine gather_isafety()

Uses

  • proc~~gather_isafety~~UsesGraph proc~gather_isafety gather_isafety module~mod_comm_lib mod_comm_lib proc~gather_isafety->module~mod_comm_lib module~mod_forest mod_forest proc~gather_isafety->module~mod_forest module~mod_global_parameters mod_global_parameters proc~gather_isafety->module~mod_global_parameters module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

Make every rank's isafety flags known to every rank.

The flags live in a [max_blocks, 0:npe-1] table, but only the leaves carry a meaningful value and only the owner of a leaf writes one, so gathering the whole table would move npe*max_blocks integers - sized by the allocated bound rather than by the blocks that exist. Instead each rank contributes just its own leaves, in Morton order, and the gather moves nleafs integers in total.

sfc(1:2, Morton_no) is the globally replicated (igrid, ipe) of each leaf, and Morton_start/Morton_stop cut it into the per-rank runs, so the counts and displacements are known to everyone without a handshake and the scatter back into (igrid, ipe) needs no inverse map.

Arguments

None

Calls

proc~~gather_isafety~~CallsGraph proc~gather_isafety gather_isafety mpi_allgatherv mpi_allgatherv proc~gather_isafety->mpi_allgatherv proc~mpistop mpistop proc~gather_isafety->proc~mpistop mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

proc~~gather_isafety~~CalledByGraph proc~gather_isafety gather_isafety proc~selectgrids selectgrids proc~selectgrids->proc~gather_isafety proc~amr_coarsen_refine amr_coarsen_refine proc~amr_coarsen_refine->proc~selectgrids proc~main main proc~main->proc~selectgrids proc~resettree_convert resettree_convert proc~main->proc~resettree_convert proc~settree settree proc~main->proc~settree proc~timeintegration timeintegration proc~main->proc~timeintegration proc~resettree resettree proc~resettree->proc~amr_coarsen_refine proc~resettree_convert->proc~amr_coarsen_refine proc~settree->proc~amr_coarsen_refine program~agile agile program~agile->proc~main proc~timeintegration->proc~resettree

Source Code

  subroutine gather_isafety
    use mod_forest
    use mod_global_parameters
    use mod_comm_lib, only: mpistop

    integer :: Morton_no, ipe, nown
    integer :: cnt(0:npe-1), disp(0:npe-1)

    do ipe = 0, npe-1
      cnt(ipe)  = Morton_stop(ipe) - Morton_start(ipe) + 1
      disp(ipe) = Morton_start(ipe) - 1
    end do
    nown = cnt(mype)

    if (.not. allocated(sndsafety)) then
      allocate(sndsafety(max(nleafs,1)), rcvsafety(max(nleafs,1)))
    else if (size(rcvsafety) < nleafs) then
      deallocate(sndsafety, rcvsafety)
      allocate(sndsafety(max(nleafs,1)), rcvsafety(max(nleafs,1)))
    end if

    do Morton_no = Morton_start(mype), Morton_stop(mype)
      ! the run this rank owns must be the run sfc says it owns, or the
      ! displacements below would scatter another rank's flags
      if (sfc(2,Morton_no) /= mype) call mpistop(&
         "gather_isafety: Morton range disagrees with the space-filling curve")
      sndsafety(Morton_no-Morton_start(mype)+1) = isafety(sfc(1,Morton_no),mype)
    end do

    call MPI_ALLGATHERV(sndsafety, nown, MPI_INTEGER, rcvsafety, cnt, disp,&
       MPI_INTEGER, icomm, ierrmpi)

    isafety = -1
    do Morton_no = 1, nleafs
      isafety(sfc(1,Morton_no),sfc(2,Morton_no)) = rcvsafety(Morton_no)
    end do

  end subroutine gather_isafety