corr(3f) - [M_datapac:STATISTICS] compute the sample correlation
coefficient
SUBROUTINE CORR(X,Y,N,Iwrite,C)
CORR(3f) computes the sample correlation coefficient between the 2
sets of data in the input vectors X and Y. The sample correlation
coefficient will be a REAL value between -1.0 and 1.0 (inclusively).
X description of parameter
Y description of parameter
Sample program:
program demo_corr
use M_datapac, only : corr
implicit none
! call corr(x,y)
end program demo_corr
Results:
The original DATAPAC library was written by James Filliben of the
Statistical Engineering Division, National Institute of Standards
and Technology.
John Urban, 2022.05.31
CC0-1.0
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=wp), | dimension(:) | :: | X | |||
real(kind=wp), | dimension(:) | :: | Y | |||
integer | :: | N | ||||
integer | :: | Iwrite | ||||
real(kind=wp) | :: | C |
SUBROUTINE CORR(X,Y,N,Iwrite,C) REAL(kind=wp) :: an , C , hold , sum1 , sum2 , sum3 , X , xbar , Y , ybar INTEGER i , iflag , Iwrite , N ! ! INPUT ARGUMENTS--X = THE VECTOR OF ! (UNSORTED) OBSERVATIONS ! WHICH CONSTITUTE THE FIRST SET ! OF DATA. ! --Y = THE VECTOR OF ! (UNSORTED) OBSERVATIONS ! WHICH CONSTITUTE THE SECOND SET ! OF DATA. ! --N = THE INTEGER NUMBER OF OBSERVATIONS ! IN THE VECTOR X, OR EQUIVALENTLY, ! THE INTEGER NUMBER OF OBSERVATIONS ! IN THE VECTOR Y. ! --IWRITE = AN INTEGER FLAG CODE WHICH ! (IF SET TO 0) WILL SUPPRESS ! THE PRINTING OF THE ! SAMPLE CORRELATION COEFFICIENT ! AS IT IS COMPUTED; ! OR (IF SET TO SOME INTEGER ! VALUE NOT EQUAL TO 0), ! LIKE, SAY, 1) WILL CAUSE ! THE PRINTING OF THE ! SAMPLE CORRELATION COEFFICIENT ! AT THE TIME IT IS COMPUTED. ! OUTPUT ARGUMENTS--C = THE VALUE OF THE ! COMPUTED SAMPLE CORRELATION COEFFICIENT ! BETWEEN THE 2 SETS OF DATA ! IN THE INPUT VECTORS X AND Y. ! THIS VALUE ! WILL BE BETWEEN -1.0 AND 1.0 ! (INCLUSIVELY). ! OUTPUT--THE COMPUTED VALUE OF THE ! SAMPLE CORRELATION COEFFICIENT BETWEEN THE 2 SETS ! OF DATA IN THE INPUT VECTORS X AND Y. ! RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE ! OF N FOR THIS SUBROUTINE. !--------------------------------------------------------------------- DIMENSION X(:) , Y(:) ! ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! an = N C = 0.0_wp iflag = 0 IF ( N<1 ) THEN WRITE (G_IO,99001) 99001 FORMAT (' ***** FATAL ERROR--The third input argument to CORR(3f) is non-positive *****') WRITE (G_IO,99002) N 99002 FORMAT (' ','***** The value of the argument is ',I0,' *****') RETURN ELSEIF ( N==1 ) THEN WRITE (G_IO,99003) 99003 FORMAT (' ***** NON-FATAL DIAGNOSTIC--The third input argument to CORR(3f) has the value 1 *****') RETURN ELSE hold = X(1) DO i = 2 , N IF ( X(i)/=hold ) GOTO 50 ENDDO WRITE (G_IO,99004) hold 99004 FORMAT (' ***** NON-FATAL DIAGNOSTIC--The first input argument (a vector) to CORR(3f) has all elements =',& & E15.8,' *****') iflag = 1 50 hold = Y(1) DO i = 2 , N IF ( Y(i)/=hold ) GOTO 100 ENDDO WRITE (G_IO,99005) hold 99005 FORMAT (' ***** NON-FATAL DIAGNOSTIC--The second input argument (a vector) to CORR(3f) has all elements =', & & E15.8,' *****') iflag = 1 100 IF ( iflag==1 ) RETURN ! !-----START POINT----------------------------------------------------- ! xbar = 0.0_wp ybar = 0.0_wp DO i = 1 , N xbar = xbar + X(i) ybar = ybar + Y(i) ENDDO xbar = xbar/an ybar = ybar/an sum1 = 0.0_wp sum2 = 0.0_wp sum3 = 0.0_wp DO i = 1 , N sum1 = sum1 + (X(i)-xbar)*(Y(i)-ybar) sum2 = sum2 + (X(i)-xbar)**2 sum3 = sum3 + (Y(i)-ybar)**2 ENDDO sum2 = SQRT(sum2) sum3 = SQRT(sum3) C = sum1/(sum2*sum3) IF ( Iwrite/=0 ) WRITE (G_IO,99006) N , C 99006 FORMAT (' The linear correlation coefficient of the 2 sets of ',I0,' observations is ',F14.5) ENDIF END SUBROUTINE CORR