test_gather_2d Subroutine

    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