MAPL_CreateRequest Subroutine

public subroutine MAPL_CreateRequest(grid, Root, request, tag, RequestType, DstArray, PrePost, hw, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: Root
type(MAPL_CommRequest), intent(inout) :: request
integer, intent(in) :: tag
integer, intent(in) :: RequestType
real, intent(in), optional, target :: DstArray(:,:)
logical, intent(in), optional :: PrePost
integer, intent(in), optional :: hw
integer, intent(out), optional :: rc

Calls

proc~~mapl_createrequest~~CallsGraph proc~mapl_createrequest MAPL_CreateRequest ESMF_GridGet ESMF_GridGet proc~mapl_createrequest->ESMF_GridGet ESMF_VMGet ESMF_VMGet proc~mapl_createrequest->ESMF_VMGet ESMF_VMGetCurrent ESMF_VMGetCurrent proc~mapl_createrequest->ESMF_VMGetCurrent interface~mapl_assert MAPL_Assert proc~mapl_createrequest->interface~mapl_assert mpi_irecv mpi_irecv proc~mapl_createrequest->mpi_irecv proc~mapl_distgridget MAPL_DistGridGet proc~mapl_createrequest->proc~mapl_distgridget proc~mapl_return MAPL_Return proc~mapl_createrequest->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_createrequest->proc~mapl_verify proc~mapl_distgridget->proc~mapl_verify ESMF_DistGridGet ESMF_DistGridGet proc~mapl_distgridget->ESMF_DistGridGet 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_createrequest~~CalledByGraph proc~mapl_createrequest MAPL_CreateRequest proc~mapl_cfioreadbundleread MAPL_CFIOReadBundleRead proc~mapl_cfioreadbundleread->proc~mapl_createrequest proc~mapl_cfiowritebundlepost MAPL_CFIOWriteBundlePost proc~mapl_cfiowritebundlepost->proc~mapl_createrequest proc~mapl_collectivegather3d MAPL_CollectiveGather3D proc~mapl_collectivegather3d->proc~mapl_createrequest proc~mapl_collectivescatter3d MAPL_CollectiveScatter3D proc~mapl_collectivescatter3d->proc~mapl_createrequest

Source Code

  subroutine MAPL_CreateRequest(grid, Root, request, tag, RequestType, &
                                DstArray, PrePost, hw, rc)
    type (ESMF_Grid),        intent(IN   ) :: grid
    integer,                 intent(IN   ) :: Root
    type (MAPL_CommRequest), intent(INOUT) :: request
    integer,                 intent(IN   ) :: tag, RequestType
    real, target, optional,  intent(IN   ) :: DstArray(:,:)
    logical,      optional,  intent(IN   ) :: PrePost
    integer,      optional,  intent(IN   ) :: hw
    integer,      optional,  intent(  OUT) :: rc

! Local variables

    integer                    :: status


    type (ESMF_VM)             :: VM
    type (ESMF_DistGrid)       :: distGrid

    integer, allocatable       :: AL(:,:), AU(:,:)
    integer                    :: count
    integer                    :: displs
    integer                    :: n
    integer                    :: myPE, nDEs
    integer                    :: gridRank
    integer                    :: comm
    integer                    :: hw_

! Begin
!------

    if (present(hw)) then
       hw_ = hw
    else
       hw_ = 0
    end if

    _ASSERT(.not.request%active, 'request is already active')

! Communicator info all comes from the ESMF VM
!---------------------------------------------

    call ESMF_VMGetCurrent(vm,                                RC=STATUS)
    _VERIFY(STATUS)
    call ESMF_VMGet       (VM,       mpiCommunicator =comm,   RC=STATUS)
    _VERIFY(STATUS)
    call ESMF_VMGet       (VM, localpet=MYPE, petcount=nDEs,  RC=STATUS)
    _VERIFY(STATUS)

    call ESMF_GridGet(GRID, dimCount=gridRank, rc=status)
    _VERIFY(STATUS)

! Does not support 1D grids
!--------------------------

    _ASSERT(gridRank > 1, 'rank 1 is not supported')


! Get the local grid bounds for all pes. We will use only
!   the first 2 dimensions.
!--------------------------------------------------------

    call ESMF_GridGet(GRID, distGrid=distGrid, RC=STATUS); _VERIFY(STATUS)

    allocate (AL(gridRank,0:nDEs-1), stat=STATUS)
    _VERIFY(STATUS)
    allocate (AU(gridRank,0:nDEs-1), stat=STATUS)
    _VERIFY(STATUS)

    call MAPL_DistGridGet (distgrid, minIndex=AL, maxIndex=AU, RC=STATUS); _VERIFY(STATUS)

! Allocate space for request variables
!-------------------------------------

    allocate (request%i1(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%in(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%j1(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%jn(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%im(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%jm(0:nDEs-1),  stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%RECV (0:nDEs-1         ),        stat=STATUS)
    _VERIFY(STATUS)
    allocate (request%SEND (0:nDEs-1         ),        stat=STATUS)
    _VERIFY(STATUS)

! Fill the request variables
!---------------------------

    request%amRoot        =  (myPE == Root)
    request%active        = .true.
    request%nDEs          =  nDEs
    request%myPE          =  myPE
    request%comm          =  comm
    request%root          =  root
    request%RequestType   =  RequestType
    request%tag           =  tag

    request%I1 = AL(1,:)-hw_
    request%In = AU(1,:)+hw_
    request%J1 = AL(2,:)-hw_
    request%Jn = AU(2,:)+hw_
    request%IM = request%IN-request%I1+1
    request%JM = request%JN-request%J1+1

    request%IM_WORLD = request%IN(nDEs-1)- request%I1(0) + 1 - (2*hw_)
    request%JM_WORLD = request%JN(nDEs-1)- request%J1(0) + 1 - (2*hw_)
    request%IM0      = request%IN(mype  )- request%I1(mype) + 1
    request%JM0      = request%JN(mype  )- request%J1(mype) + 1

    if(present(PrePost)) then
       request%IsPrePosted = PrePost
    else
       request%IsPrePosted = .false.
    end if

    deallocate(AL,AU)

! Verify that we have a valid destination area
!---------------------------------------------

    if(requestType==MAPL_IsGather) then
       if(request%amRoot) then
          if(present(DstArray)) then
             request%DstArray => DstArray
             _ASSERT(all(shape(DstArray)==(/ request%IM_WORLD, request%JM_WORLD/)), 'inconsistent shape')
          else
             allocate(request%DstArray(request%IM_WORLD, request%JM_WORLD),stat=STATUS)
             _VERIFY(STATUS)
          end if
       endif
    elseif(requestType==MAPL_IsScatter) then
       if(present(DstArray)) then
          request%DstArray => DstArray
          _ASSERT(all(shape(DstArray)==(/ request%IM0     , request%JM0     /)), 'inconsistent shape')
       else
          allocate(request%DstArray(request%IM0 , request%JM0 ),stat=STATUS)
          _VERIFY(STATUS)
       end if
    else
       _FAIL( 'unsupported action')
    end if

! Allocate a contiguous buffer for communication
!-----------------------------------------------

    if(requestType==MAPL_IsGather .and. request%amRoot) then
       allocate (request%Var(0:request%IM_WORLD*request%JM_WORLD-1),      stat=STATUS)
       _VERIFY(STATUS)
    elseif(requestType==MAPL_IsScatter) then
       allocate (request%Var(0:request%IM0*request%JM0-1),      stat=STATUS)
       _VERIFY(STATUS)
    else
       allocate (request%Var(1),      stat=STATUS)
       _VERIFY(STATUS)
    endif

! We also PrePost the request here
!---------------------------------

    POST_REQUEST: if(request%IsPrePosted) then
       if(requestType==MAPL_IsGather) then
          if(request%amRoot) then
             displs = 0
             do n=0,nDEs-1
                count = request%IM(n)*request%JM(n)
                if(n /= mype) then
                   call MPI_IRecv(request%VAR(displs), count, MPI_REAL, &
                        n, tag, comm, request%recv(n), status)
                   _VERIFY(STATUS)
                end if
                displs = displs + count
             end do
          endif

       else
          if(.not.request%amRoot) then
             call MPI_IRecv(request%Var, size(request%Var), MPI_REAL, &
                  request%Root, tag, comm, request%recv(0), status)
             _VERIFY(STATUS)
          end if
       end if
    end if POST_REQUEST

    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_CreateRequest