subroutine ESMF_TestResultsGather(vm, localPet, petCount, testResults, &
file, line, unit, rc)
! !ARGUMENTS:
type(ESMF_VM), intent(in) :: vm ! the vm of this pet
integer, intent(in) :: localPet ! number of this pet
integer, intent(in) :: petCount ! number of pets
integer, intent(in) :: testResults ! test results for this pet
character(*), intent(in) :: file ! test file name
integer, intent(in) :: line ! test file line number
integer, intent(in), optional :: unit ! additional output unit number
integer, intent(out), optional :: rc ! return code
! !DESCRIPTION:
! The gatherPet gathers the test results, PASS/FAIl, from all other
! Pets and prints out a PASS/FAIL Message . This subroutine should
! be called at the end of system tests and use test cases.
!
!EOP
!-------------------------------------------------------------------------------
character(ESMF_MAXSTR) :: msg
! character(ESMF_MAXSTR) :: failMsg
integer, allocatable:: array1(:), array2(:)
integer:: finalrc, gatherRoot, i, localrc
character(16) :: linestr
write (linestr,*) line
linestr = adjustl (linestr)
allocate(array1(petCount))
allocate(array2(1))
! Store test results
array2(1) = testResults
gatherRoot = 0
! Don't Gather until all pets are done
call ESMF_VMBarrier(vm, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) then
write(msg, *) " FAIL ESMF_VMBarrier failed. Error code ", localrc
print *, trim(msg)
if (present(unit)) write(unit, *) trim(msg)
if (present(rc)) rc = localrc
return
endif
! Gather test results
call ESMF_VMGather(vm, sendData=array2, recvData=array1, count=1, &
rootPet=gatherRoot, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) then
write(msg, *) " FAIL ESMF_VMGather failed. Error code ", localrc
print *, trim(msg)
if (present(unit)) write(unit, *) trim(msg)
if (present(rc)) rc = localrc
return
endif
! assume success
finalrc=ESMF_SUCCESS
! The gather pet checks the results and prints out PASS/FAIL message.
if (localPet==gatherRoot) then
do i=1, petCount
if (array1(i).EQ.ESMF_FAILURE) finalrc = ESMF_FAILURE
enddo
if (finalrc.EQ.ESMF_SUCCESS) then
print *, " PASS: ", trim(file), ' ', trim (linestr)
call c_ESMC_PrintPassFlush(); ! print and flush out of C++
else
print *, " FAIL: ", trim(file), ' ', trim (linestr)
endif
endif
deallocate(array1)
deallocate(array2)
! Don't end test until all pets are done
call ESMF_VMBarrier(vm, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) then
write(msg, *) " FAIL ESMF_VMBarrier failed. Error code ", localrc
print *, trim(msg)
if (present(unit)) write(unit, *) trim(msg)
if (present(rc)) rc = localrc
return
endif
if (present(rc)) rc=ESMF_SUCCESS
end subroutine ESMF_TestResultsGather