c_redist_22_mpi_copy_persist_end Subroutine

private subroutine c_redist_22_mpi_copy_persist_end(r, to_here)

Uses

Finish persistent communications associated with redistribute. Unpacks receive buffer.

Arguments

Type IntentOptional Attributes Name
type(redist_type), intent(inout) :: r
complex, intent(inout), dimension ( r%to_low(1):, r%to_low(2): ) :: to_here

Contents


Source Code

  subroutine c_redist_22_mpi_copy_persist_end(r, to_here)
    use mp, only: waitall
    implicit none
    type (redist_type), intent (in out) :: r
    complex, dimension ( &
         r%to_low(1):,   &
         r%to_low(2):    &
         ), intent (in out) :: to_here
    integer :: i, ip, nn, nrecv, nsend, j

    !Wait for recv communications to complete and unpack buffer
    nrecv = r%nrecv
    if (nrecv > 0) then
       !Now we don't have anything to do until all the data has arrived (so should we post sends first?)
       !We could do a wait all but may be better to keep on checking each message seperately so that when
       !it arrives we can copy out whilst waiting for others to arrive. 
       !Start with a wait all
       call waitall(nrecv, r%recv_hand)

       !Now unpack data
       !$OMP PARALLEL DEFAULT(none) &
       !$OMP PRIVATE(i, ip, nn, j) &
       !$OMP SHARED(nrecv, to_here, r)
       do i = 1, nrecv
          !Which processor is this data from?
          ip = r%recv_ip(i)
          nn = r%to(ip)%nn
          !$OMP DO &
          !$OMP SCHEDULE(static)
          do j = 1, nn
             to_here(            &
                  r%to(ip)%k(j), &
                  r%to(ip)%l(j)  &
                  ) = r%buff_recv(i)%complex_buffer(j)
          enddo
          !$OMP END DO NOWAIT
       enddo
       !$OMP END PARALLEL
    endif

    !Wait for all sends to complete
    nsend = r%nsend
    if (nsend > 0) then
       call waitall(nsend, r%send_hand)
    endif
  end subroutine c_redist_22_mpi_copy_persist_end