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

Calls

proc~~esmf_reconcileexchgneeds~~CallsGraph proc~esmf_reconcileexchgneeds ESMF_ReconcileExchgNeeds interface~esmf_vmalltoallv ESMF_VMAllToAllV proc~esmf_reconcileexchgneeds->interface~esmf_vmalltoallv interface~esmf_vmget ESMF_VMGet proc~esmf_reconcileexchgneeds->interface~esmf_vmget proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~esmf_reconcileexchgneeds->proc~esmf_logfoundallocerror proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_reconcileexchgneeds->proc~esmf_logfounderror proc~esmf_traceregionenter ESMF_TraceRegionEnter proc~esmf_reconcileexchgneeds->proc~esmf_traceregionenter proc~esmf_traceregionexit ESMF_TraceRegionExit proc~esmf_reconcileexchgneeds->proc~esmf_traceregionexit proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_reconcileexchgneeds->proc~esmf_utiliounitflush proc~esmf_vmalltoallvchararray ESMF_VMAllToAllVCharArray interface~esmf_vmalltoallv->proc~esmf_vmalltoallvchararray proc~esmf_vmalltoallvflogical ESMF_VMAllToAllVFLogical interface~esmf_vmalltoallv->proc~esmf_vmalltoallvflogical proc~esmf_vmalltoallvi4 ESMF_VMAllToAllVI4 interface~esmf_vmalltoallv->proc~esmf_vmalltoallvi4 proc~esmf_vmalltoallvi8 ESMF_VMAllToAllVI8 interface~esmf_vmalltoallv->proc~esmf_vmalltoallvi8 proc~esmf_vmalltoallvr4 ESMF_VMAllToAllVR4 interface~esmf_vmalltoallv->proc~esmf_vmalltoallvr4 proc~esmf_vmalltoallvr8 ESMF_VMAllToAllVR8 interface~esmf_vmalltoallv->proc~esmf_vmalltoallvr8 proc~esmf_vmgetdefault ESMF_VMGetDefault interface~esmf_vmget->proc~esmf_vmgetdefault proc~esmf_vmgetpetspecific ESMF_VMGetPetSpecific interface~esmf_vmget->proc~esmf_vmgetpetspecific esmf_breakpoint esmf_breakpoint proc~esmf_logfoundallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfoundallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfoundallocerror->proc~esmf_logwrite proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logfounderror->proc~esmf_logwrite proc~esmf_traceregionenter->proc~esmf_logfounderror c_esmftrace_region_enter c_esmftrace_region_enter proc~esmf_traceregionenter->c_esmftrace_region_enter proc~esmf_traceregionexit->proc~esmf_logfounderror c_esmftrace_region_exit c_esmftrace_region_exit proc~esmf_traceregionexit->c_esmftrace_region_exit

Called by

proc~~esmf_reconcileexchgneeds~~CalledByGraph proc~esmf_reconcileexchgneeds ESMF_ReconcileExchgNeeds proc~esmf_reconcilebruteforce ESMF_ReconcileBruteForce proc~esmf_reconcilebruteforce->proc~esmf_reconcileexchgneeds

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 :: localPet, petCount
    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=localPet, petCount=petCount, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    if (size (id_info) /= petCount) then
      if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, &
          msg="size (id_info) /= petCount", &
          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:petCount-1),  &
        offsets_send(0:petCount-1),  &
        stat=memstat)
    if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

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

    itemcount_local = counts_send(localPet)
    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, petCount-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:petCount-1),  &
        offsets_recv(0:petCount-1),  &
        buffer_recv(0:itemcount_local*petCount-1),  &
        recv_needs(itemcount_local,0:petCount-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, petCount-1) /)
    buffer_recv = .false.

    ! 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=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, petCount-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, petCount-1
        write (msgstring,'(a,i0,a,i0,a)')  &
            '  PET ', localPet, ': 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