subroutine computeFracMesh(mesh, vm, indices, frac, rc)
type(ESMF_Mesh) :: mesh
type(ESMF_VM) :: vm
integer :: indices(:,:)
real(ESMF_KIND_R8), pointer :: frac(:)
integer :: rc
integer (ESMF_KIND_I4) :: localCount(1)
integer (ESMF_KIND_I4),pointer :: globalCount(:),globalDispl(:)
integer (ESMF_KIND_I4),pointer :: buffer(:), buffer1(:)
integer :: totalCount, maxIndex
integer :: i, j, total
integer :: petNo,petCnt
integer :: count, saved
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=rc)
! Allocate List of counts
allocate(globalCount(petCnt))
total = size(indices,2)
! find unique indices in the destination column: indices(2,:)
count = 0
saved = 0
do i=1,total
if (indices(2,i) /= saved) then
count = count+1
saved = indices(2,i)
endif
enddo
allocate(buffer(count))
saved = 0
j=1
do i=1,total
if (indices(2,i) /= saved) then
buffer(j)=indices(2,i)
j=j+1
saved = indices(2,i)
endif
enddo
! Get List of counts
localCount(1)=count
call ESMF_VMGather(vm,localCount,globalCount,count=1,rootPet=0,rc=rc)
if (rc /=ESMF_SUCCESS) then
return
endif
! Calculate Displacements
allocate(globalDispl(petCnt))
if (petNo==0) then
globalDispl(1)=0
do i=2,petCnt
globalDispl(i)=globalDispl(i-1)+globalCount(i-1)
enddo
else
globalDispl=0
endif
! Sum size
if (petNo==0) then
totalCount=0
do i=1,petCnt
totalCount=totalCount+globalCount(i)
enddo
else
totalCount=1 ! Because I'm not sure what happens
! if array is not allocated in VM
endif
! Allocate final area list
allocate(buffer1(totalCount))
! Gather all areas
call ESMF_VMGatherV(vm,sendData=buffer, sendCount=localCount(1),&
recvData=buffer1,recvCounts=globalCount,recvOffsets=globalDispl,&
rootPet=0, rc=rc)
if (rc /=ESMF_SUCCESS) then
return
endif
if (PetNo==0) then
maxIndex = maxval(buffer1)
allocate(frac(maxIndex))
frac = 0
do i=1,totalCount
frac(buffer1(i))=1
enddo
endif
! Get rid of helper variables
deallocate(buffer, buffer1)
deallocate(globalCount)
deallocate(globalDispl)
end subroutine computeFracMesh