ESMF_VMGatherUTest Program

Uses

  • program~~esmf_vmgatherutest~~UsesGraph program~esmf_vmgatherutest ESMF_VMGatherUTest module~esmf ESMF program~esmf_vmgatherutest->module~esmf module~esmf_testmod ESMF_TestMod program~esmf_vmgatherutest->module~esmf_testmod

Calls

program~~esmf_vmgatherutest~~CallsGraph program~esmf_vmgatherutest ESMF_VMGatherUTest interface~esmf_vmgather ESMF_VMGather program~esmf_vmgatherutest->interface~esmf_vmgather interface~esmf_vmgatherv ESMF_VMGatherV program~esmf_vmgatherutest->interface~esmf_vmgatherv interface~esmf_vmget ESMF_VMGet program~esmf_vmgatherutest->interface~esmf_vmget proc~esmf_finalize ESMF_Finalize program~esmf_vmgatherutest->proc~esmf_finalize proc~esmf_test ESMF_Test program~esmf_vmgatherutest->proc~esmf_test proc~esmf_testend ESMF_TestEnd program~esmf_vmgatherutest->proc~esmf_testend proc~esmf_teststart ESMF_TestStart program~esmf_vmgatherutest->proc~esmf_teststart proc~esmf_vmgetglobal ESMF_VMGetGlobal program~esmf_vmgatherutest->proc~esmf_vmgetglobal proc~esmf_vmgatherflogical2d ESMF_VMGatherFLogical2D interface~esmf_vmgather->proc~esmf_vmgatherflogical2d proc~esmf_vmgatheri4 ESMF_VMGatherI4 interface~esmf_vmgather->proc~esmf_vmgatheri4 proc~esmf_vmgatheri8 ESMF_VMGatherI8 interface~esmf_vmgather->proc~esmf_vmgatheri8 proc~esmf_vmgatherlogical ESMF_VMGatherLogical interface~esmf_vmgather->proc~esmf_vmgatherlogical proc~esmf_vmgatherr4 ESMF_VMGatherR4 interface~esmf_vmgather->proc~esmf_vmgatherr4 proc~esmf_vmgatherr8 ESMF_VMGatherR8 interface~esmf_vmgather->proc~esmf_vmgatherr8 proc~esmf_vmgathervi4 ESMF_VMGatherVI4 interface~esmf_vmgatherv->proc~esmf_vmgathervi4 proc~esmf_vmgathervi8 ESMF_VMGatherVI8 interface~esmf_vmgatherv->proc~esmf_vmgathervi8 proc~esmf_vmgathervr4 ESMF_VMGatherVR4 interface~esmf_vmgatherv->proc~esmf_vmgathervr4 proc~esmf_vmgathervr8 ESMF_VMGatherVR8 interface~esmf_vmgatherv->proc~esmf_vmgathervr8 proc~esmf_vmgetdefault ESMF_VMGetDefault interface~esmf_vmget->proc~esmf_vmgetdefault proc~esmf_vmgetpetspecific ESMF_VMGetPetSpecific interface~esmf_vmget->proc~esmf_vmgetpetspecific c_esmc_getcompliancechecktrace c_esmc_getcompliancechecktrace proc~esmf_finalize->c_esmc_getcompliancechecktrace proc~esmf_calendarfinalize ESMF_CalendarFinalize proc~esmf_finalize->proc~esmf_calendarfinalize proc~esmf_logfinalize ESMF_LogFinalize proc~esmf_finalize->proc~esmf_logfinalize proc~esmf_logflush ESMF_LogFlush proc~esmf_finalize->proc~esmf_logflush proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_finalize->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_finalize->proc~esmf_logwrite proc~esmf_traceclose ESMF_TraceClose proc~esmf_finalize->proc~esmf_traceclose proc~esmf_vmabort ESMF_VMAbort proc~esmf_finalize->proc~esmf_vmabort proc~esmf_vmfinalize ESMF_VMFinalize proc~esmf_finalize->proc~esmf_vmfinalize proc~esmf_test->proc~esmf_logwrite proc~esmf_testend->proc~esmf_finalize proc~esmf_testend->proc~esmf_logwrite proc~esmf_teststart->interface~esmf_vmget proc~esmf_initialize ESMF_Initialize proc~esmf_teststart->proc~esmf_initialize proc~esmf_logset ESMF_LogSet proc~esmf_teststart->proc~esmf_logset proc~esmf_teststart->proc~esmf_logwrite

Variables

Type Attributes Name Initial
character(len=*), parameter :: version = '$Id$'
character(len=ESMF_MAXSTR) :: failMsg
character(len=ESMF_MAXSTR) :: name
integer, allocatable :: array1(:)
integer, allocatable :: array2(:)
integer :: gatherRoot
integer :: i
integer :: localPet
integer :: nlen
integer :: nsize
integer :: petCount
integer :: rc
integer, allocatable :: recvCounts(:)
integer, allocatable :: recvOffsets(:)
integer :: result = 0
real(kind=ESMF_KIND_R4), allocatable :: f4array1(:)
real(kind=ESMF_KIND_R4), allocatable :: f4array2(:)
real(kind=ESMF_KIND_R8), allocatable :: farray1(:)
real(kind=ESMF_KIND_R8), allocatable :: farray2(:)
type(ESMF_VM) :: vm

