compactMatrix Subroutine

subroutine compactMatrix(inFactorList, inFactorIndexList, &
                         wasCompacted, &
                         outFactorList, outFactorIndexList, &
                         rc)
    real(ESMF_KIND_R8), intent(inout)               :: inFactorList(:)
    integer(ESMF_KIND_I4),intent(inout)             :: inFactorIndexList(:,:)
    logical, intent(out)                            :: wasCompacted
    real(ESMF_KIND_R8), pointer                     :: outFactorList(:)
    integer(ESMF_KIND_I4),pointer                   :: outFactorIndexList(:,:)
    integer, intent(out)                            :: rc
    integer  :: localrc      ! local return code
    integer  :: inListCount, outListCount
    integer  :: i, srcInd, dstInd
    integer  :: outListPos
    real(ESMF_KIND_R8) :: factorSum
    integer  :: beg


    ! Get size of list
    inListCount=size(inFactorIndexList,2)

    ! if too small to need compacting (e.g. <2) return
    if (inListCount .lt. 2) then
       wasCompacted=.false.
       return
    endif

   ! Sort the dstInd first
   call QSort(inListCount, inFactorIndexList, InFactorList)

   ! Put source indices for each run of destination
   ! indices in sorted order to allow weights with
   ! the same indices to be merged below. Note
   ! runs with less than 3 entries are not sorted because
   ! they will be handled correctly by the merge code below.
    beg=1
    dstInd=inFactorIndexList(2,1)
    do i=2,inListCount
       if (inFactorIndexList(2,i) .ne. dstInd) then
          ! Sort [beg,i-1] if there could be repeats
          if ((i-1)-beg+1 >2) then
             call hsort_array(inFactorIndexList(:,beg:i-1), inFactorList(beg:i-1))
          endif

          ! Reset
          beg=i
          dstInd=inFactorIndexList(2,i)
       endif
    enddo

    ! If long enough sort [beg,inListCount], because it's not handled above
    if ((inListCount)-beg+1 >2) then
       call hsort_array(inFactorIndexList(:,beg:inListCount), inFactorList(beg:inListCount))
    endif


    ! Loop counting unique entries
    outListCount=1 ! 1 because counting switches below
    srcInd=inFactorIndexList(1,1)
    dstInd=inFactorIndexList(2,1)
    do i=2,inListCount
       if ((srcInd /= inFactorIndexList(1,i)) .or. &
           (dstInd /= inFactorIndexList(2,i))) then
          srcInd=inFactorIndexList(1,i)
          dstInd=inFactorIndexList(2,i)
          outListCount=outListCount+1
       endif
    enddo

    ! if all unique then don't compact
    if (inListCount .eq. outListCount) then
       wasCompacted=.false.
       return
    endif


    ! Allocate new lists
    allocate(outFactorList(outListCount))
    allocate(outFactorIndexList(2,outListCount))

    ! Loop counting unique entries
    outListPos=1
    srcInd=inFactorIndexList(1,1)
    dstInd=inFactorIndexList(2,1)
    factorSum=inFactorList(1)
    do i=2,inListCount
       if ((srcInd /= inFactorIndexList(1,i)) .or. &
           (dstInd /= inFactorIndexList(2,i))) then
          ! Save the old entry
          outFactorIndexList(1,outListPos)=srcInd
          outFactorIndexList(2,outListPos)=dstInd
          outFactorList(outListPos)=factorSum

          ! Change to a new entry
          srcInd=inFactorIndexList(1,i)
          dstInd=inFactorIndexList(2,i)
          factorSum=inFactorList(i)

          outListPos=outListPos+1
       else
          factorSum=factorSum+inFactorList(i)
       endif
    enddo

    ! Save the last entry
    outFactorIndexList(1,outListPos)=srcInd
    outFactorIndexList(2,outListPos)=dstInd
    outFactorList(outListPos)=factorSum


    ! Output that the lists were compacted
    wasCompacted=.true.

    ! return success
    rc = ESMF_SUCCESS

end subroutine CompactMatrix