load_balance Subroutine

public subroutine load_balance()

Uses

  • proc~~load_balance~~UsesGraph proc~load_balance load_balance mod_amr_solution_node mod_amr_solution_node proc~load_balance->mod_amr_solution_node module~mod_forest mod_forest proc~load_balance->module~mod_forest module~mod_functions_forest mod_functions_forest proc~load_balance->module~mod_functions_forest module~mod_global_parameters mod_global_parameters proc~load_balance->module~mod_global_parameters module~mod_space_filling_curve mod_space_filling_curve proc~load_balance->module~mod_space_filling_curve module~mod_mpi_wrapper mod_mpi_wrapper module~mod_functions_forest->module~mod_mpi_wrapper 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_mpi_wrapper->mpi module~mod_variables->module~mod_basic_types

reallocate blocks into processors for load balance

Arguments

None

Calls

proc~~load_balance~~CallsGraph proc~load_balance load_balance getnode getnode proc~load_balance->getnode mpi_waitall mpi_waitall proc~load_balance->mpi_waitall proc~amr_morton_order amr_Morton_order proc~load_balance->proc~amr_morton_order proc~change_ipe_tree_leaf change_ipe_tree_leaf proc~load_balance->proc~change_ipe_tree_leaf proc~exchange_migrated_blocks exchange_migrated_blocks proc~load_balance->proc~exchange_migrated_blocks proc~get_morton_range get_Morton_range proc~load_balance->proc~get_morton_range proc~lb_recv lb_recv proc~load_balance->proc~lb_recv proc~lb_send lb_send proc~load_balance->proc~lb_send putnode putnode proc~load_balance->putnode proc~mpistop mpistop proc~amr_morton_order->proc~mpistop proc~exchange_migrated_blocks->mpi_waitall mpi_get_count mpi_get_count proc~exchange_migrated_blocks->mpi_get_count proc~layout_runs layout_runs proc~exchange_migrated_blocks->proc~layout_runs proc~mpi_irecv_wrapper mpi_irecv_wrapper proc~exchange_migrated_blocks->proc~mpi_irecv_wrapper proc~mpi_isend_wrapper mpi_isend_wrapper proc~exchange_migrated_blocks->proc~mpi_isend_wrapper proc~exchange_migrated_blocks->proc~mpistop alloc_node alloc_node proc~lb_recv->alloc_node proc~lb_recv->proc~mpi_irecv_wrapper proc~lb_recv->proc~mpistop proc~lb_send->proc~mpi_isend_wrapper proc~lb_send->proc~mpistop proc~rank_keys rank_keys proc~layout_runs->proc~rank_keys mpi_irecv mpi_irecv proc~mpi_irecv_wrapper->mpi_irecv mpi_isend mpi_isend proc~mpi_isend_wrapper->mpi_isend mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

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

Source Code

  subroutine load_balance
    use mod_forest
    use mod_global_parameters
    use mod_space_filling_curve
    use mod_amr_solution_node, only: getnode,putnode
    use mod_functions_forest, only: change_ipe_tree_leaf

    integer :: Morton_no, ipe
    !> MPI recv send variables for staggered-variable AMR
    integer :: itag_stg
    integer, dimension(:,:), allocatable :: recvstatus_stg, sendstatus_stg

    ! Jannis: for now, not using version for passive/active blocks
    call get_Morton_range()

    if (npe==1) then
       sfc_to_igrid(:)=sfc(1,Morton_start(mype):Morton_stop(mype))
       return
    end if

    irecv=0
    isend=0
    n_lb_snd=0
    n_lb_rcv=0
    if (.not.allocated(recvrequest)) then
       allocate(recvstatus(MPI_STATUS_SIZE,npe),recvrequest(npe),&
           sendstatus(MPI_STATUS_SIZE,npe),sendrequest(npe))
       allocate(lb_send_pe(npe),lb_send_pe_off(npe),lb_send_pe_len(npe),&
           lb_recv_pe(npe),lb_recv_pe_off(npe),lb_recv_pe_len(npe))
    end if
    recvrequest=MPI_REQUEST_NULL
    sendrequest=MPI_REQUEST_NULL

    if(stagger_grid) then
      allocate(recvstatus_stg(MPI_STATUS_SIZE,max_blocks*3),&
         recvrequest_stg(max_blocks*3), sendstatus_stg(MPI_STATUS_SIZE,&
         max_blocks*3),sendrequest_stg(max_blocks*3))
      recvrequest_stg=MPI_REQUEST_NULL
      sendrequest_stg=MPI_REQUEST_NULL
    end if

    ! Only the descriptors are allocated up front, and they are integers.  The
    ! data buffers are sized by what actually migrates, in
    ! exchange_migrated_blocks, once the walk below has counted it.
    if ( .not. allocated(lb_snd_igrid) ) then
       allocate( lb_snd_igrid(max_blocks), lb_snd_ibuf(max_blocks), &
            lb_snd_dest(max_blocks), lb_snd_key(max_blocks), &
            lb_rcv_igrid(max_blocks), lb_rcv_ibuf(max_blocks), &
            lb_rcv_src(max_blocks), lb_rcv_key(max_blocks) )
    end if

    do ipe=0,npe-1; do Morton_no=Morton_start(ipe),Morton_stop(ipe)
       recv_ipe=ipe

       send_igrid=sfc(1,Morton_no)
       send_ipe=sfc(2,Morton_no)

       if (recv_ipe/=send_ipe) then
          ! get an igrid number for the new node in recv_ipe processor
          recv_igrid=getnode(recv_ipe)
          ! update node igrid and ipe on the tree
          call change_ipe_tree_leaf(recv_igrid,recv_ipe,send_igrid,send_ipe)
          ! receive physical data of the new node in recv_ipe processor
          if (recv_ipe==mype) call lb_recv
          ! send physical data of the old node in send_ipe processor
          if (send_ipe==mype) call lb_send
       end if
       if (recv_ipe==mype) then
          if (recv_ipe==send_ipe) then
             sfc_to_igrid(Morton_no)=send_igrid
          else
             sfc_to_igrid(Morton_no)=recv_igrid
          end if
       end if
    end do; end do

    ! Lay the blocks out per peer, exchange them in one message each, and apply
    ! them.  The walk above only recorded descriptors.
    call exchange_migrated_blocks

    ! The staggered path still posts per block; see the note in lb_send.  It is
    ! unreachable here (stagger_grid is false and fix_edges is not called), so
    ! it is left as it was found.
    if(stagger_grid) then
      if (irecv>0) call MPI_WAITALL(irecv,recvrequest_stg,recvstatus_stg,&
         ierrmpi)
      if (isend>0) call MPI_WAITALL(isend,sendrequest_stg,sendstatus_stg,&
         ierrmpi)
   end if

    if(stagger_grid) deallocate(recvstatus_stg,recvrequest_stg,sendstatus_stg,&
       sendrequest_stg)

    ! post processing
    do ipe=0,npe-1; do Morton_no=Morton_start(ipe),Morton_stop(ipe)
       recv_ipe=ipe

       send_igrid=sfc(1,Morton_no)
       send_ipe=sfc(2,Morton_no)

       if (recv_ipe/=send_ipe) then
          !if (send_ipe==mype) call dealloc_node(send_igrid)
          call putnode(send_igrid,send_ipe)
       end if
    end do; end do


    ! Update sfc array: igrid and ipe info in space filling curve
    call amr_Morton_order()

  end subroutine load_balance