ESMF_ReconcileExchgNeeds Subroutine

private subroutine ESMF_ReconcileExchgNeeds(vm, id_info, recv_needs, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_VM), intent(in) :: vm
type(ESMF_ReconcileIDInfo), intent(in) :: id_info(0:)
logical, pointer :: recv_needs(:,:)
integer, intent(out) :: rc

Source Code

  subroutine ESMF_ReconcileExchgNeeds (vm, id_info, recv_needs, rc)
!
! !ARGUMENTS:
    type(ESMF_VM),              intent(in)  :: vm
    type(ESMF_ReconcileIDInfo), intent(in)  :: id_info(0:)
    logical,                    pointer     :: recv_needs(:,:) ! intent(out)
    integer,                    intent(out) :: rc
!
! !DESCRIPTION:
!
!  Performs alltoallv communications from needy PETs to PETs which offer
!  items they need.
!
!   The arguments are:
!   \begin{description}
!   \item[vm]
!     The current {\tt ESMF\_VM} (virtual machine).
!   \item[id_info]
!     Array of arrays of global VMId info.  The 'needed' flags indicate
!     which items are needed from which offering PETs.
!   \item[recv_needs]
!     Array of needy PETs and their needs.  If a flag is set, the PET
!     needs the item.
!   \item[rc]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!EOPI

    integer :: localrc
    integer :: memstat
    integer :: mypet, npets
    integer :: i
    integer :: itemcount, itemcount_global, itemcount_local
    integer :: offset_pos

    integer, allocatable :: counts_recv(:),  counts_send(:)
    integer, allocatable :: offsets_recv(:), offsets_send(:)
    logical, allocatable :: buffer_recv(:),  buffer_send(:)

    character(ESMF_MAXSTR) :: msgstring

    logical, parameter :: debug = .false.
    logical, parameter :: profile = .false.

    localrc = ESMF_RC_NOT_IMPL

    if (associated (recv_needs)) then
      if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU,  &
          ESMF_CONTEXT,  &
          rcToReturn=rc)) return
    end if

    call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    if (size (id_info) /= npets) then
      if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, &
          msg="size (id_info) /= npets", &
          ESMF_CONTEXT,  &
          rcToReturn=rc)) return
    end if

!   Set up send counts, offsets, and buffer.  Note that each remote PET
!   can have differing numbers of items to offer.

    allocate (  &
        counts_send (0:npets-1),  &
        offsets_send(0:npets-1),  &
        stat=memstat)
    if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    do, i=0, npets-1
      counts_send(i) = size (id_info(i)%needed)
    end do

    itemcount_local = counts_send(mypet)
    itemcount_global = sum (counts_send)

    allocate (  &
        buffer_send(0:itemcount_global-1),  &
        stat=memstat)
    if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    offset_pos = 0
    do, i=0, npets-1
      itemcount = counts_send(i)
      offsets_send(i) = offset_pos
      buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%needed
      offset_pos = offset_pos + itemcount
    end do

!   Each remote PET should return a buffer that is the same
!   size as the number of items on the local PET.  So the recv_needs
!   buffer can be a simple rectangular matrix of which PETs need
!   which of my items.

    allocate (  &
        counts_recv (0:npets-1),  &
        offsets_recv(0:npets-1),  &
        buffer_recv(0:itemcount_local*npets-1),  &
        recv_needs(itemcount_local,0:npets-1), stat=memstat)
    if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    counts_recv = itemcount_local
    offsets_recv = itemcount_local * (/ (i,i=0, npets-1) /)
    buffer_recv = .false.

    ! AlltoAllV

    if (trace) then
      call ESMF_ReconcileDebugPrint (ESMF_METHOD //  &
          ': calling VMAllToAll')
    end if

    if (profile) then
      call ESMF_TraceRegionEnter("ESMF_VMAllToAllV", rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return
    endif

    call ESMF_VMAllToAllV (vm,  &
        sendData=buffer_send, sendCounts=counts_send, sendOffsets=offsets_send, &
        recvData=buffer_recv, recvCounts=counts_recv, recvOffsets=offsets_recv, &
        rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    if (profile) then
      call ESMF_TraceRegionExit("ESMF_VMAllToAllV", rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return
    endif

    ! Copy recv buffers into recv_needs

    do, i=0, npets-1
      itemcount = counts_recv(i)
      offset_pos = offsets_recv(i)
      recv_needs(:,i) = buffer_recv(offset_pos:offset_pos+itemcount-1)
    end do

    if (debug) then
      do, i=0, npets-1
        write (msgstring,'(a,i0,a,i0,a)')  &
            '  PET ', mypet, ': needs that PET ', i, ' requested are:'
        write (6,*) trim (msgstring), recv_needs(:,i)
        call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout)
      end do
    end if

    rc = localrc

  end subroutine ESMF_ReconcileExchgNeeds