subroutine ESMF_ReconcileExchgAttributes (state, vm, rc)
!
! !ARGUMENTS:
type(ESMF_State), intent(inout):: state
type(ESMF_VM), intent(in) :: vm
integer, intent(out) :: rc
!
! !DESCRIPTION:
!
! Exchange attributes on the base of the State itself.
!
! The arguments are:
! \begin{description}
! \item[state]
! {\tt ESMF\_State} to add proxy objects to.
! \item[vm]
! The current {\tt ESMF\_VM} (virtual machine).
! \item[rc]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!EOPI
integer :: localrc
integer :: memstat
type(ESMF_Base), pointer :: base
type(ESMF_Base) :: base_temp
character, allocatable :: buffer_local(:), buffer_recv(:)
integer, allocatable :: recv_sizes(:), recv_offsets(:)
integer :: buffer_size(1)
integer :: i, pass
integer :: mypet, npets
integer :: offset
type(ESMF_InquireFlag) :: inqflag
type(ESMF_Info) :: base_info, base_temp_info
logical, parameter :: debug = .false.
logical, parameter :: profile = .false.
rc = 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
base => state%statep%base
! Serialize the Base attributes
if (profile) then
call ESMF_TraceRegionEnter("Serialize the Base attributes", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
do, pass = 1, 2
select case (pass)
case (1)
! Pass 1 finds the required buffer length to serialize any attributes.
allocate (buffer_local(4), stat=memstat) ! Dummy to avoid null pointer derefs
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
inqflag = ESMF_INQUIREONLY
case (2)
! Pass 2 allocates the buffer and performs the actual serialization.
deallocate (buffer_local, stat=memstat)
if (ESMF_LogFoundDeallocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
allocate (buffer_local(0:offset-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
buffer_local = achar (0)
inqflag = ESMF_NOINQUIRE
end select
offset = 0
call ESMF_BaseSerialize (base, buffer_local, offset, &
ESMF_ATTRECONCILE_ON, inqflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
end do ! pass
if (profile) then
call ESMF_TraceRegionExit("Serialize the Base attributes", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! Exchange serialized buffer sizes
if (profile) then
call ESMF_TraceRegionEnter("Exchange serialized buffer sizes", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
allocate (recv_sizes(0:npets-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
buffer_size(1) = offset
if (profile) then
call ESMF_TraceRegionEnter("ESMF_VMAllGather", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
call ESMF_VMAllGather (vm, &
sendData=buffer_size, recvData=recv_sizes, &
count=1, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (profile) then
call ESMF_TraceRegionExit("ESMF_VMAllGather", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
if (profile) then
call ESMF_TraceRegionExit("Exchange serialized buffer sizes", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
if (debug) then
print *, ESMF_METHOD, &
': PET', mypet, ': Base sizes recved are:', recv_sizes
end if
! Exchange serialized buffers
if (profile) then
call ESMF_TraceRegionEnter("Exchange serialized buffers", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
allocate ( &
buffer_recv(0:sum (recv_sizes)-1), &
recv_offsets(0:npets-1), stat=memstat)
if (ESMF_LogFoundAllocError(memstat, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
recv_offsets(0) = 0
do, i=1, npets-1
recv_offsets(i) = recv_offsets(i-1)+recv_sizes(i-1)
end do
if (debug) then
print *, ESMF_METHOD, &
': PET', mypet, ': Base offsets recved are:', recv_offsets
end if
if (profile) then
call ESMF_TraceRegionEnter("ESMF_VMAllGatherV", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
call ESMF_VMAllGatherV (vm, &
sendData=buffer_local(:buffer_size(1)-1), sendCount=buffer_size(1), &
recvData=buffer_recv, recvCounts=recv_sizes, recvOffsets=recv_offsets, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
if (profile) then
call ESMF_TraceRegionExit("ESMF_VMAllGatherV", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
if (profile) then
call ESMF_TraceRegionExit("Exchange serialized buffers", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
! Update local Base
if (profile) then
call ESMF_TraceRegionEnter("Update local Base", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
do, i=0, npets-1
if (i /= mypet) then
base_temp = ESMF_BaseDeserializeWoGarbage(buffer_recv, &
offset=recv_offsets(i), attreconflag=ESMF_ATTRECONCILE_ON, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_BaseSetInitCreated(base_temp, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoGetFromBase(base_temp, base_temp_info, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoGetFromBase(base, base_info, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoUpdate(base_info, base_temp_info, recursive=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_BaseDestroyWoGarbage(base_temp, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
end if
end do
if (profile) then
call ESMF_TraceRegionExit("Update local Base", rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, &
rcToReturn=rc)) return
endif
deallocate(buffer_local)
deallocate(recv_sizes)
deallocate(recv_offsets)
deallocate(buffer_recv)
rc = ESMF_SUCCESS
end subroutine ESMF_ReconcileExchgAttributes