ESMF_ReconcileSingleCompCase Subroutine

  subroutine ESMF_ReconcileSingleCompCase(state, vm, vmId, vmIntId, &
    attreconflag, siwrap, vmintids_send, rc)
!
! !ARGUMENTS:
    type(ESMF_State),                     intent(inout) :: state
    type(ESMF_VM),                        intent(in)    :: vm
    type(ESMF_VMId),             pointer, intent(in)    :: vmId
    integer,                              intent(in)    :: vmIntId
    type(ESMF_AttReconcileFlag),          intent(in)    :: attreconflag
    type(ESMF_StateItemWrap),    pointer, intent(in)    :: siwrap(:)
    integer,                     pointer, intent(in)    :: vmintids_send(:)
    integer,                              intent(out)   :: rc
!
! !DESCRIPTION:
!
!   Handle the single component reconciliation case. This is the expected
!   situation under NUOPC rules.
!
!   The arguments are:
!   \begin{description}
!   \item[state]
!     The {\tt ESMF\_State} to reconcile.
!   \item[vm]
!     The {\tt ESMF\_VM} object across which to reconcile {\tt state}.
!   \item[vmId]
!     The {\tt ESMF\_VMId} of the objects in {\tt state} to reconcile.
!   \item[vmIntId]
!     The integer VMId of the objects in {\tt state} to reconcile.
!   \item[attreconflag]
!     Flag indicating whether attributes need to be reconciled.
!   \item[siwrap]
!     List of local state items.
!   \item[vmintids_send]
!     The integer VMId for each local state item.
!   \item[rc]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!EOPI

    integer               :: localrc, i
    integer               :: petCount, localPet, rootVas, rootPet, vas
    integer               :: sizeBuffer(1), itemCount
    logical               :: isFlag
    character, pointer    :: buffer(:)
    integer, allocatable  :: itemList(:)

    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_ReconcileSingleCompCase() 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

    call ESMF_VMIdGet(vmId, leftMostOnBit=rootVas, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return

    ! search for first PET in VM that executes on rootVas -> use as rootPet
    do rootPet=0, petCount-1
      call ESMF_VMGet(vm, pet=rootPet, vas=vas, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
      if (vas==rootVas) exit  ! found
    enddo
    if (rootPet==petCount) then
      call ESMF_LogSetError(ESMF_RC_INTNRL_INCONS, &
        msg="Could not find PET that executes on the identified VAS", &
        ESMF_CONTEXT, rcToReturn=rc)
      return
    endif

#ifdef RECONCILE_LOG_on
    block
      character(160)  :: msgStr
      write(msgStr,*) "SingleCompCase rootVas=", rootVas
      call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
      write(msgStr,*) "SingleCompCase rootPet=", rootPet
      call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
      write(msgStr,*) "SingleCompCase size(siwrap)=", size(siwrap)
      call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
    end block
#endif

    ! On rootPet: construct itemList and serialize
    if (localPet==rootPet) then
      ! itemList to hold indices into siwrap(:) of objects that need to be sent
      allocate(itemList(ubound(vmintids_send,1)))   ! max number of items possible
      itemCount=0
      do i=1, size(itemList)
        if (vmintids_send(i)==vmIntId) then
          ! the integer VMId of object "i" matches that of handled single comp
          itemCount = itemCount+1
          itemList(itemCount) = i
        endif
      enddo
      ! serialize all items in itemList
      call ESMF_ReconcileSerializeAll(state, itemList, itemCount, &
        attreconflag, siwrap, buffer, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
      sizeBuffer(1) = size(buffer)
      ! cleanup
      deallocate(itemList)
    endif

    ! Broadcast buffer across all PETs
    call ESMF_VMBroadcast(vm, sizeBuffer, count=1, rootPet=rootPet, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
      rcToReturn=rc)) return

#ifdef RECONCILE_LOG_on
    block
      character(160)  :: msgStr
      write(msgStr,*) "SingleCompCase sizeBuffer=", sizeBuffer(1)
      call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
    end block
#endif

    if (localPet/=rootPet) allocate(buffer(0:sizeBuffer(1)-1))

    call ESMF_VMBroadcast(vm, buffer, count=sizeBuffer(1), rootPet=rootPet, &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
      rcToReturn=rc)) return

    ! determine if local PET is active under the vmId
    call ESMF_VMIdGet(vmId, isLocalPetActive=isFlag, rc=localrc)
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
      rcToReturn=rc)) return

#ifdef RECONCILE_LOG_on
    block
      character(160)  :: msgStr
      write(msgStr,*) "SingleCompCase PET active isFlag=", isFlag
      call ESMF_LogWrite(msgStr, ESMF_LOGMSG_DEBUG, rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
    end block
#endif

    ! only inactive PETs deserialize the buffer received from rootPet
    if (.not.isFlag) then
      call ESMF_ReconcileDeserializeAll(state, vm, attreconflag, buffer, &
        rc=localrc)
      if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, &
        rcToReturn=rc)) return
    endif

    ! Get rid of buffer
    deallocate(buffer)

  end subroutine ESMF_ReconcileSingleCompCase