subroutine gatherFracFieldGrid(grid, fracField, petNo, frac, rc)
type(ESMF_Grid) :: grid
type(ESMF_Field) :: fracField
integer :: petNo
real (ESMF_KIND_R8), pointer :: frac(:)
integer :: rc
integer :: minIndex(2), maxIndex(2), gridDims(2)
real (ESMF_KIND_R8), pointer :: frac2D(:,:)
integer :: i, start, ntiles
integer :: localrc
! Get size of Grid
call ESMF_GridGet(grid, tile=1, staggerloc=ESMF_STAGGERLOC_CENTER, &
minIndex=minIndex, maxIndex=maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get number of tiles
call ESMF_GridGet(grid, tileCount = ntiles, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Grid size
gridDims(1)=maxIndex(1)-minIndex(1)+1
gridDims(2)=maxIndex(2)-minIndex(2)+1
! Allocate memory for area
allocate(frac2D(gridDims(1),gridDims(2)))
! Only do this part on PET 0
if (petNo .eq. 0) then
! Allocate memory for area
allocate(frac(gridDims(1)*gridDims(2)*ntiles))
endif
! Get area onto PET 0
start = 1
do i=1,ntiles
call ESMF_FieldGather(fracField, farray=frac2D, rootPet=0, tile=i, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! copy to 1D array
if (PetNo == 0) then
! flatten area
frac(start:start+gridDims(1)*gridDims(2)-1)=RESHAPE(frac2D,(/gridDims(1)*gridDims(2)/))
start= start+gridDims(1)*gridDims(2)
endif
enddo
! deallocate memory for 2D area
deallocate(frac2D)
end subroutine gatherFracFieldGrid