mp_sendrecv_dv Subroutine

private subroutine mp_sendrecv_dv(msgin, dest, msgout, source, comm)

Sends and receives vector data

Arguments

TypeIntentOptionalAttributesName
real(kind=real_8), intent(in), CONTIGUOUS:: msgin(:)

Data to send

integer, intent(in) :: dest

Process to send data to

real(kind=real_8), intent(out), CONTIGUOUS:: msgout(:)

Received data

integer, intent(in) :: source

Process from which to receive Message passing environment identifier

integer, intent(in) :: comm

Process from which to receive Message passing environment identifier


Contents

Source Code


Source Code

      SUBROUTINE mp_sendrecv_dv(msgin, dest, msgout, source, comm)
      !! Sends and receives vector data

         REAL(kind=real_8), CONTIGUOUS, INTENT(IN)        :: msgin(:)
         !! Data to send
         INTEGER, INTENT(IN)                      :: dest
         !! Process to send data to
         REAL(kind=real_8), CONTIGUOUS, INTENT(OUT)       :: msgout(:)
         !! Received data
         INTEGER, INTENT(IN)                      :: source, comm
         !! Process from which to receive
         !! Message passing environment identifier

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

         INTEGER                                  :: handle, ierr
#if defined(__parallel)
         INTEGER                                  :: msglen_in, msglen_out, &
                                                     recv_tag, send_tag
#endif

         ierr = 0
         CALL timeset(routineN, handle)

#if defined(__parallel)
         msglen_in = SIZE(msgin)
         msglen_out = SIZE(msgout)
         send_tag = 0 ! cannot think of something better here, this might be dangerous
         recv_tag = 0 ! cannot think of something better here, this might be dangerous
         CALL mpi_sendrecv(msgin, msglen_in, MPI_DOUBLE_PRECISION, dest, send_tag, msgout, &
                           msglen_out, MPI_DOUBLE_PRECISION, source, recv_tag, comm, MPI_STATUS_IGNORE, ierr)
         IF (ierr /= 0) CALL mp_stop(ierr, "mpi_sendrecv @ "//routineN)
         CALL add_perf(perf_id=7, &
                       msg_size=(msglen_in + msglen_out)*real_8_size/2)
#else
         MARK_USED(dest)
         MARK_USED(source)
         MARK_USED(comm)
         msgout = msgin
#endif
         CALL timestop(handle)
      END SUBROUTINE mp_sendrecv_dv