gatherRedistFracFieldMesh Subroutine

private subroutine gatherRedistFracFieldMesh(mesh, VM, fracField, petNo, petCnt, frac, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Mesh) :: mesh
type(ESMF_VM) :: VM
type(ESMF_Field) :: fracField
integer :: petNo
integer :: petCnt
real(kind=ESMF_KIND_R8), pointer :: frac(:)
integer :: rc

Source Code

subroutine gatherRedistFracFieldMesh(mesh, vm, fracField, petNo, petCnt, frac, rc)
  type(ESMF_Mesh) :: mesh
  type(ESMF_VM) :: VM
  integer :: petNo,petCnt
  type(ESMF_Field) :: fracField
  type(ESMF_Array) :: fracArray, justPet0Array
  type(ESMF_DistGrid) :: justPet0DistGrid
  type(ESMF_RouteHandle) :: rh
  real (ESMF_KIND_R8), pointer :: frac(:)
  integer :: rc
  real (ESMF_KIND_R8), pointer :: localFrac(:)
  real (ESMF_KIND_R8), pointer :: mergedFrac(:)
  integer :: localrc
  integer :: localElemCount,i
  integer (ESMF_KIND_I4) :: localCount(1), globalCount(1)
  integer :: totalCount
  integer, pointer :: seqIndexList(:)



  ! Get localFrac from field
  call ESMF_FieldGet(fracField, localDE=0, farrayPtr=localFrac,  rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return

  localElemCount=size(localFrac)
  ! localFrac is gotten from the fracField above


  ! Get total size
  localCount(1)=localElemCount
  globalCount(1)=0
  call ESMF_VMReduce(vm,localCount,globalCount,count=1, &
            reduceflag=ESMF_REDUCE_SUM, rootPet=0,rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return


  ! Set total size
  if (petNo==0) then
     totalCount=globalCount(1)
  else
     totalCount=0
  endif

  ! Allocate and fill array to create distgrid
  allocate(seqIndexList(totalCount))
  do i=1,totalCount
     seqIndexList(i)=i
  enddo

  ! Create distgrid with everything on PET 0
  justPet0Distgrid=ESMF_DistGridCreate(seqIndexList, rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return

  ! Free seqIndexList memory
  deallocate(seqIndexList)


  ! Allocate final frac list
  allocate(frac(totalCount))

  ! Create array from distgrid
  justPet0Array=ESMF_ArrayCreate(justPet0Distgrid, &
                         farrayPtr=frac, rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return

  ! Get array from fracField
  call ESMF_FieldGet(fracField, array=fracArray, &
                     rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return


  ! Redist from one to the other
  call ESMF_ArrayRedistStore(srcArray=fracArray, &
                             dstArray=justPet0Array, &
                             routehandle=rh, rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return

  call ESMF_ArrayRedist(srcArray=fracArray, &
                        dstArray=justPet0Array, &
                        routehandle=rh, rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return

  call ESMF_ArrayRedistRelease(routehandle=rh, rc=localrc)
  if (ESMF_LogFoundError(localrc, &
       ESMF_ERR_PASSTHRU, &
       ESMF_CONTEXT, rcToReturn=rc)) return


  ! Properly redisted fractions should now be in frac(:)

  call ESMF_ArrayDestroy(justPet0Array)
  call ESMF_DistGridDestroy(justPet0Distgrid)

end subroutine gatherRedistFracFieldMesh