MAPL_CollectiveWait Subroutine

public subroutine MAPL_CollectiveWait(request, DstArray, rc)

Arguments

Type IntentOptional Attributes Name
type(MAPL_CommRequest), intent(inout) :: request
real, optional, pointer :: DstArray(:,:)
integer, intent(out), optional :: rc

Calls

proc~~mapl_collectivewait~~CallsGraph proc~mapl_collectivewait MAPL_CollectiveWait mpi_recv mpi_recv proc~mapl_collectivewait->mpi_recv mpi_wait mpi_wait proc~mapl_collectivewait->mpi_wait proc~mapl_return MAPL_Return proc~mapl_collectivewait->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_collectivewait->proc~mapl_verify at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception

Called by

proc~~mapl_collectivewait~~CalledByGraph proc~mapl_collectivewait MAPL_CollectiveWait proc~mapl_cfioreadbundlewait MAPL_CFIOReadBundleWait proc~mapl_cfioreadbundlewait->proc~mapl_collectivewait proc~mapl_cfiowritebundlewait MAPL_CFIOWriteBundleWait proc~mapl_cfiowritebundlewait->proc~mapl_collectivewait proc~mapl_collectivegather3d MAPL_CollectiveGather3D proc~mapl_collectivegather3d->proc~mapl_collectivewait proc~mapl_collectivescatter3d MAPL_CollectiveScatter3D proc~mapl_collectivescatter3d->proc~mapl_collectivewait

Source Code

  subroutine MAPL_CollectiveWait(request, DstArray, rc)
    type (MAPL_COMMRequest), intent(INOUT) :: request
    real, pointer, optional                :: DstArray(:,:)
    integer, optional,       intent(  OUT) :: rc

    integer                               :: status


    integer               :: i,j,k,n
    integer               :: count

    REQUEST_TYPE: if(request%RequestType==MAPL_IsGather) then

       ROOT_GATH: if(request%amRoot) then
          k = 0
          PE_GATH: do n=0,request%nDEs-1
             count = request%IM(n)*request%JM(n)
             if(request%mype/=n) then
                if(request%IsPrePosted) then
                   call MPI_Wait(request%recv(n),MPI_STATUS_IGNORE,status)
                   _VERIFY(STATUS)
                else
                   call MPI_Recv(request%var(k), count, MPI_REAL, &
                        n, request%tag, request%comm, MPI_STATUS_IGNORE, status)
                   _VERIFY(STATUS)
                endif
                do J=request%J1(n),request%JN(n)
                   do I=request%I1(n),request%IN(n)
                      request%DstArray(I,J) = request%var(k)
                      k = k+1
                   end do
                end do
             else
                k = k + count
             end if
          end do PE_GATH
          if(present(DstArray)) DstArray => request%DstArray
       else
          call MPI_WAIT(request%send(0),MPI_STATUS_IGNORE,status)
          _VERIFY(STATUS)
       endif ROOT_GATH

    elseif(request%RequestType==MAPL_IsScatter) then

       ROOT_SCAT: if(.not.request%amRoot) then
          if(request%IsPrePosted) then
             call MPI_Wait(request%recv(0),MPI_STATUS_IGNORE,status)
             _VERIFY(STATUS)
          else
             call MPI_Recv(request%Var, size(request%Var), MPI_REAL, &
                           request%Root, request%tag, request%comm,  &
                           MPI_STATUS_IGNORE, status)
             _VERIFY(status)
          endif
          k=0
          do J=1,request%JM0
             do I=1,request%IM0
                request%DstArray(I,J) = request%var(k)
                k = k+1
             end do
          end do

       else
             PE_SCAT: do n=0,request%nDEs-1
                if(n /= request%mype) then
                   call MPI_Wait(request%send(n),MPI_STATUS_IGNORE,status)
                   _VERIFY(STATUS)
                   deallocate(request%buff(n)%A)
                end if
             end do PE_SCAT
          deallocate(request%Buff)
       end if ROOT_SCAT

       if(present(DstArray)) DstArray => request%DstArray
    end if REQUEST_TYPE

! Destroy the request
!--------------------

    deallocate(request%var )
    deallocate(request%recv)
    deallocate(request%send)
    deallocate(request%i1  )
    deallocate(request%in  )
    deallocate(request%j1  )
    deallocate(request%jn  )
    deallocate(request%im  )
    deallocate(request%jm  )

    nullify(request%var     )
    nullify(request%send    )
    nullify(request%recv    )
    nullify(request%DstArray)

    if(associated(request%Local_Array)) deallocate(request%Local_Array)
    nullify(request%Local_Array)

    request%active = .false.

    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_CollectiveWait