comm_typed_isend_irecv_real Subroutine

private subroutine comm_typed_isend_irecv_real(send, recv, state, message_flag, send_state, comm)

exchange the communication mes with a non-blocking mpi communication using preposted irecv and isend with a waitall

values for send me must have been copied from the actual state array start receive communications

start the sending communications wait for above communications to complete

Arguments

Type IntentOptional Attributes Name
type(tem_communication_type), intent(inout) :: send
type(tem_communication_type), intent(inout) :: recv
real(kind=rk), intent(inout) :: state(*)
integer, intent(in) :: message_flag
real(kind=rk), intent(in), optional :: send_state(*)
integer, intent(in) :: comm

mpi communicator

Calls

proc~~comm_typed_isend_irecv_real~~CallsGraph proc~comm_typed_isend_irecv_real comm_typed_isend_irecv_real mpi_irecv mpi_irecv proc~comm_typed_isend_irecv_real->mpi_irecv mpi_isend mpi_isend proc~comm_typed_isend_irecv_real->mpi_isend mpi_waitall mpi_waitall proc~comm_typed_isend_irecv_real->mpi_waitall

Source Code

  subroutine comm_typed_isend_irecv_real( send, recv, state,             &
    &                                        message_flag, send_state, comm )
    ! -------------------------------------------------------------------- !
    type( tem_communication_type ), intent(inout) :: send, recv
    real(kind=rk), intent(inout) :: state(*)  !< current state vector
    integer, intent(in) :: message_flag
    real(kind=rk), intent(in), optional :: send_state(*)  !< data to send
    !> mpi communicator
    integer, intent(in) :: comm
    ! -------------------------------------------------------------------- !
    ! @todo request handle array could exist during complete code runtime
    ! integer :: rq_handle( recv%nprocs + send%nprocs )
    integer :: status( mpi_status_size, max(recv%nprocs, send%nprocs) )
    integer :: ierr             ! error flag
    integer :: iproc
    ! -------------------------------------------------------------------- !

    !> values for send me must have been copied from the actual state array
    do iproc = 1, recv%nprocs
      !> start receive communications
      call mpi_irecv(                                     &
       &              state,                              & ! buffer
       &              1,                                  & ! count
       &              recv%buf_real(iproc)%memindexed, & ! type
       &              recv%proc(iproc),                   & ! source
       &              message_flag,                       & ! tag
       &              comm,                               & ! comm
       &              recv%rqhandle(iproc),               & ! request handle
       &              ierr )

    end do

    !>  start the sending communications
    if (present(send_state)) then
      do iproc = 1, send%nprocs
        call mpi_isend(                                     &
          &             send_state,                         & ! buffer
          &             1,                                  & ! count
          &             send%buf_real(iproc)%memindexed, & ! type
          &             send%proc(iproc),                   & ! target
          &             message_flag,                       & ! tag
          &             comm,                               & ! comm
          &             send%rqhandle( iproc ),             & ! handle
          &             ierr )
      end do !< iproc
    else
      do iproc = 1, send%nprocs
        call mpi_isend(                                     &
          &             state,                              & ! buffer
          &             1,                                  & ! count
          &             send%buf_real(iproc)%memindexed, & ! type
          &             send%proc(iproc),                   & ! target
          &             message_flag,                       & ! tag
          &             comm,                               & ! comm
          &             send%rqhandle( iproc ),             & ! handle
          &             ierr )
      end do !< iproc
    end if

    !> wait for above communications to complete
    if ( recv%nprocs /= 0 ) then
      call mpi_waitall( recv%nprocs,     & ! count
        &               recv%rqhandle,   & ! request handles
        &               status,          & ! statuses
        &               ierr )
    end if
    if ( send%nprocs /= 0 ) then
      call mpi_waitall( send%nprocs,     & ! count
        &               send%rqhandle,   & ! request handles
        &               status,          & ! statuses
        &               ierr )
    end if

  end subroutine comm_typed_isend_irecv_real