ESMF_TestResultsGather Subroutine

public subroutine ESMF_TestResultsGather(vm, localPet, petCount, testResults, file, line, unit, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_VM), intent(in) :: vm
integer, intent(in) :: localPet
integer, intent(in) :: petCount
integer, intent(in) :: testResults
character(len=*), intent(in) :: file
integer, intent(in) :: line
integer, intent(in), optional :: unit
integer, intent(out), optional :: rc

Source Code

      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