!*************************************************************
! rank numerical priorities
! CREATED: June/July 2005, Julia Lee-TAYLOR, NCAR            !
!*************************************************************

      SUBROUTINE sortrank(nca,prank,rank)
      IMPLICIT NONE
      INCLUDE 'general.h'

! input/output      
      INTEGER nca, prank(mca,3),rank(mca)
! internal
      INTEGER pr(nca,3)
      INTEGER store(3)
      INTEGER i,ii,j,ctr

      !print*,'*sortrank*'

! truncate input rank array 
      DO i=1,nca
        DO j=1,3
          pr(i,j) = prank(i,j)
        ENDDO
      ENDDO

! first pass
20    i=1
30    ii=i+1
      IF (pr(i,2).LE.pr(ii,2)) GO TO 10
      DO j=1,3
        store(j) = pr(ii,j)  
        pr(ii,j)  = pr(i,j)
        pr(i,j)  = store(j)
      ENDDO
      i     = i-1
      IF (i.EQ.0) GO TO 20
      GO TO 30
10    IF (ii.EQ.nca) GO TO 40
      i = i + 1
      GO TO 30
40    CONTINUE

! second pass
120   i=1
130   ii=i+1
      IF (pr(i,2).EQ.pr(ii,2))THEN
        IF(pr(i,3).LE.pr(ii,3)) GO TO 110
        DO j=1,3
          store(j) = pr(ii,j)  
          pr(ii,j)  = pr(i,j)
          pr(i,j)  = store(j)
        ENDDO
        i     = i-1
      ELSE
        GO TO 110
      ENDIF
      IF (i.EQ.0) GO TO 120
      GO TO 130
110   IF (ii.EQ.nca) GO TO 140
      i = i + 1
      GO TO 130
140   CONTINUE

! find new ranks
      ctr=1
      rank(pr(1,1))=ctr
      DO ii=2,nca
        i=ii-1
        IF(pr(ii,2).EQ.pr(i,2).AND.pr(ii,3).EQ.pr(i,3)) THEN
          ctr=ctr
        ELSE
          ctr=ctr+1
        ENDIF  
        rank(pr(ii,1))=ctr
      ENDDO

      END
