ESMF_ArrayGatherUTest Program

Uses

  • program~~esmf_arraygatherutest~~UsesGraph program~esmf_arraygatherutest ESMF_ArrayGatherUTest module~esmf ESMF program~esmf_arraygatherutest->module~esmf module~esmf_testmod ESMF_TestMod program~esmf_arraygatherutest->module~esmf_testmod

Calls

program~~esmf_arraygatherutest~~CallsGraph program~esmf_arraygatherutest ESMF_ArrayGatherUTest proc~esmf_finalize ESMF_Finalize program~esmf_arraygatherutest->proc~esmf_finalize proc~esmf_test ESMF_Test program~esmf_arraygatherutest->proc~esmf_test proc~esmf_testend ESMF_TestEnd program~esmf_arraygatherutest->proc~esmf_testend proc~esmf_testminpets ESMF_TestMinPETs program~esmf_arraygatherutest->proc~esmf_testminpets proc~esmf_teststart ESMF_TestStart program~esmf_arraygatherutest->proc~esmf_teststart proc~test_gather_1d test_gather_1d program~esmf_arraygatherutest->proc~test_gather_1d proc~test_gather_2d test_gather_2d program~esmf_arraygatherutest->proc~test_gather_2d proc~test_gather_3d test_gather_3d program~esmf_arraygatherutest->proc~test_gather_3d 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 interface~esmf_vmget ESMF_VMGet proc~esmf_testminpets->interface~esmf_vmget proc~esmf_testminpets->proc~esmf_logwrite proc~esmf_vmgetglobal ESMF_VMGetGlobal proc~esmf_testminpets->proc~esmf_vmgetglobal 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 esmf_arraycreate esmf_arraycreate proc~test_gather_1d->esmf_arraycreate esmf_arraydestroy esmf_arraydestroy proc~test_gather_1d->esmf_arraydestroy esmf_arraygather esmf_arraygather proc~test_gather_1d->esmf_arraygather esmf_arrayget esmf_arrayget proc~test_gather_1d->esmf_arrayget interface~esmf_distgridcreate ESMF_DistGridCreate proc~test_gather_1d->interface~esmf_distgridcreate proc~test_gather_1d->interface~esmf_vmget proc~esmf_arrayspecset ESMF_ArraySpecSet proc~test_gather_1d->proc~esmf_arrayspecset proc~esmf_distgriddestroy ESMF_DistGridDestroy proc~test_gather_1d->proc~esmf_distgriddestroy proc~esmf_logfounderror ESMF_LogFoundError proc~test_gather_1d->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~test_gather_1d->proc~esmf_logseterror proc~esmf_vmgetcurrent ESMF_VMGetCurrent proc~test_gather_1d->proc~esmf_vmgetcurrent proc~test_gather_2d->esmf_arraycreate proc~test_gather_2d->esmf_arraydestroy proc~test_gather_2d->esmf_arraygather proc~test_gather_2d->esmf_arrayget proc~test_gather_2d->interface~esmf_distgridcreate proc~test_gather_2d->interface~esmf_vmget proc~test_gather_2d->proc~esmf_arrayspecset proc~test_gather_2d->proc~esmf_distgriddestroy proc~test_gather_2d->proc~esmf_logfounderror proc~test_gather_2d->proc~esmf_vmgetcurrent proc~test_gather_3d->esmf_arraycreate proc~test_gather_3d->esmf_arraydestroy proc~test_gather_3d->esmf_arraygather proc~test_gather_3d->esmf_arrayget proc~test_gather_3d->interface~esmf_distgridcreate proc~test_gather_3d->interface~esmf_vmget proc~test_gather_3d->proc~esmf_arrayspecset proc~test_gather_3d->proc~esmf_distgriddestroy proc~test_gather_3d->proc~esmf_logfounderror proc~test_gather_3d->proc~esmf_vmgetcurrent

Variables

Type Attributes Name Initial
character(len=*), parameter :: version = '$Id$'
character(len=ESMF_MAXSTR*2) :: failMsg
character(len=ESMF_MAXSTR) :: name
integer :: rc = ESMF_SUCCESS
integer :: result = 0

Subroutines

