SUBROUTINE RANK(X,N,XR) 
C
C     PURPOSE--THIS SUBROUTINE RANKS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X,
C              AND PUTS THE RESULTING N RANKS INTO THE
C              SINGLE PRECISION VECTOR XR.
C              THIS SUBROUTINE GIVES THE DATA ANALYST
C              THE ABILITY TO (FOR EXAMPLE) RANK THE DATA
C              PRELIMINARY TO CERTAIN DISTRIBUTION-FREE
C              ANALYSES.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE RANKED. 
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C     OUTPUT ARGUMENTS--XR     = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE RANKS
C                                FROM X WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR XR
C             CONTAINING THE RANKS
C             (IN ASCENDING ORDER)
C             OF THE VALUES
C             IN THE SINGLE PRECISION VECTOR X.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--THE RANK OF THE FIRST ELEMENT
C              OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR XR,
C              THE RANK OF THE SECOND ELEMENT
C              OF THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR XR,
C              ETC. 
C     COMMENT--THE SMALLEST ELEMENT IN THE VECTOR X
C              WILL HAVE A RANK OF 1 (UNLESS TIES EXIST).
C              THE LARGEST ELEMENT IN THE VECTOR X
C              WILL HAVE A RANK OF N (UNLESS TIES EXIST).
C     COMMENT--ALTHOUGH RANKS ARE USUALLY (UNLESS TIES EXIST)
C              INTEGRAL VALUES FROM 1 TO N, IT IS TO BE
C              NOTED THAT THEY ARE OUTPUTED AS SINGLE
C              PRECISION INTEGERS IN THE SINGLE PRECISION
C              VECTOR XR.
C              XR IS SINGLE PRECISION SO AS TO BE 
C              CONSISTENT WITH THE FACT THAT ALL
C              VECTOR ARGUMENTS IN ALL OTHER
C              DATAPAC SUBROUTINES ARE SINGLE PRECISION;
C              BUT MORE IMPORTANTLY, BECAUSE TIES FREQUENTLY
C              DO EXIST IN DATA SETS AND SO SOME OF THE
C              RESULTING RANKS WILL BE NON-INTEGRAL
C              AND SO THE OUTPUT VECTOR OF RANKS MUST NECESSARILY
C              BE SINGLE PRECISION AND NOT INTEGER.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--DUE TO CONFLICTING USE OF LABELED
C              COMMON /BLOCK2/ BY THIS RANK
C              SUBROUTINE AND THE SPCORR (SPEARMAN RANK
C              CORRELATION COEFFICIENT) SUBROUTINE,
C              THE VECTOR XS OF THIS RANK
C              SUBROUTINE HAS BEEN PLACED IN
C              LABELED COMMON /BLOCK4/
C     COMMENT--THE FIRST AND THIRD ARGUMENTS IN THE
C              CALLING SEQUENCE MAY
C              BE IDENTICAL; THAT IS, AN 'IN PLACE'
C              RANKING IS PERMITTED.
C              THE CALLING SEQUENCE
C              CALL RANK(X,N,X) IS VALID, IF DESIRED.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE BINARY SORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM        BINARY SORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 (BINARY SORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-2315
C     ORIGINAL VERSION--JUNE      1972. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --JANUARY   1977. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),XR(1)
      COMMON /BLOCK4/ XS(7500)
C
      AN=N
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      AVRANK=(AN+1.0)/2.0
      DO61I=1,N
      XR(I)=AVRANK
   61 CONTINUE
      RETURN
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XR(1)=1.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE RANK   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 RANK   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE RANK   SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
C     FIRST SORT THE DATA FROM THE INPUT VECTOR X 
C     INTO THE INTERMEDIATE STORAGE VECTOR XS.
C
      CALL SORT(X,N,XS)
C
C     NOW DETERMINE THE RANKS.
C     THE BASIC ALGORITHM IS TO TAKE A GIVEN ELEMENT
C     IN THE ORIGINAL INPUT VECTOR X,
C     AND SCAN THE SORTED VALUES IN THE XS VECTOR 
C     UNTIL A MATCH IS FOUND; 
C     WHEN A MATCH IS FOUND, THEN THE RANK FOR THAT
C     VALUE IN THE XS VECTOR IS DETERMINED.
C     THAT RANK IS THEN WRITTEN INTO THAT POSITION
C     IN THE OUTPUT Y VECTOR WHICH CORRESPONDS TO THE POSITION OF THE 
C     GIVEN ELEMENT OF INTEREST IN THE ORIGINAL X VECTOR.
C     THE CODE IS LENGTHENED FROM THIS BASIC ALGORITHM
C     BY A SECTION WHICH CUTS DOWN THE SEARCH IN THE XS VECTOR,
C     AND BY A SECTION WHICH OBVIATES (UNDER CERTAIN CIRCUMSTANCES)
C     THE NEED FOR RECALCULATING THE RANK OF AN ELEMENT IN XS.
C
      NM1=N-1
      XPREV=X(1)
      DO700I=1,N
      JMIN=1
      IF(X(I).GT.XPREV)GOTO770
      IF(I.EQ.1)GOTO790
      IF(X(I).EQ.XPREV)GOTO750
      GOTO790
  750 CONTINUE
      XR(I)=RPREV
      GOTO880
  770 CONTINUE
      JMIN=K
      IF(JMIN.LT.N)GOTO790
      IF(JMIN.EQ.N)GOTO820
      IBRAN=1
      WRITE(IPR,109)IBRAN
      WRITE(IPR,101)JMIN
  109 FORMAT(1H ,40H*****INTERNAL ERROR IN RANK SUBROUTINE--,
     146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8) 
  101 FORMAT(1H ,'JMIN = ',I8)
      STOP
  790 CONTINUE
      DO800J=JMIN,NM1
      IF(X(I).NE.XS(J))GOTO800
      JP1=J+1
      DO900K=JP1,N
      IF(XS(K).NE.XS(J))GOTO950
  900 CONTINUE
      K=N+1
  950 CONTINUE
      AVRANK=J+K-1
      AVRANK=AVRANK/2.0
      XR(I)=AVRANK
      GOTO880
  800 CONTINUE
  820 CONTINUE
      J=N 
      K=N+1
      IF(X(I).EQ.XS(J))GOTO850
      IBRAN=2
      WRITE(IPR,109)IBRAN
      WRITE(IPR,102)X(I),XS(J)
  102 FORMAT(1H ,'X(I) = ',F15.7,'   XS(J) = ',F15.7)
      STOP
  850 CONTINUE
      XR(I)=N
  880 CONTINUE
      XPREV=X(I)
      RPREV=XR(I)
  700 CONTINUE
C
      RETURN
      END