test_gather_3d Subroutine

    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