gatherFracFieldGrid Subroutine

private subroutine gatherFracFieldGrid(grid, fracField, petNo, frac, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Grid) :: grid
type(ESMF_Field) :: fracField
integer :: petNo
real(kind=ESMF_KIND_R8), pointer :: frac(:)
integer :: rc

Source Code

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