mp_rget_dv Subroutine

      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
#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_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