SUBROUTINE SPCORR(X,Y,N,IWRITE,SPC)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SPEARMAN RANK CORRELATION COEFFICIENT
C              BETWEEN THE 2 SETS OF DATA IN THE INPUT VECTORS X AND Y.
C              THE SPEARMAN RANK CORRELATION COEFFICIENT WILL BE A
C              SINGLE PRECISION VALUE BETWEEN -1.0 AND 1.0
C              (INCLUSIVELY). 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE FIRST SET
C                                OF DATA.
C                     --Y      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS
C                                WHICH CONSTITUTE THE SECOND SET
C                                OF DATA.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X, OR EQUIVALENTLY,
C                                THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR Y. 
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SPEARMAN RANK CORRELATION COEFFICIENT
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SPEARMAN CORRELATION COEFFICIENT
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--SPC    = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SPEARMAN RANK CORRELATION
C                                COEFFICIENT BETWEEN THE 2 SETS OF DATA
C                                IN THE INPUT VECTORS X AND Y.
C                                THIS SINGLE PRECISION VALUE
C                                WILL BE BETWEEN -1.0 AND 1.0
C                                (INCLUSIVELY).
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SPEARMAN RANK CORRELATION COEFFICIENT BETWEEN THE 2 SETS
C             OF DATA IN THE INPUT VECTORS X AND Y.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 7500.
C     OTHER DATAPAC   SUBROUTINES NEEDED--RANK AND SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--KENDALL AND STUART, THE ADVANCED THEORY OF
C                 STATISTICS, VOLUME 2, EDITION 1, 1961, PAGES 476-477.
C               --SNEDECOR AND COCHRAN, STATISTICAL METHODS,
C                 EDITION 6, 1967, PAGES 193-195. 
C               --DIXON AND MASSEY, INTRODUCTION TO STATISTICAL
C                 ANALYSIS, EDITION 2, 1957, PAGES 294-295. 
C               --MOOD AND GRABLE, 'INTRODUCTION TO THE THEORY
C                 OF STATISTICS, EDITION 2, 1963, PAGE 424. 
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         --OCTOBER   1974. 
C     UPDATED         --JANUARY   1975. 
C     UPDATED         --SEPTEMBER 1975. 
C     UPDATED         --NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION XR(7500),YR(7500)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (XR(1),WS(1)),(YR(1),WS(7501))
C
      IPR=6
      IUPPER=7500
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      SPC=0.0
      IFLAG=0
      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)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      IFLAG=1
   65 HOLD=Y(1)
      DO70I=2,N
      IF(Y(I).NE.HOLD)GOTO80
   70 CONTINUE
      WRITE(IPR,19)HOLD
      IFLAG=1
   80 IF(IFLAG.EQ.1)RETURN
      GOTO90
   50 WRITE(IPR,27)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,28) 
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   19 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT (A VECTOR) TO THE SPCORR SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   27 FORMAT(' ***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE SP',
     1'CORR SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *',
     1'****')
   28 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUME
     1NT TO THE SPCORR SUBROUTINE HAS THE VALUE 1 *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL RANK(X,N,XR)
      CALL RANK(Y,N,YR)
      SUM=0.0
      DO100I=1,N
      SUM=SUM+(XR(I)-YR(I))**2
  100 CONTINUE
      SPC   =1.0-(6.0*SUM/((AN-1.0)*AN*(AN+1.0))) 
C
      IF(IWRITE.NE.0)WRITE(IPR,105)N,SPC
  105 FORMAT(1H ,59HTHE SPEARMAN RANK CORRELATION COEFFICIENT OF THE 2 S
     1ETS OF ,I6,17H OBSERVATIONS IS ,F14.5)
      RETURN
      END