subroutine test_gather_1d(totalLWidth, totalUWidth, dgCase, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: totalLWidth(:)
integer, intent(in) :: totalUWidth(:)
character(len=*), intent(in) :: dgCase
integer, intent(out) :: rc

subroutine test_gather_2d(totalLWidth, totalUWidth, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: totalLWidth(:)
integer, intent(in) :: totalUWidth(:)
integer, intent(out) :: rc

subroutine test_gather_3d(totalLWidth, totalUWidth, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: totalLWidth(:)
integer, intent(in) :: totalUWidth(:)
integer, intent(out) :: rc

Source Code

program ESMF_ArrayGatherUTest

!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
#include "ESMF_Macros.inc"
!
!==============================================================================
!BOPI
! !PROGRAM: ESMF_ArrayGatherUTest - This test verifies ArrayGather functionality.
!
! !DESCRIPTION:
!
! The code in this file specializes on testing the usage of ArrayGather.
!EOPI
!
!-----------------------------------------------------------------------------
! !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 result code
    integer :: rc = ESMF_SUCCESS

    ! individual test name
    character(ESMF_MAXSTR) :: name

    ! individual test failure messages
    character(ESMF_MAXSTR*2) :: failMsg

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

    if (.not. ESMF_TestMinPETs(4, ESMF_SRCLINE)) &
        call ESMF_Finalize(endflag=ESMF_END_ABORT)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 1D ArrayGather() test contiguous Array
    call test_gather_1d(totalLWidth=(/0/), totalUWidth=(/0/), &
      dgCase="regDecomp", rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 1d test, contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 1D ArrayGather() test non-contiguous Array
    call test_gather_1d(totalLWidth=(/2/), totalUWidth=(/3/), &
      dgCase="regDecomp", rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 1d test, non-contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 1D ArrayGather() test contiguous Array with deBlockList DistGrid
    call test_gather_1d(totalLWidth=(/0/), totalUWidth=(/0/), &
      dgCase="deBlockList", rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 1d test, contiguous Array, deBlockList DistGrid"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 1D ArrayGather() test non-contiguous Array with deBlockList DistGrid
    call test_gather_1d(totalLWidth=(/2/), totalUWidth=(/3/), &
      dgCase="deBlockList", rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 1d test, non-contiguous Array, deBlockList DistGrid"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 2D ArrayGather() test contiguous Array
    call test_gather_2d(totalLWidth=(/0,0/), totalUWidth=(/0,0/), rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 2d test, contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 2D ArrayGather() test non-contiguous Array
    call test_gather_2d(totalLWidth=(/2,3/), totalUWidth=(/4,7/), rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 2d test, non-contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 3D ArrayGather() test contiguous Array
    call test_gather_3d(totalLWidth=(/0,0,0/), totalUWidth=(/0,0,0/), rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 3d test, contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    !------------------------------------------------------------------------
    !NEX_UTest_Multi_Proc_Only
    ! 3D ArrayGather() test non-contiguous Array
    call test_gather_3d(totalLWidth=(/11,21,31/), totalUWidth=(/9,4,3/), rc=rc)
    write(failMsg, *) ""
    write(name, *) "ArrayGather 3d test, non-contiguous Array"
    call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

    call ESMF_TestEnd(ESMF_SRCLINE)

contains

#undef ESMF_METHOD
#define ESMF_METHOD "test_gather_1d"
    subroutine test_gather_1d(totalLWidth, totalUWidth, dgCase, rc)
        integer, intent(in)       :: totalLWidth(:), totalUWidth(:)
        character(*), intent(in)  :: dgCase
        integer, intent(out)      :: rc

        ! local arguments used to create field etc
        type(ESMF_DistGrid)                         :: distgrid
        type(ESMF_VM)                               :: vm
        type(ESMF_Array)                            :: array
        type(ESMF_ArraySpec)                        :: arrayspec
        integer                                     :: localrc, localPet, i, j
        integer, allocatable                        :: deBlockList(:,:,:)

        integer, pointer                            :: farray(:)
        integer, pointer                            :: farrayDst(:)

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS

        call ESMF_VMGetCurrent(vm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_VMGet(vm, localPet=localPet, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
          
        if (trim(dgCase)=="regDecomp") then
          ! default DistGrid with regDecomp
          distgrid = ESMF_DistGridCreate(minIndex =(/1/), maxIndex=(/16/), &
            rc=localrc)
          if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else if (trim(dgCase)=="deBlockList") then
          ! DistGrid with deBlockList
          allocate(deBlockList(1, 2, 4))  ! dimCount, 2, deCount
          deBlockList(1, 1, 1) = 5        ! 1st DE minIndex
          deBlockList(1, 2, 1) = 8        ! 1st DE maxIndex
          deBlockList(1, 1, 2) = 9        ! 2nd DE minIndex
          deBlockList(1, 2, 2) = 12       ! 2nd DE maxIndex
          deBlockList(1, 1, 3) = 13       ! 3rd DE minIndex
          deBlockList(1, 2, 3) = 16       ! 3rd DE maxIndex
          deBlockList(1, 1, 4) = 1        ! 4th DE minIndex
          deBlockList(1, 2, 4) = 4        ! 4th DE maxIndex
          distgrid = ESMF_DistGridCreate(minIndex =(/1/), maxIndex=(/16/), &
            deBlockList=deBlockList, rc=localrc)
          if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
          deallocate(deBlockList)
        else
          call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
            msg="An invalid 'option' argument was provided.", &
            ESMF_CONTEXT, rcToReturn=rc)
          return
        endif

        call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_I4, rank=1, &
          rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        array = ESMF_ArrayCreate(distgrid, arrayspec, &
          totalLWidth=totalLWidth, totalUWidth=totalUWidth, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_ArrayGet(array, farrayPtr=farray, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        farray = 0  ! initialize the entire local array
        do i=1, 4
          if (trim(dgCase)=="regDecomp") then
            farray(lbound(farray,1)+totalLWidth(1)-1+i) = localPet * 10 + i
          else if (trim(dgCase)=="deBlockList") then
            farray(lbound(farray,1)+totalLWidth(1)-1+i) = mod(localPet+1,4) * 10 + i
          endif
        enddo

        if(localPet .eq. 0) then
          allocate(farrayDst(16))  ! rootPet
        else
          allocate(farrayDst(1))
        end if
        call ESMF_ArrayGather(array, farrayDst, rootPet=0, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
            
        ! check that the values gathered on rootPet are correct
        if(localPet .eq. 0) then
          do j = 1, 4
            do i = 1, 4
              if(farrayDst((j-1)*4+i) .ne. (j-1)*10+i) then
                localrc=ESMF_FAILURE
              endif
            enddo
          enddo
          if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif

        call ESMF_ArrayDestroy(array, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
                    
        call ESMF_DistGridDestroy(distgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
        
        deallocate(farrayDst)

        rc = ESMF_SUCCESS
    end subroutine test_gather_1d

#undef ESMF_METHOD
#define ESMF_METHOD "test_gather_2d"
    subroutine test_gather_2d(totalLWidth, totalUWidth, rc)
        integer, intent(in)   :: totalLWidth(:), totalUWidth(:)
        integer, intent(out)  :: rc

        ! local arguments used to create field etc
        type(ESMF_DistGrid)                         :: distgrid
        type(ESMF_VM)                               :: vm
        type(ESMF_Array)                            :: array
        type(ESMF_ArraySpec)                        :: arrayspec
        integer                                     :: localrc, localPet, i, j

        integer, pointer                            :: farray(:,:)
        integer, pointer                            :: farrayDst(:,:)

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS

        call ESMF_VMGetCurrent(vm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_VMGet(vm, localPet=localPet, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/10,20/), &
          regDecomp=(/2,2/), rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_I4, rank=2, &
          rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        array = ESMF_ArrayCreate(distgrid, arrayspec, &
          totalLWidth=totalLWidth, totalUWidth=totalUWidth, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_ArrayGet(array, farrayPtr=farray, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        farray = 0  ! initialize the entire local array
        do j=1, 10
        do i=1, 5
          farray(lbound(farray,1)+totalLWidth(1)-1+i, &
                 lbound(farray,2)+totalLWidth(2)-1+j) &
            = localPet * 100 + ((j-1)*5+i)
        enddo
        enddo

        if(localPet .eq. 0) then
          allocate(farrayDst(10,20))  ! rootPet
        else
          allocate(farrayDst(1,1))
        end if
        call ESMF_ArrayGather(array, farrayDst, rootPet=0, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
          
        ! check that the values gathered on rootPet are correct
        if(localPet .eq. 0) then
          ! from DE 0
          do j=1, 10
          do i=1, 5
            if(farrayDst(i, j) /= ((j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          ! from DE 1
          do j=1, 10
          do i=1, 5
            if(farrayDst(5+i, j) /= 1*100 + ((j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          ! from DE 2
          do j=1, 10
          do i=1, 5
            if(farrayDst(i, 10+j) /= 2*100 + ((j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          ! from DE 3
          do j=1, 10
          do i=1, 5
            if(farrayDst(5+i, 10+j) /= 3*100 + ((j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          if (ESMF_LogFoundError(localrc, &
            ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif

        call ESMF_ArrayDestroy(array, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
                    
        call ESMF_DistGridDestroy(distgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
        
        deallocate(farrayDst)
        rc = ESMF_SUCCESS
    end subroutine test_gather_2d


#undef ESMF_METHOD
#define ESMF_METHOD "test_gather_3d"
    subroutine test_gather_3d(totalLWidth, totalUWidth, rc)
        integer, intent(in)   :: totalLWidth(:), totalUWidth(:)
        integer, intent(out)  :: rc

        ! local arguments used to create field etc
        type(ESMF_DistGrid)                         :: distgrid
        type(ESMF_VM)                               :: vm
        type(ESMF_Array)                            :: array
        type(ESMF_ArraySpec)                        :: arrayspec
        integer                                     :: localrc, localPet, i, j, k

        integer, pointer                            :: farray(:,:,:)
        integer, pointer                            :: farrayDst(:,:,:)

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS

        call ESMF_VMGetCurrent(vm, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_VMGet(vm, localPet=localPet, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        distgrid = ESMF_DistGridCreate(minIndex=(/1,1,1/), &
          maxIndex=(/10,20,5/), regDecomp=(/2,2,1/), rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_I4, rank=3, &
          rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        array = ESMF_ArrayCreate(distgrid, arrayspec, &
          totalLWidth=totalLWidth, totalUWidth=totalUWidth, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_ArrayGet(array, farrayPtr=farray, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        farray = 0  ! initialize the entire local array
        do k=1, 5
        do j=1, 10
        do i=1, 5
          farray(lbound(farray,1)+totalLWidth(1)-1+i, &
                 lbound(farray,2)+totalLWidth(2)-1+j, &
                 lbound(farray,3)+totalLWidth(3)-1+k) &
            = localPet * 1000 + ((k-1)*50+(j-1)*5+i)
        enddo
        enddo
        enddo

        if(localPet .eq. 0) then
          allocate(farrayDst(10,20,5))  ! rootPet
        else
          allocate(farrayDst(1,1,1))  ! rootPet
        end if
        call ESMF_ArrayGather(array, farrayDst, rootPet=0, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return

        ! check that the values gathered on rootPet are correct
        if(localPet .eq. 0) then
          ! from DE 0
          do k=1, 5
          do j=1, 10
          do i=1, 5
            if(farrayDst(i, j, k) /= ((k-1)*50+(j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          enddo
          ! from DE 1
          do k=1, 5
          do j=1, 10
          do i=1, 5
            if(farrayDst(5+i, j, k) /= 1*1000 + ((k-1)*50+(j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          enddo
          ! from DE 2
          do k=1, 5
          do j=1, 10
          do i=1, 5
            if(farrayDst(i, 10+j, k) /= 2*1000 + ((k-1)*50+(j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          enddo
          ! from DE 3
          do k=1, 5
          do j=1, 10
          do i=1, 5
            if(farrayDst(5+i, 10+j, k) /= 3*1000 + ((k-1)*50+(j-1)*5+i)) then
              localrc=ESMF_FAILURE
            endif
          enddo
          enddo
          enddo
        endif

        call ESMF_ArrayDestroy(array, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
                    
        call ESMF_DistGridDestroy(distgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return
        
        deallocate(farrayDst)
        rc = ESMF_SUCCESS
    end subroutine test_gather_3d

end program ESMF_ArrayGatherUTest