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