Single-sided get function for vector data
Note
arrays can be pointers or assumed shape, but they must be contiguous!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_8), | CONTIGUOUS, DIMENSION(:) | :: | base | |||
integer, | intent(in) | :: | source | |||
type(mp_win_type), | intent(in) | :: | win | |||
real(kind=real_8), | 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_dv(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_8), CONTIGUOUS, DIMENSION(:) :: base INTEGER, INTENT(IN) :: source TYPE(mp_win_type), INTENT(IN) :: win REAL(kind=real_8), 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_dv' 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_DOUBLE_PRECISION origin_len = len IF (PRESENT(origin_datatype)) THEN handle_origin_datatype = origin_datatype%type_handle origin_len = 1 END IF handle_target_datatype = MPI_DOUBLE_PRECISION 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 base(:) = win_data(disp_aint + 1:disp_aint + len) 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_8_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_dv