MODULE cc_mod

PRIVATE
PUBLIC cc_type, get_cc, put_cc

TYPE cc_type
  REAL(KIND(1.d0)) :: sx=0,sy=0,sxx=0,syy=0,sxy=0
  INTEGER :: n=0
END TYPE cc_type

INTERFACE put_cc
  MODULE PROCEDURE put_cc44, put_cc48, put_cc84, put_cc88
END INTERFACE put_cc

CONTAINS

ELEMENTAL FUNCTION get_cc(cc_data) RESULT(cc)
! calculation of correlation coeff 
       IMPLICIT NONE
       TYPE(cc_type), INTENT(IN) :: cc_data
       REAL(KIND(1.d0)) :: cc,t1,t2
       
       cc=0
       IF (cc_data%n < 3) RETURN
       
       t1 = cc_data%sxx - cc_data%sx**2 / cc_data%n
       IF (t1 <= 0) RETURN
       
       t2 = cc_data%syy - cc_data%sy**2 / cc_data%n       
       IF (t2 <= 0) RETURN
       
       cc = (cc_data%sxy - cc_data%sx * cc_data%sy / cc_data%n)/sqrt(t1*t2)
END FUNCTION get_cc

SUBROUTINE put_cc44(cc_data,x,y)
       REAL :: x,y
       TYPE(cc_type) :: cc_data
       CALL put_cc88(cc_data,DBLE(x),DBLE(y))
END SUBROUTINE put_cc44
SUBROUTINE put_cc48(cc_data,x,y)
       REAL :: x
       REAL(KIND(1.d0)) :: y
       TYPE(cc_type) :: cc_data
       CALL put_cc88(cc_data,DBLE(x),y)
END SUBROUTINE put_cc48
SUBROUTINE put_cc84(cc_data,x,y)
       REAL(KIND(1.d0)) :: x
       REAL :: y
       TYPE(cc_type) :: cc_data
       CALL put_cc88(cc_data,x,DBLE(y))
END SUBROUTINE put_cc84
SUBROUTINE put_cc88(cc_data,x,y)
       IMPLICIT NONE
       REAL(KIND(1.d0)) :: x,y
       TYPE(cc_type) :: cc_data
       cc_data%n  = cc_data%n + 1
       cc_data%sx = cc_data%sx + x
       cc_data%sy = cc_data%sy + y
       cc_data%sxx = cc_data%sxx + x*x
       cc_data%syy = cc_data%syy + y*y
       cc_data%sxy = cc_data%sxy + x*y
END SUBROUTINE put_cc88

END MODULE cc_mod

