subroutine ESMF_ReconcileBruteForce(state, vm, attreconflag, siwrap, &
ids_send, vmids_send, vmintids_send, nitems_buf, rc)
!
! !ARGUMENTS:
type(ESMF_State), intent(inout) :: state
type(ESMF_VM), intent(in) :: vm
type(ESMF_AttReconcileFlag), intent(in) :: attreconflag
type(ESMF_StateItemWrap), pointer, intent(in) :: siwrap(:)
integer, pointer, intent(in) :: ids_send(:)
type(ESMF_VMId), pointer, intent(in) :: vmids_send(:)
integer, pointer, intent(in) :: vmintids_send(:)
integer, pointer, intent(in) :: nitems_buf(:)
integer, intent(out) :: rc
!
! !DESCRIPTION:
!
! Brute force reconciliation across all of the PETs using Alltoall
! communications. This should be able to reconcile any conceivable situation.
!
! The arguments are:
! \begin{description}
! \item[state]
! The {\tt ESMF\_State} to reconcile.
! \item[vm]
! The {\tt ESMF\_VM} object across which the state is reconciled.
! \item[attreconflag]
! Flag indicating whether attributes need to be reconciled.
! \item[siwrap]
! List of local state items.
! \item[rc]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!EOPI
integer :: localrc
integer :: memstat
integer :: localPet, petCount
integer :: i
type(ESMF_ReconcileIDInfo), allocatable :: id_info(:)
type(ESMF_CharPtr), allocatable :: items_recv(:)
logical, pointer :: recvd_needs_matrix(:,:)
character, pointer :: buffer_recv(:)
logical, parameter :: meminfo = .false.
logical, parameter :: profile = .false.
rc = ESMF_SUCCESS
#ifdef RECONCILE_LOG_on
block
character(ESMF_MAXSTR) :: stateName
call ESMF_StateGet(state, name=stateName, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
call ESMF_LogWrite("ESMF_ReconcileBruteForce() for State: "//trim(stateName), &
ESMF_LOGMSG_DEBUG, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
end block
#endif
call ESMF_VMGet(vm, petCount=petCount, localPet=localPet, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
! (3) All PETs send their items Ids and VMIds to all the other PETs,
! then create local directories of which PETs have which ids/VMIds.
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(3) Send arrays exchange", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
allocate (id_info(0:petCount-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
call ESMF_ReconcileExchgIDInfo (vm, &
nitems_buf=nitems_buf, &
id=ids_send, &
vmid=vmintids_send, &
id_info=id_info, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(3) Send arrays exchange", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (3) Send arrays exchange")
! At this point, each PET knows what items can be found on all of
! the other PETs. The id_info array has global PET info in it.
! -------------------------------------------------------------------------
! (4) Construct needs list. Receiving PETs compare IDs and VMIds
! in their send ID/VMId array with what was received from the
! currently-being-processed sending PET. Note that multiple PETs
! can 'offer' an item.
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(4) Construct needs list", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
call ESMF_ReconcileCompareNeeds (vm, &
id= ids_send, &
vmid=vmintids_send, &
id_info=id_info, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(4) Construct needs list", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (4) Construct needs list")
! -------------------------------------------------------------------------
! (5) Communicate needs back to the offering PETs.
! Send to each offering PET a buffer containing 'needed' array
! specifying which items are needed. The array is the same size as,
! and corresponds to, the ID and VMId arrays that were previously
! offered.
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(5) Communicate needs back", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
recvd_needs_matrix => null ()
call ESMF_ReconcileExchgNeeds (vm, &
id_info=id_info, &
recv_needs=recvd_needs_matrix, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(5) Communicate needs back", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (5) Communicate needs back")
! -------------------------------------------------------------------------
! (6) Serialize needed objects
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(6) Serialize needed objects", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
call ESMF_ReconcileSerialize (state, vm, siwrap, &
needs_list=recvd_needs_matrix, &
attreconflag=attreconflag, &
id_info=id_info, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
deallocate (recvd_needs_matrix, stat=memstat)
if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(6) Serialize needed objects", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (6) Serialize needed objects")
! -------------------------------------------------------------------------
! (7) Send/receive serialized objects to whoever needed them
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(7) Send/receive serialized objects", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
allocate (items_recv(0:petCount-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
buffer_recv => null ()
call ESMF_ReconcileExchgItems (vm, &
id_info=id_info, &
recv_items=items_recv, & ! %cptr aliased to portions of buffer_recv
recv_buffer=buffer_recv, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(7) Send/receive serialized objects", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (7) Send/receive serialized objects")
! -------------------------------------------------------------------------
! (8) Deserialize received objects and create proxies (recurse on
! nested States as needed)
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(8) Deserialize received objects and create proxies", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
do, i=0, petCount-1
if (associated (items_recv(i)%cptr)) then
call ESMF_ReconcileDeserialize (state, vm, &
obj_buffer=items_recv(i)%cptr, &
attreconflag=attreconflag, &
rc=localrc)
else
localrc = ESMF_SUCCESS
end if
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end do
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(8) Deserialize received objects and create proxies", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (8) Deserialize received objects and create proxies")
! -------------------------------------------------------------------------
! (9) Attributes on the State itself
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionEnter("(9) Attributes on the State itself", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (attreconflag == ESMF_ATTRECONCILE_ON) then
call ESMF_ReconcileExchgAttributes (state, vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
! -------------------------------------------------------------------------
if (profile) then
call ESMF_TraceRegionExit("(9) Attributes on the State itself", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! -------------------------------------------------------------------------
if (meminfo) call ESMF_VMLogMemInfo ("after (9) Attributes on the State itself")
! Clean up
if (associated (buffer_recv)) then
deallocate (buffer_recv, stat=memstat)
if (ESMF_LogFoundDeallocError (memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
do, i=0, ubound (id_info, 1)
if (associated (id_info(i)%id)) then
deallocate (id_info(i)%id, id_info(i)%vmid, id_info(i)%needed, &
stat=memstat)
if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
if (associated (id_info(i)%item_buffer)) then
deallocate (id_info(i)%item_buffer, &
stat=memstat)
if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end if
end do
deallocate (id_info, stat=memstat)
if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end subroutine ESMF_ReconcileBruteForce