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