Source Code

program ESMF_VMGatherUTest

!------------------------------------------------------------------------------
 
#include "ESMF_Macros.inc"

!==============================================================================
!BOP
! !PROGRAM: ESMF_VMGatherUTest - Unit test for VM Gather Functions
!
! !DESCRIPTION:
!
! The code in this file drives the F90 VM  Gather tests.  The VM
! Gather function is complex enough to require a separate test file.
!   It runs on multiple processors.
!
!-----------------------------------------------------------------------------
! !USES:
  use ESMF_TestMod     ! test methods
  use ESMF

  implicit none

!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
  character(*), parameter :: version = &
    '$Id$'
!------------------------------------------------------------------------------
  ! cumulative result: count failures; no failures equals "all pass"
  integer :: result = 0

  ! individual test failure message
  character(ESMF_MAXSTR) :: name
  character(ESMF_MAXSTR) :: failMsg

  ! local variables
  integer::  rc
  type(ESMF_VM):: vm
  integer:: localPet, petCount
  integer:: nlen, nsize, i, gatherRoot
  integer, allocatable:: array1(:), array2(:)
  real(ESMF_KIND_R8), allocatable:: farray1(:), farray2(:)
  real(ESMF_KIND_R4), allocatable:: f4array1(:), f4array2(:)
  integer, allocatable:: recvCounts(:), recvOffsets(:)
     
