sort_int Subroutine

 subroutine sort_int(origlist, newind, unique)
!
! !ARGUMENTS:
 integer(ESMF_KIND_I4), intent(in) :: origlist(:)
 integer(ESMF_KIND_I4), intent(inout) :: newind(:)
 integer(ESMF_KIND_I4), intent(out) :: unique

 INTEGER, PARAMETER :: SELECT = 20
! ..
! .. Local Scalars ..
 INTEGER :: ENDD, I, J, START, STKPNT
 integer :: n , first, k
 integer(ESMF_KIND_I4) :: arrayel1, arrayel2, arrayel3, arrayel_minmax, arrayel_temp
 integer(ESMF_KIND_I4) :: indtemp, minind
 integer(ESMF_KIND_I4), allocatable :: list(:), origind(:), offset(:)

! ..
! .. Local Arrays ..
 INTEGER :: STACK( 2, 32 )
! ..
! .. Executable Statements ..

!
! Test the input paramters.

 n = size (origlist)
 allocate(list(n), origind(n), offset(n))
 list = origlist
 do i=1,n
  origind(i)=i
  newind(i)=i
 enddo
 STKPNT = 1
 STACK( 1, 1 ) = 1
 STACK( 2, 1 ) = N

 10 CONTINUE
 START = STACK( 1, STKPNT )
 ENDD = STACK( 2, STKPNT )
 STKPNT = STKPNT - 1
 IF( ENDD-START.LE.SELECT .AND. ENDD-START > 0 ) THEN
!
! Do Insertion sort on D( START:ENDD )
!
! Sort into increasing order
!
 DO 50 I = START + 1, ENDD
 DO, J = I, START + 1, -1
 IF( list( J ) < list( J-1 ) ) THEN
 arrayel_minmax = list( J )
 list( J ) = list( J-1 )
 list( J-1 ) = arrayel_minmax
 indtemp = origind(j)
 origind(j)=origind(j-1)
 origind(j-1)=indtemp
 ELSE
 GO TO 50
 END IF
 end do
 50 end do
!
 ELSE IF( ENDD-START > SELECT ) THEN
!
! Partition list( START:ENDD ) and stack parts, largest one first
!
! Choose partition entry as median of 3
!
 arrayel1 = list( START )
 arrayel2 = list( ENDD )
 I = ( START+ENDD ) / 2
 arrayel3 = list( I )
 IF( arrayel1 < arrayel2 ) THEN
 IF( arrayel3 < arrayel1 ) THEN
 arrayel_minmax = arrayel1
 ELSE IF( arrayel3 < arrayel2 ) THEN
 arrayel_minmax = arrayel3
 ELSE
 arrayel_minmax = arrayel2
 END IF
 ELSE
 IF( arrayel3 < arrayel2 ) THEN
 arrayel_minmax = arrayel2
 ELSE IF( arrayel3 < arrayel1 ) THEN
 arrayel_minmax = arrayel3
 ELSE
 arrayel_minmax = arrayel1
 END IF
 END IF
!
 I = START - 1
 J = ENDD + 1

 90 CONTINUE
 do
 J = J - 1
 IF( list( J ) <= arrayel_minmax )&
 & exit
 end do

 do
 I = I + 1
 IF( list( I ) >= arrayel_minmax )&
 & exit
 end do

 IF( I < J ) THEN
 arrayel_temp = list( I )
 list( I ) = list( J )
 list( J ) = arrayel_temp
 indtemp = origind(i)
 origind(i)=origind(j)
 origind(j)=indtemp
 GO TO 90
 END IF
 IF( J-START > ENDD-J-1 ) THEN
 STKPNT = STKPNT + 1
 STACK( 1, STKPNT ) = START
 STACK( 2, STKPNT ) = J
 STKPNT = STKPNT + 1
 STACK( 1, STKPNT ) = J + 1
 STACK( 2, STKPNT ) = ENDD
 ELSE
 STKPNT = STKPNT + 1
 STACK( 1, STKPNT ) = J + 1
 STACK( 2, STKPNT ) = ENDD
 STKPNT = STKPNT + 1
 STACK( 1, STKPNT ) = START
 STACK( 2, STKPNT ) = J
 END IF
 END IF
 IF( STKPNT > 0 ) &
 & GO TO 10

 ! find unique elements in list
offset = 0
 unique=1
 first=-1
 do i=2,n
  if (list(i) > list(i-1)) then
    unique=unique+1
    if (first>0) then
      !found duplicate, set the newIds to the smallest of the list
      minind = origind(first)
      do j=first+1,i-1
        if (origind(j)<minind) minind=origind(j)
      enddo
      do j=first,i-1
        if (origind(j) > minind) then
           do k=origind(j)+1,n
              offset(k)=offset(k)+1
           enddo
        endif
        newind(origind(j))=minind
      enddo
      first=-1
    endif
  else
    if (first<0) first=i-1
  endif
 enddo

 do i=1,n
   newind(i)=newind(i)-offset(newind(i))
 enddo

 RETURN

 end subroutine sort_int