mp_irecv_bv Subroutine

private subroutine mp_irecv_bv(msgout, source, comm, request, tag)

Non-blocking receive of logical vector data

Note

see mp_irecv_iv

Note

arrays can be pointers or assumed shape, but they must be contiguous!

Arguments

Type IntentOptional Attributes Name
logical, DIMENSION(:), CONTIGUOUS :: msgout

the received message

integer, intent(in) :: source

the source processor

type(mp_comm_type), intent(in) :: comm

the communicator object

type(mp_request_type), intent(out) :: request

communication request index

integer, intent(in), optional :: tag

message tag


Source Code

   SUBROUTINE mp_irecv_bv(msgout, source, comm, request, tag)
      !! Non-blocking receive of logical vector data
      !! @note see mp_irecv_iv
      !! @endnote
      !! @note
      !! arrays can be pointers or assumed shape, but they must be contiguous!

      LOGICAL, DIMENSION(:), CONTIGUOUS        :: msgout
         !! the received message
      INTEGER, INTENT(IN)                      :: source
         !! the source processor
      TYPE(mp_comm_type), INTENT(IN)           :: comm
         !! the communicator object
      TYPE(mp_request_type), INTENT(out)                     :: request
         !! communication request index
      INTEGER, INTENT(in), OPTIONAL            :: tag
         !! message tag

      CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_irecv_bv'

      INTEGER                                  :: handle, ierr
#if defined(__parallel)
      INTEGER                                  :: msglen, my_tag
      LOGICAL                                  :: foo(1)
#endif

      ierr = 0
      CALL timeset(routineN, handle)

#if defined(__parallel)
      my_tag = 0
      IF (PRESENT(tag)) my_tag = tag

      msglen = SIZE(msgout, 1)
      IF (msglen > 0) THEN
         CALL mpi_irecv(msgout, msglen, MPI_LOGICAL, source, my_tag, &
                        comm%handle, request%handle, ierr)
      ELSE
         CALL mpi_irecv(foo, msglen, MPI_LOGICAL, source, my_tag, &
                        comm%handle, request%handle, ierr)
      END IF
      IF (ierr /= 0) CALL mp_stop(ierr, "mpi_ircv @ "//routineN)

      CALL add_perf(perf_id=12, msg_size=msglen*loglen)
#else
      DBCSR_ABORT("mp_irecv called in non parallel case")
      MARK_USED(msgout)
      MARK_USED(source)
      MARK_USED(comm)
      MARK_USED(request)
      MARK_USED(tag)
      request = mp_request_null
#endif
      CALL timestop(handle)
   END SUBROUTINE mp_irecv_bv