!------------------------------------------------------------------------------
! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are
! always run. When the environment variable, EXHAUSTIVE, is set to ON then
! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set
! Special strings (Non-exhaustive and exhaustive) have been
! added to allow a script to count the number and types of unit tests.
!------------------------------------------------------------------------------

  !------------------------------------------------------------------------
  call ESMF_TestStart(ESMF_SRCLINE, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  !------------------------------------------------------------------------

  ! get global vm information
  call ESMF_VMGetGlobal(vm, rc=rc)
  call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc)

  gatherRoot = petCount - 1
  ! allocate data arrays
  nsize = 2
  nlen = nsize * petCount
  allocate(array1(nlen))
  allocate(array2(nsize))
  allocate(farray1(nlen))
  allocate(farray2(nsize))
  allocate(f4array1(nlen))
  allocate(f4array2(nsize))

  ! prepare data array1
  do i=1, nlen
    array1    = 0
    farray1   = 0
    f4array1  = 0
  enddo

  ! prepare data array2
  do i=1, nsize
    array2(i)   = 2*localPet + i
    farray2(i)  = real(2*localPet + i, ESMF_KIND_R8)
    f4array2(i) = real(farray2(i), ESMF_KIND_R4)
  enddo

  !Testing with Integer arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "Gather() Test for Integer"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGather(vm, sendData=array2, recvData=array1, count=nsize, &
    rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify array1 data after gather
  write(name, *) "Verifying array1 data after Gather() Test for Integer"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (array1(i)/=i) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (array1(i)/=0) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "Contents after gather (should be 1,2,... at ", &
    "localPet=petCount-1 , 0 elsewhere), :"
  do i=1,nlen
    print *, localPet," array1: ", array1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify array2 data after gather
  write(name, *) "Verifying array2 data after Gather() Test for Integer"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (array2(i)/=(i + 2 * localPet)) rc = ESMF_FAILURE
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !Testing with ESMF_KIND_R8 arguments
  !===================================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "Gather() Test for ESMF_KIND_R8"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGather(vm, sendData=farray2, recvData=farray1, count=nsize, &
    rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify farray1 data after gather
  write(name, *) "Verifying farray1 data after Gather() Test for ESMF_KIND_R8"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (farray1(i)/=real(i,ESMF_KIND_R8)) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (farray1(i)/=0.) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "contents after gather (should be 1.,2.,... at ", &
    "localPet=petCount-1 , 0. elsewhere), :"
  do i=1,nlen
    print *, localPet," farray1: ", farray1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify farray2 data after gather
  write(name, *) "Verifying farray2 data after Gather() Test for ESMF_KIND_R8"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (farray2(i)/=real(i + 2 * localPet,ESMF_KIND_R8)) rc = ESMF_FAILURE
  enddo

  print *, "contents after gather (should be localPet*2+1, localPet*2+2):"
  do i=1, nsize
    print *, localPet," farray2: ", farray2(i)
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !Testing with ESMF_KIND_R4 arguments
  !===================================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "Gather() Test for ESMF_KIND_R4"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGather(vm, sendData=f4array2, recvData=f4array1, count=nsize, &
    rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f4array1 data after gather
  write(name, *) "Verifying f4array1 data after Gather() Test for ESMF_KIND_R4"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (f4array1(i)/=real(i,ESMF_KIND_R4)) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (f4array1(i)/=0.) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "contents after gather (should be 1.,2.,... at ", &
    "localPet=petCount-1 , 0. elsewhere), :"
  do i=1,nlen
    print *, localPet," f4array1: ", f4array1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f4array2 data after gather
  write(name, *) "Verifying f4array2 data after Gather() Test for ESMF_KIND_R4"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (f4array2(i)/=real(i + 2 * localPet,ESMF_KIND_R4)) rc = ESMF_FAILURE
  enddo

  print *, "contents after gather (should be localPet*2+1, localPet*2+2):"
  do i=1, nsize
    print *, localPet," f4array2: ", f4array2(i)
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)


  !------------------------------------------------------------------------
  !------------------------------------------------------------------------
  ! Next test the same as above but for GatherV()
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------


  ! prepare data array1
  do i=1, nlen
    array1    = 0
    farray1   = 0
    f4array1  = 0
  enddo

  ! prepare data array2
  do i=1, nsize
    array2(i)   = 2*localPet + i
    farray2(i)  = real(2*localPet + i, ESMF_KIND_R8)
    f4array2(i) = real(farray2(i), ESMF_KIND_R4)
  enddo
  
  ! recvCounts and recvOffsets
  allocate(recvCounts(petCount))
  recvCounts = nsize
  allocate(recvOffsets(petCount))
  recvOffsets = 0 ! initialize
  do i=2, petCount
    recvOffsets(i) = recvOffsets(i-1) + recvCounts(i-1)
  enddo

  !Testing with Integer arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "GatherV() Test for Integer"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGatherV(vm, sendData=array2, sendCount=nsize, recvData=array1, &
    recvCounts=recvCounts, recvOffsets=recvOffsets, rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify array1 data after gather
  write(name, *) "Verifying array1 data after GatherV() Test for Integer"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (array1(i)/=i) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (array1(i)/=0) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "Contents after gather (should be 1,2,... at ", &
    "localPet=petCount-1 , 0 elsewhere), :"
  do i=1,nlen
    print *, localPet," array1: ", array1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify array2 data after gather
  write(name, *) "Verifying array2 data after GatherV() Test for Integer"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (array2(i)/=(i + 2 * localPet)) rc = ESMF_FAILURE
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !Testing with ESMF_KIND_R8 arguments
  !===================================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "GatherV() Test for ESMF_KIND_R8"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGatherV(vm, sendData=farray2, sendCount=nsize, recvData=farray1, &
    recvCounts=recvCounts, recvOffsets=recvOffsets, rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify farray1 data after gather
  write(name, *) "Verifying farray1 data after GatherV() Test for ESMF_KIND_R8"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (farray1(i)/=real(i,ESMF_KIND_R8)) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (farray1(i)/=0.) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "contents after gather (should be 1.,2.,... at ", &
    "localPet=petCount-1 , 0. elsewhere), :"
  do i=1,nlen
    print *, localPet," farray1: ", farray1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify farray2 data after gather
  write(name, *) "Verifying farray2 data after GatherV() Test for ESMF_KIND_R8"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (farray2(i)/=real(i + 2 * localPet,ESMF_KIND_R8)) rc = ESMF_FAILURE
  enddo

  print *, "contents after gather (should be localPet*2+1, localPet*2+2):"
  do i=1, nsize
    print *, localPet," farray2: ", farray2(i)
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !Testing with ESMF_KIND_R4 arguments
  !===================================
  !------------------------------------------------------------------------
  !NEX_UTest
  ! Gather from gatherRoot
  write(name, *) "GatherV() Test for ESMF_KIND_R4"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_VMGatherV(vm, sendData=f4array2, sendCount=nsize, recvData=f4array1,&
    recvCounts=recvCounts, recvOffsets=recvOffsets, rootPet=gatherRoot, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f4array1 data after gather
  write(name, *) "Verifying f4array1 data after GatherV() Test for ESMF_KIND_R4"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  if (localPet==gatherRoot) then
    do i=1, nlen
      if (f4array1(i)/=real(i,ESMF_KIND_R4)) rc = ESMF_FAILURE
    enddo
  else
    do i=1, nlen
      if (f4array1(i)/=0.) rc = ESMF_FAILURE
    enddo
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  print *, "contents after gather (should be 1.,2.,... at ", &
    "localPet=petCount-1 , 0. elsewhere), :"
  do i=1,nlen
    print *, localPet," f4array1: ", f4array1(i)
  end do

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f4array2 data after gather
  write(name, *) "Verifying f4array2 data after GatherV() Test for ESMF_KIND_R4"
  write(failMsg, *) "Wrong data."
  rc = ESMF_SUCCESS
  do i=1, nsize
    if (f4array2(i)/=real(i + 2 * localPet,ESMF_KIND_R4)) rc = ESMF_FAILURE
  enddo

  print *, "contents after gather (should be localPet*2+1, localPet*2+2):"
  do i=1, nsize
    print *, localPet," f4array2: ", f4array2(i)
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  deallocate(array1)
  deallocate(array2)
  deallocate(farray1)
  deallocate(farray2)
  deallocate(f4array1)
  deallocate(f4array2)
  deallocate(recvCounts)
  deallocate(recvOffsets)

  !------------------------------------------------------------------------
  call ESMF_TestEnd(ESMF_SRCLINE)
  !------------------------------------------------------------------------

end program ESMF_VMGatherUTest