Single-sided get function for vector data
arrays can be pointers or assumed shape, but they must be contiguous!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_4), | CONTIGUOUS, DIMENSION(:) | :: | base | |||
integer, | intent(in) | :: | source | |||
type(mp_win_type), | intent(in) | :: | win | |||
real(kind=real_4), | CONTIGUOUS, DIMENSION(:) | :: | win_data | |||
integer, | intent(in), | optional | :: | myproc | ||
integer, | intent(in), | optional | :: | disp | ||
type(mp_request_type), | intent(out) | :: | request | |||
type(mp_type_descriptor_type), | intent(in), | optional | :: | origin_datatype | ||
type(mp_type_descriptor_type), | intent(in), | optional | :: | target_datatype |
SUBROUTINE mp_rget_rv(base, source, win, win_data, myproc, disp, request, &
origin_datatype, target_datatype)
!! Single-sided get function for vector data
!! @note
!! arrays can be pointers or assumed shape, but they must be contiguous!
REAL(kind=real_4), CONTIGUOUS, DIMENSION(:) :: base
INTEGER, INTENT(IN) :: source
TYPE(mp_win_type), INTENT(IN) :: win
REAL(kind=real_4), CONTIGUOUS, DIMENSION(:) :: win_data
INTEGER, INTENT(IN), OPTIONAL :: myproc, disp
TYPE(mp_request_type), INTENT(OUT) :: request
TYPE(mp_type_descriptor_type), INTENT(IN), OPTIONAL :: origin_datatype, target_datatype
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_rget_rv'
INTEGER :: ierr, handle
#if defined(__parallel)
INTEGER :: len, &
origin_len, target_len
LOGICAL :: do_local_copy
INTEGER(kind=mpi_address_kind) :: disp_aint
MPI_DATA_TYPE :: handle_origin_datatype, handle_target_datatype
#endif
ierr = 0
CALL timeset(routineN, handle)
#if defined(__parallel)
len = SIZE(base)
disp_aint = 0
IF (PRESENT(disp)) THEN
disp_aint = INT(disp, KIND=mpi_address_kind)
END IF
handle_origin_datatype = MPI_REAL
origin_len = len
IF (PRESENT(origin_datatype)) THEN
handle_origin_datatype = origin_datatype%type_handle
origin_len = 1
END IF
handle_target_datatype = MPI_REAL
target_len = len
IF (PRESENT(target_datatype)) THEN
handle_target_datatype = target_datatype%type_handle
target_len = 1
END IF
IF (len > 0) THEN
do_local_copy = .FALSE.
#if !defined(__DBCSR_DISABLE_RMA_LOCAL_COPY)
IF (PRESENT(myproc) .AND. .NOT. PRESENT(origin_datatype) .AND. .NOT. PRESENT(target_datatype)) THEN
IF (myproc .EQ. source) do_local_copy = .TRUE.
END IF
#else
MARK_USED(myproc)
#endif
IF (do_local_copy) THEN
#if !defined(__DBCSR_DISABLE_WORKSHARE)
!$OMP PARALLEL WORKSHARE DEFAULT(none) SHARED(base,win_data,disp_aint,len)
#endif
base(:) = win_data(disp_aint + 1:disp_aint + len)
#if !defined(__DBCSR_DISABLE_WORKSHARE)
!$OMP END PARALLEL WORKSHARE
#endif
request = mp_request_null
ierr = 0
ELSE
CALL mpi_rget(base, origin_len, handle_origin_datatype, source, disp_aint, &
target_len, handle_target_datatype, win%handle, request%handle, ierr)
END IF
ELSE
request = mp_request_null
ierr = 0
END IF
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_rget @ "//routineN)
CALL add_perf(perf_id=25, msg_size=SIZE(base)*real_4_size)
#else
MARK_USED(source)
MARK_USED(win)
MARK_USED(myproc)
MARK_USED(origin_datatype)
MARK_USED(target_datatype)
request = mp_request_null
!
IF (PRESENT(disp)) THEN
base(:) = win_data(disp + 1:disp + SIZE(base))
ELSE
base(:) = win_data(:SIZE(base))
END IF
#endif
CALL timestop(handle)
END SUBROUTINE mp_rget_rv