subroutine ESMF_ReconcileExchgIDInfo (vm, &
nitems_buf, id, vmid, id_info, rc)
!
! !ARGUMENTS:
type(ESMF_VM), intent(in) :: vm
integer, intent(in) :: nitems_buf(0:)
integer, intent(in) :: id(0:)
integer, intent(in) :: vmid(0:)
type(ESMF_ReconcileIDInfo), intent(inout) :: id_info(0:)
integer, intent(out) :: rc
!
! !DESCRIPTION:
!
! Dense AlltoAll of all Ids and VMIds from every PET to every PET.
!
! The arguments are:
! \begin{description}
! \item[vm]
! The current {\tt ESMF\_VM} (virtual machine).
! \item[nitems_buf]
! Number of items on each PET.
! \item[id]
! The object ids of this PETs State itself (in element 0) and the items
! contained within it. It does not return the IDs of nested State
! items.
! \item[vmid]
! The object integer VMIds of this PET's State itself (in element 0) and the
! items contained within it. It does not return the IDs of nested State items.
! \item[id_info]
! Array of arrays of global VMId info. Array has a size of numPets, and each
! element points to Id/VMId arrays. Also returns which objects are not
! present on the current PET.
! \item[rc]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!EOPI
integer :: localrc
integer :: mypet, npets
integer :: send_pet
integer, allocatable :: counts_buf_send(:), counts_buf_recv(:)
integer, allocatable :: displs_buf_send(:), displs_buf_recv(:)
integer :: i, ipos
integer :: memstat
integer, allocatable :: id_recv(:), vm_intids_recv(:)
logical, parameter :: debug = .false.
logical, parameter :: meminfo = .false.
character(len=ESMF_MAXSTR) :: logmsg
localrc = ESMF_RC_NOT_IMPL
if (meminfo) call ESMF_VMLogMemInfo ('entering ESMF_ReconcileExchgIDInfo')
call ESMF_VMGet(vm, localPet=mypet, petCount=npets, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! Sanity checks
if (size (id) /= size (vmid)) then
if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
if (size (id_info) /= npets) then
if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
if (size (nitems_buf) /= npets) then
if (ESMF_LogFoundError(ESMF_RC_ARG_BAD, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
#if 0
! Log some information about the number of items in the state.
write(logmsg, *) nitems_buf
call ESMF_LogWrite("nitems_buf="//trim(logmsg))
! Log the current integer VM identifiers
write(logmsg, *) "vmid=", vmid
call ESMF_LogWrite(trim(logmsg))
! Log the current integer Base identifiers
write(logmsg, *) "id=", id
call ESMF_LogWrite(trim(logmsg))
#endif
! Broadcast each Id to all the other PETs. Since the number of items per
! PET can vary, use AllToAllV.
do, i=0, npets-1
allocate ( &
id_info(i)% id (0:nitems_buf(i)), &
id_info(i)%vmid (0:nitems_buf(i)), &
id_info(i)%needed( nitems_buf(i)), &
stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
id_info(i)%needed = .false.
end do
if (meminfo) call ESMF_VMLogMemInfo ('tp ESMF_ReconcileExchgIDInfo - after id_info allocate and VMIDCreate')
! First, compute counts and displacements for AllToAllV calls. Note that
! sending displacements are always zero, since each PET is broadcasting
allocate (counts_buf_send(0:npets-1), displs_buf_send(0:npets-1), &
counts_buf_recv(0:npets-1), displs_buf_recv(0:npets-1), &
stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! Add 1 to take the State itself (element 0) into account
counts_buf_send = nitems_buf(mypet) + 1
counts_buf_recv = nitems_buf + 1
displs_buf_send = 0 ! Always zero, since local PET is broadcasting
displs_buf_recv(0) = 0
do, i=1, npets-1
displs_buf_recv(i) = displs_buf_recv(i-1) + counts_buf_recv(i-1)
end do
if (debug) then
do, i=0, npets-1
if (i == mypet) then
write (6,*) ESMF_METHOD, ': pet', mypet, ': counts_buf_send =', counts_buf_send
write (6,*) ESMF_METHOD, ': pet', mypet, ': displs_buf_send =', displs_buf_send
write (6,*) ESMF_METHOD, ': pet', mypet, ': counts_buf_recv =', counts_buf_recv
write (6,*) ESMF_METHOD, ': pet', mypet, ': displs_buf_recv =', displs_buf_recv
call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout)
end if
call ESMF_VMBarrier (vm)
end do
end if
! Exchange Base Ids -------------------------------------------------------
! NOTE: The base id exchange could be combined with the integer VM Id
! exchange below. Historically, they were separate because the VM Ids were
! character strings. Now that the VM Ids used in reconcile are integers, they
! could be both be exhchanged in the same AllToAll call.
allocate(id_recv(0:sum (counts_buf_recv+1)-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (debug) then
call ESMF_ReconcileDebugPrint (ESMF_METHOD // &
': Exchanging Ids (using ESMF_VMAllGatherV)')
end if
call ESMF_VMAllGatherV (vm, &
sendData=id , sendCount =size (id), &
recvData=id_recv, recvCounts=counts_buf_recv, recvOffsets=displs_buf_recv, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (meminfo) call ESMF_VMLogMemInfo ('tp ESMF_ReconcileExchgIDInfo - after VMAllGatherV for Base Ids')
ipos = 0
do, i=0, npets-1
id_info(i)%id = id_recv(ipos:ipos+counts_buf_recv(i)-1)
ipos = ipos + counts_buf_recv(i)
end do
! Exchange VMIds ----------------------------------------------------------
allocate(vm_intids_recv(0:sum (counts_buf_recv+1)-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
call ESMF_VMAllGatherV (vm, &
sendData=vmid, sendCount=size(vmid), &
recvData=vm_intids_recv, recvCounts=counts_buf_recv, recvOffsets=displs_buf_recv, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (meminfo) call ESMF_VMLogMemInfo ('tp ESMF_ReconcileExchgIDInfo - after VMAllGatherV for Base Ids')
ipos = 0
do, i=0, npets-1
id_info(i)%vmid = vm_intids_recv(ipos:ipos+counts_buf_recv(i)-1)
ipos = ipos + counts_buf_recv(i)
end do
! if (debug) then
! do, j=0, npets-1
! if (j == myPet) then
! do, i=0, ubound (id_info, 1)
! write (6,*) 'pet', j, ': id_info%id =', id_info(i)%id
! call ESMF_UtilIOUnitFlush (ESMF_UtilIOStdout)
! end do
! end if
! call ESMF_VMBarrier (vm)
! end do
! end if
! NOTE: This code is a non-collective approach to the base and VM id exchanges.
! It will probably not be used, but AllToAll calls are notoriously problematic
! with some MPI implementations.
#if 0
if (trace) then
call ESMF_ReconcileDebugPrint (ESMF_METHOD // &
': Exchanging VMIds (using ESMF_VMAllGatherVMId)')
end if
allocate (vmid_recv(0:sum (counts_buf_recv+1)-1), &
stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
call ESMF_VMIdCreate (vmid_recv, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
call ESMF_VMAllGatherV (vm, &
sendData=vmid, sendCount=size (vmid), &
recvData=vmid_recv, recvCounts=counts_buf_recv, recvOffsets=displs_buf_recv, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
ipos = 0
do, i=0, npets-1
call ESMF_VMIdCopy ( &
dest =id_info(i)%vmid, &
source=vmid_recv(ipos:ipos+counts_buf_recv(i)-1), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
ipos = ipos + counts_buf_recv(i)
end do
!else
! VMBcastVMId version
if (trace) then
call ESMF_ReconcileDebugPrint (ESMF_METHOD // &
': Exchanging VMIds (using ESMF_VMBcastVMId)')
end if
if (debug) then
call ESMF_ReconcileDebugPrint (ESMF_METHOD // &
': VMIdCopying...')
end if
call ESMF_VMIdCopy ( &
dest=id_info(mypet)%vmid, &
source=vmid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
do, send_pet=0, npets-1
if (debug) then
call ESMF_ReconcileDebugPrint (ESMF_METHOD // &
': broadcasting VMId, using rootPet ' // iToS (send_pet), &
ask=.false.)
end if
call ESMF_VMBcastVMId (vm, &
bcstData=id_info(send_pet)%vmid, &
count=size (id_info(send_pet)%vmid), &
rootPet=send_pet, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end do
#endif
rc = localrc
if (meminfo) call ESMF_VMLogMemInfo ('exiting ESMF_ReconcileExchgIDInfo')
end subroutine ESMF_ReconcileExchgIDInfo