Single-sided get function for vector data
arrays can be pointers or assumed shape, but they must be contiguous!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
complex(kind=real_8), | CONTIGUOUS, DIMENSION(:) | :: | base | |||
integer, | intent(in) | :: | source | |||
integer, | intent(in) | :: | win | |||
complex(kind=real_8), | CONTIGUOUS, DIMENSION(:) | :: | win_data | |||
integer, | intent(in), | optional | :: | myproc | ||
integer, | intent(in), | optional | :: | disp | ||
integer, | 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_zv(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!
COMPLEX(kind=real_8), CONTIGUOUS, DIMENSION(:) :: base
INTEGER, INTENT(IN) :: source, win
COMPLEX(kind=real_8), CONTIGUOUS, DIMENSION(:) :: win_data
INTEGER, INTENT(IN), OPTIONAL :: myproc, disp
INTEGER, INTENT(OUT) :: request
TYPE(mp_type_descriptor_type), INTENT(IN), OPTIONAL :: origin_datatype, target_datatype
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_rget_zv'
INTEGER :: ierr, handle
#if defined(__parallel)
INTEGER :: len, &
handle_origin_datatype, &
handle_target_datatype, &
origin_len, target_len
LOGICAL :: do_local_copy
INTEGER(kind=mpi_address_kind) :: disp_aint
#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_COMPLEX
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_COMPLEX
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(1), origin_len, handle_origin_datatype, source, disp_aint, &
target_len, handle_target_datatype, win, request, 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)*(2*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_zv