subroutine ESMF_ReconcileExchgItems (vm, id_info, recv_items, recv_buffer, rc)
!
! !ARGUMENTS:
type(ESMF_VM), intent(in) :: vm
type(ESMF_ReconcileIDInfo), intent(in) :: id_info(0:)
type(ESMF_CharPtr), intent(out) :: recv_items(0:)
character, pointer :: recv_buffer(:) ! intent(out)
integer, intent(out) :: rc
!
! !DESCRIPTION:
!
! Performs alltoallv communications of serialized data from offering PETs
! to PETs requesting items.
!
! The arguments are:
! \begin{description}
! \item[vm]
! The current {\tt ESMF\_VM} (virtual machine).
! \item[id_info]
! Array of arrays of global VMId info.
! \item[recv_items]
! Array of arrays of serialized item data.
! \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(:)
character, allocatable :: buffer_send(:)
character, pointer :: cptr_tmp(:)
logical, parameter :: debug = .false.
logical, parameter :: meminfo = .false.
logical, parameter :: profile = .false.
character(len=ESMF_MAXSTR) :: logmsg
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo("entering ESMF_ReconcileExchgItems")
localrc = ESMF_RC_NOT_IMPL
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
if (size (recv_items) /= npets) then
if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, &
msg="size (recv_items) /= npets", &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
! Set up send counts, offsets, and buffer.
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
if (associated (id_info(i)%item_buffer)) then
counts_send(i) = size (id_info(i)%item_buffer)
else
counts_send(i) = 0
end if
end do
itemcount_local = counts_send(mypet)
itemcount_global = sum (counts_send)
allocate ( &
buffer_send(0:max (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
if (associated (id_info(i)%item_buffer)) then
buffer_send(offset_pos:offset_pos+itemcount-1) = id_info(i)%item_buffer
end if
offset_pos = offset_pos + itemcount
end do
! Set up recv counts, offsets, and buffer. Since there will be a different
! buffer size from each remote PET, an AllToAll communication is necessary
! for PETs to exchange the buffer sizes they are sending to each other.
allocate ( &
counts_recv(0:npets-1), &
stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (profile) then
call ESMF_TraceRegionEnter("ESMF_VMAllToAll", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
call ESMF_VMAllToAll (vm, &
sendData=counts_send, sendCount=1, &
recvData=counts_recv, recvCount=1, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (profile) then
call ESMF_TraceRegionExit("ESMF_VMAllToAll", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
if (debug) then
print *, ESMF_METHOD, ': PET', mypet, ': serialized buffer sizes', &
': counts_send =', counts_send, &
', counts_recv =', counts_recv
end if
allocate ( &
offsets_recv(0:npets-1), &
recv_buffer(0:max (0, sum (counts_recv)-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_recv(i)
offsets_recv(i) = offset_pos
offset_pos = offset_pos + itemcount
end do
#if 0
write(logmsg, *) SIZE(buffer_send)
call ESMF_LogWrite("SIZE(buffer_send)="//TRIM(logmsg), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
write(logmsg, *) SIZE(recv_buffer)
call ESMF_LogWrite("SIZE(recv_buffer)="//TRIM(logmsg), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#endif
! AlltoAllV
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=recv_buffer, 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
if (meminfo) call ESMF_VMLogMemInfo("tp ESMF_ReconcileExchgItems: after ESMF_VMAllToAllV")
deallocate (buffer_send, counts_send, offsets_send, &
stat=memstat)
if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! Copy recv buffers into recv_items
do, i=0, npets-1
itemcount = counts_recv(i)
if (itemcount > 0) then
offset_pos = offsets_recv(i)
#if 1
! Fortran 2003 version
recv_items(i)%cptr(0:) => recv_buffer(offset_pos:offset_pos+itemcount-1)
#else
! Fortran 90/95 version
cptr_tmp => recv_buffer(offset_pos:offset_pos+itemcount-1)
! cptr_tmp is 1-based. Convert to 0-based.
call ptr_assoc_zero (cptr_tmp, itemcount, recv_items(i)%cptr)
! print *, 'associated cptr(', lbound (recv_items(i)%cptr,1), ':', ubound (recv_items(i)%cptr,1), ')'
#endif
else
recv_items(i)%cptr => null ()
end if
end do
rc = localrc
if (meminfo) call ESMF_VMLogMemInfo("exiting ESMF_ReconcileExchgItems")
contains
subroutine ptr_assoc_zero (cbuffer, itemcount, cptr)
integer, intent(in) :: itemcount
character, intent(in), target :: cbuffer(0:itemcount-1)
character, pointer :: cptr(:)
cptr => cbuffer
end subroutine
end subroutine ESMF_ReconcileExchgItems