Inverse Communication: Communicate, which elements each process needs from me.
In this routine, we send the treeIDs of the halo elements to the processes, where they are located. Later on, we fill these halos locally with information from these processes (sourceProcs). In this routine however, we now SEND information to these sourceProcs, so do not get confused here.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(tem_levelDesc_type), | intent(inout) | :: | levelDesc(tree%global%minlevel:) |
the level descriptor to be filled |
||
| type(tem_comm_env_type), | intent(in) | :: | proc |
Process description to use. |
||
| type(treelmesh_type), | intent(in) | :: | tree |
the global tree |
||
| integer, | intent(in) | :: | iLevel |
current level |
||
| type(tem_stencilHeader_type), | intent(in) | :: | stencil |
stencil definition |
||
| type(tem_path_type), | intent(in) | :: | pathFirst(:) |
first and last treeID path in every process |
||
| type(tem_path_type), | intent(in) | :: | pathLast(:) |
first and last treeID path in every process |
subroutine request_remoteHalos( levelDesc, proc, tree, iLevel, stencil,& & pathFirst, pathLast ) ! --------------------------------------------------------------------------- !> the global tree type(treelmesh_type), intent(in) :: tree !> the level descriptor to be filled type(tem_levelDesc_type), intent(inout) :: levelDesc(tree%global%minlevel: ) !> Process description to use. type(tem_comm_env_type), intent(in) :: proc !> current level integer, intent(in) :: iLevel !> stencil definition type(tem_stencilHeader_type), intent(in) :: stencil !> first and last treeID path in every process type(tem_path_type), intent(in) :: pathFirst(:), pathLast(:) ! --------------------------------------------------------------------------- integer :: iProc, iErr, iElem, elemPos, procPos integer :: haloLevel integer, allocatable :: rq_handle(:) integer, allocatable :: status(:,: ) integer :: nCommunications, nesting type( grw_longArray_type ), allocatable :: treeIDs_fromTarget(:) type( grw_intArray_type ), allocatable :: nestings_fromTarget(:) type( grw_longArray_type ), allocatable :: treeIDs_toSource(:) type( grw_intArray_type ), allocatable :: nestings_toSource(:) logical :: updated integer, parameter :: message_flag_long = 24 integer, parameter :: message_flag_int = 25 ! --------------------------------------------------------------------------- call tem_horizontalSpacer( fUnit = dbgUnit(1), before = 1 ) write(dbgUnit(1),*) "Get into routine: request_remoteHalos" write(dbgUnit(1),*) 'Requesting remote halos on level: ', iLevel ! two communications: treeID and nesting nCommunications = 2 * ( levelDesc( iLevel )%sendbuffer%nProcs & & + levelDesc( iLevel )%recvbuffer%nProcs ) allocate( rq_handle( nCommunications ) ) allocate( status( mpi_status_size, nCommunications ) ) rq_handle(:) = MPI_REQUEST_NULL ! Warning: Inverse Communication ! (send to source, recv from target) ! --------------------------------------------------------------------- ! I receive from target what elements are needed by them ! SendBuffer contains my elements required by remote targets allocate( treeIDs_fromTarget( levelDesc( iLevel )%sendbuffer%nProcs )) allocate( nestings_fromTarget( levelDesc( iLevel )%sendbuffer%nProcs )) do iProc = 1, levelDesc( iLevel )%sendbuffer%nProcs ! Allocate the buffers call init( me = treeIDs_fromTarget( iProc ), & & length = levelDesc( iLevel )%sendbuffer%nElemsProc( iProc )) call init( me = nestings_fromTarget( iProc ), & & length = levelDesc( iLevel )%sendbuffer%nElemsProc( iProc )) ! Receive the element tree IDs call mpi_irecv( treeIDs_fromTarget( iProc )%val, & & treeIDs_fromTarget( iProc )%ContainerSize, & & mpi_integer8, & & levelDesc( iLevel )%sendbuffer%proc(iProc), & & message_flag_long, & & proc%comm, & & rq_handle( iProc), & & iErr ) ! Receive the element nestings call mpi_irecv( nestings_fromTarget( iProc )%val, & & nestings_fromTarget( iProc )%ContainerSize, & & mpi_integer, & & levelDesc( iLevel )%sendbuffer%proc(iProc), & & message_flag_int, & & proc%comm, & & rq_handle( iProc+nCommunications/2 ), & & iErr ) ! Update the number of elements inside the growing array of the recv ! buffer treeIDs_fromTarget( iProc )%nVals = treeIDs_fromTarget( iProc )%ContainerSize nestings_fromTarget( iProc )%nVals = treeIDs_fromTarget( iProc )%ContainerSize end do ! iProc ! --------------------------------------------------------------------- ! --------------------------------------------------------------------- ! I send to source what elements I need from them allocate( treeIDs_toSource( levelDesc( iLevel )%recvbuffer%nProcs ) ) allocate( nestings_toSource( levelDesc( iLevel )%recvbuffer%nProcs ) ) do iProc = 1, levelDesc( iLevel )%recvbuffer%nProcs ! Get the position of the process in the dynamic halos list (might be ! unordered) procPos = PositionOfVal( me = levelDesc(iLevel)%haloList%PartnerProc, & & val = levelDesc(iLevel)%recvbuffer & & %proc(iProc) + 1 ) call init( me = treeIDs_toSource( iProc ), & & length = levelDesc( iLevel )%recvbuffer%nElemsProc( iProc )) call init( me = nestings_toSource( iProc ), & & length = levelDesc( iLevel )%recvbuffer%nElemsProc( iProc )) ! Collect the halo treeIDs into send buffers for all the processes to ! request from do iElem = 1, levelDesc( iLevel )%recvbuffer%nElemsProc( iProc ) elemPos = levelDesc( iLevel )%haloList%halos%val(procPos)%val(iElem) call append( me = treeIDs_toSource( iProc ), & & val = levelDesc( iLevel )%elem%tID%val( elemPos ) ) call append( me = nestings_toSource( iProc ), & & val = levelDesc( iLevel )%elem%haloNesting%val( elemPos ) ) enddo ! Send treeIDs call mpi_isend( & & treeIDs_toSource(iProc)%val, & & treeIDs_toSource(iProc)%nVals, & & mpi_integer8, & & levelDesc( iLevel )%recvbuffer%proc( iProc ), & & message_flag_long, & & proc%comm, & & rq_handle( iProc + levelDesc( iLevel )%sendbuffer%nProcs), & & ierr ) ! Send nesting call mpi_isend( & & nestings_toSource(iProc)%val, & & nestings_toSource(iProc)%nVals, & & mpi_integer, & & levelDesc( iLevel )%recvbuffer%proc( iProc ), & & message_flag_int, & & proc%comm, & & rq_handle( iProc + levelDesc( iLevel )%sendbuffer%nProcs & & + nCommunications/2), & & ierr ) end do ! iProc call mpi_waitall( nCommunications, rq_handle, status, ierr) write(logUnit(5),*) ' Received requested halo elements successfully.' deallocate( treeIDs_toSource ) deallocate( nestings_toSource ) deallocate( rq_handle ) deallocate( status ) ! Requested halo elements were received. ! --------------------------------------------------------------------------- ! --------------------------------------------------------------------------- ! Now identify the requested halos. if( allocated( levelDesc( iLevel )%sendbufferFromCoarser%elemPos)) & & deallocate( levelDesc( iLevel )%sendbufferFromCoarser%elemPos ) allocate( levelDesc( iLevel )%sendbufferFromCoarser%elemPos( & & levelDesc( iLevel )%sendbuffer%nProcs )) if( allocated( levelDesc( iLevel )%sendbufferFromFiner%elemPos )) & & deallocate( levelDesc( iLevel )%sendbufferFromFiner%elemPos ) allocate( levelDesc( iLevel )%sendbufferFromFiner%elemPos( & & levelDesc( iLevel )%sendbuffer%nProcs )) ! Add elements of received buffers to elem do iProc = 1, levelDesc( iLevel )%sendbuffer%nProcs ! Allocate the buffer for the element position indices call init( me = levelDesc( iLevel )%sendbuffer%elemPos(iProc) ) call init( me = levelDesc( iLevel )%sendbufferFromCoarser%elemPos(iProc) ) call init( me = levelDesc( iLevel )%sendbufferFromFiner%elemPos(iProc) ) do iElem = 1, treeIDs_fromTarget( iProc )%nVals nesting = nestings_fromTarget( iProc )%val( iElem ) ! identify requested halo treeID in local process call identify_halo( haloTreeID = treeIDs_fromTarget( iProc )%val(iElem), & & elemPos = elemPos, & & halolevel = haloLevel, & & levelDesc = levelDesc, & & nesting = nesting, & & updated = updated, & & tree = tree, & & minLevel = tree%global%minLevel, & & stencil = stencil ) if( elemPos > 0 ) then ! if requested halo is ghostFromCoarser then find stencil neighbors of ! this halo element if ( (nesting < nestingLimit) & & .and. (levelDesc( iLevel )%elem%eType%val(elemPos) & & == eT_ghostFromCoarser) ) then ! identify all the compute neighbors of the current element call identify_stencilNeigh( iElem = elemPos, & & iLevel = iLevel, & & tree = tree, & & iStencil = 1, & & pathFirst = pathFirst, & & pathLast = pathLast, & & levelDesc = levelDesc, & & proc = proc, & & stencil = stencil, & & nesting = nesting + 1 ) end if ! if requested halo element haloNesting < found halo element (elemPos) ! haloNesting if ( nestings_fromTarget(iProc)%val(iElem) & & < levelDesc( haloLevel )%elem%haloNesting%val(elemPos) ) then levelDesc(haloLevel)%elem%needsUpdate%val(elemPos) = .true. levelDesc(haloLevel) & & %elem & & %haloNesting & & %val(elemPos) = min( nestings_fromTarget(iProc)%val(iElem), & & levelDesc(haloLevel) & & %elem & & %haloNesting & & %val(elemPos) ) end if ! only add, if the element was added locally select case( levelDesc(iLevel)%elem%eType%val(elemPos) ) ! Depending on the type of the element, add to the ! regular buffer, bufferFromCoarser, bufferFromFiner case( eT_fluid ) call append( me = levelDesc( iLevel )%sendbuffer%elemPos( iProc ),& & val = elemPos ) case( eT_ghostFromCoarser ) call append( me = levelDesc( iLevel )%sendbufferFromCoarser & & %elemPos( iProc ), & & val = elemPos ) ! for ghostFromCoarser determine neighbors of coarser element if( levelDesc( haloLevel )%elem%haloNesting%val( elemPos ) & & < nestingLimit ) then call create_allParentNeighbors( & & targetID = levelDesc(iLevel)%elem%tID%val( elemPos ),& & level = iLevel, & & tree = tree, & & stencil = stencil, & & levelDesc = levelDesc, & & pathFirst = pathFirst, & & pathLast = pathLast, & & proc = proc ) end if case( eT_ghostFromFiner ) call append( me = levelDesc( iLevel )%sendbufferFromFiner & & %elemPos( iProc ), & & val = elemPos ) case( eT_distributedGhostFromFiner) write(logUnit(1),*)' Found distributed ghost From Finer in '// & & 'request remote Halos' write(logUnit(1),*)' This case should not occur!' call tem_abort() end select end if ! elemPos > 0 end do ! ielem recvbuffer levelDesc( iLevel )%sendbuffer%nElemsProc( iProc ) & & = levelDesc( iLevel )%sendbuffer%elemPos( iProc )%nVals levelDesc( iLevel )%sendbufferFromCoarser%nElemsProc( iProc ) & & = levelDesc( iLevel )%sendbufferFromCoarser%elemPos( iProc )%nVals levelDesc( iLevel )%sendbufferFromFiner%nElemsProc( iProc ) & & = levelDesc( iLevel )%sendbufferFromFiner%elemPos( iProc )%nVals ! destroy temp variables call destroy( me = treeIDs_fromTarget( iProc ) ) call destroy( me = nestings_fromTarget( iProc ) ) end do ! iProc deallocate( treeIDs_fromTarget ) deallocate( nestings_fromTarget ) ! Now each Process knows, which elements to send to others ! --------------------------------------------------------------------- write(logUnit(5),*) 'Finished requesting remote halos' write(dbgUnit(1),*) "Leave routine: request_remoteHalos" call tem_horizontalSpacer( fUnit = dbgUnit(1), after = 1 ) end subroutine request_remoteHalos