Fortran 90 SUBROUTINE UNBIASED_CORRELATION
SUBROUTINE UNBIASED_CORRELATION( N, A, B, msg, lag, r, t, m)
! Computes the correlation of two series A and B of length
! N as a function of lag. The correlation is unbiased
! because the sums in the covariance and standard devia-
! tions are divided by m, not m-1, where m is the number
! of overlapping grid points.
! The correlation r is defined as
!
! cov(A,B)
! r = -------------
! s(A) * s(B)
!
! where cov() is covariance and s() is standard deviation.
! The series A and B must be prepared such that they
! are sent to this routine with zero lag. If necessary, this
! is accomplished by padding the beginning or ends (or both)
! of each time series with missing values (msg) so that their
! elements correspond one to one. The resultant time series
! will be of equal length N. Also, missing values (msg)
! distributed thoughout each time series is perfectly
! acceptable. Time series B will be shifted by the amount
! lag relative to time series A:
! RETURNS: r, the unbiased correlation, t, the significance
! of the unbiased correlation ( t is set to msg if B = A
! at lag 0, i.e. an autocorrelation at lag 0, or if the
! correlation is 1.0 in general), and m, the number of
! overlapping grid points.
! A: t1 t2 t3 t4 ... tN
! B: t1 t2 t3 t4 ... tN
! \_ _/
! V
! lag = 2 (Defined to be > 0.)
IMPLICIT NONE
INTEGER, INTENT(IN) :: N
REAL, DIMENSION(N), INTENT(IN) :: A
REAL, DIMENSION(N), INTENT(IN) :: B
REAL, INTENT(IN) :: msg
INTEGER, INTENT(IN) :: lag
REAL, INTENT(OUT) :: r
REAL, INTENT(OUT) :: t
INTEGER, INTENT(OUT) :: m
REAL, DIMENSION(:), ALLOCATABLE :: x
REAL, DIMENSION(:), ALLOCATABLE :: y
REAL, DIMENSION(:), ALLOCATABLE :: xdev
REAL, DIMENSION(:), ALLOCATABLE :: ydev
REAL, DIMENSION(:), ALLOCATABLE :: xdevydev
REAL, DIMENSION(:), ALLOCATABLE :: xdevxdev
REAL, DIMENSION(:), ALLOCATABLE :: ydevydev
REAL :: xmn
REAL :: ymn
REAL :: COVxy
REAL :: Sx
REAL :: Sy
ALLOCATE( x(1:3*N) )
ALLOCATE( y(1:3*N) )
x(:) = msg
y(:) = msg
x(N+1:2*N) = A(:)
y(N+1:2*N) = B(:)
y = EOSHIFT( y, SHIFT = -lag, BOUNDARY = msg )
WHERE ( x == msg ) y = msg
WHERE ( y == msg ) x = msg
m = COUNT( x /= msg )
IF ( m < 3 ) THEN
WRITE (*,'(A40, I1)') "The number of overlapping points is m = ", m
WRITE (*,'(A35)') "The value of m should be 3 or more."
WRITE (*,'(A17)') "Decrease the lag."
WRITE (*,'(A52)') "Execution halted in SUBROUTINE UNBIASED_CORRELATION."
STOP
END IF
xmn = SUM( x, DIM = 1, MASK = x /= msg ) / REAL(m)
ymn = SUM( y, DIM = 1, MASK = y /= msg ) / REAL(m)
ALLOCATE( xdev(1:3*N) )
ALLOCATE( ydev(1:3*N) )
xdev(:) = x(:) - xmn
WHERE ( x == msg ) xdev(:) = msg
ydev(:) = y(:) - ymn
WHERE ( y == msg ) ydev(:) = msg
ALLOCATE( xdevydev(1:3*N) )
xdevydev(:) = xdev(:) * ydev(:)
WHERE ( x == msg ) xdevydev(:) = msg
COVxy = SUM( xdevydev, DIM = 1, MASK = xdevydev /= msg ) / REAL(m)
ALLOCATE( xdevxdev(1:3*N) )
xdevxdev(:) = xdev(:) * xdev(:)
WHERE ( x == msg ) xdevxdev(:) = msg
Sx = SQRT( SUM( xdevxdev, DIM = 1, MASK = xdevxdev /= msg ) / REAL(m) )
ALLOCATE( ydevydev(1:3*N) )
ydevydev(:) = ydev(:) * ydev(:)
WHERE ( y == msg ) ydevydev(:) = msg
Sy = SQRT( SUM( ydevydev, DIM = 1, MASK = ydevydev /= msg ) / REAL(m) )
r = COVxy / ( Sx * Sy )
IF ( r /= 1.0 ) THEN
t = r * SQRT( (m - 2) / ( 1 - r*r ) )
ELSE
t = msg
END IF
DEALLOCATE( x, y, xdev, ydev, xdevydev, xdevxdev, ydevydev )
END SUBROUTINE UNBIASED_CORRELATION
Back to David Stepaniak's Home Page