SUBROUTINE REGRESS_ONE(NX,XBAR,YBAR,XCOV,YCOV,XYCOV,NXEIGS,CCOF,CCOF0,RESERR,RESCOV,XVEC)

  USE RAD_BIAS
  IMPLICIT NONE

! ROUTINE          CALCF2  SUBROUTINE  *****  |EYRE.TOVFFG@

! PURPOSE          EIGENVECTOR REGRESSION ROUTINE

! VERSION          3.00,190491,J.R.EYRE

! DESCRIPTION      ROUTINE TO CALCULATE EIGENVECTOR REGRESSION COEFFICIENT
!                  Y AGAINST VECTOR X FROM COVARIANCE MATRICES XYCOV AND
!                  XCOV, WHICH CONTAINS THE COVARIANCE MATRICES OF Y AND X

! ARGUMENTS        XBAR   R*8  MEAN VECTOR OF PREDICTORS, LENGTH NX
!                  YBAR   R*8  MEAN VALUE OF PREDICTANT
!                  XCOV   R*8  COVARIANCE MATRIX (NX*NX) OF PREDICTORS
!                  XYCOV  R*8  CROSS-COVARIANCE MATRIX (NX) OF PREDICTORS/PREDICTANT
!                  NX     I*4  NUMBER OF PREDICTORS
!                  NXEIGS  I*4  NUMBER OF EIGENVECTORS OF PREDICTOR USED IN
!                              THE REGRESSION EQUATION
!                  CCOF   R*8  OUTPUT MATRIX (NX) OF REGRESSION COEFF
!                              SUCH THAT: Y = CCOF0 + CCOF.X
!                  CCOF0  R*8  OFFSET IN ABOVE EQUATION
!                  RESERR R*8  RESIDUAL ERROR IN PREDICANT
!                  RESCOV R*8  RESIDUAL VARIANCE IN PREDICTANT
!                  XVEC   R*8  OUTPUT MATRIX (NX*NX) OF PREDICTOR EIGENVECTORS

! SUBPROGRAMS      F02ABF, F01ABF (nag)

! FILES            UNIT(6)  DIAGNOSTIC OUTPUT

! 14 JAN 88. MADISON VERSION CHANGED BACK FOR HOMER.
! 13 MAY 97. REWRITTEN IN F90 (B.Harris)

  INTEGER, PARAMETER :: JWORK=4900
  INTEGER, PARAMETER :: JMPRED=70
  INTEGER            :: NXEIG  

  INTEGER, INTENT(IN) :: NX, NXEIGS
  INTEGER NXE

  REAL(KIND=LONG),    INTENT(IN) :: XBAR(NX), YBAR, XCOV(NX,NX), XYCOV(NX), YCOV

  REAL(KIND=LONG), INTENT(OUT) :: CCOF(NX), CCOF0
  REAL(KIND=LONG), INTENT(OUT) :: RESERR, RESCOV
  REAL(KIND=LONG), INTENT(OUT) :: XVEC(NX,NX)

  REAL(KIND=LONG) :: XDEV(NX), XXBAR(NX)
  REAL(KIND=LONG) :: YVEC, XVAL(NX), YVAL, DET, D(NX)
  REAL(KIND=LONG) :: XW1(NX,NX), XW2(NX,NX), YW1, XYW1(NX), YXW1(NX), XINV(NX,NX), XYW2(NX)
  REAL(KIND=LONG) :: W1(JWORK)

  INTEGER :: IFAIL = 0
  INTEGER :: IPIV(JMPRED)
  INTEGER :: NWORK = JWORK

  INTEGER :: J, JJ, I, II
  REAL    :: RR
!  REAL    :: offdiag
  REAL(KIND=LONG)  :: offdiag(NX)
  NXE=1
  NXEIG=NX

  CCOF=0.
  XVEC=0.
     D=0.

! CHECK INPUT PARAMETERS
  IF ((NX < 1) .OR. (NX > JMPRED)) STOP 701
  IF ((NXEIG < 1) .OR. (NXEIG > NX)) STOP 702


! PREDICTOR = XCOV, SIZE = NX*NX
! PREDICTANT = YCOV
! CROSS-COVARIANCE = XYCOV, SIZE = NX

  DO I=1, NX
    XDEV(I) = SQRT(XCOV(I,I))
  ENDDO

  PRINT *, 'PREDICTOR STD DEV AND MEAN NEW  F02FAF'
  PRINT 99, XDEV(1:NX)
  PRINT 99, XBAR(1:NX)

! *** CALCULATE EIGENVECTOR REGRESSION COEFFICIENTS

!     CALCULATE EIGENVECTORS AND EIGENVALUES OF XCOV:
!     XVEC AND XVAL.

! PRINT *, 'PREDICTOR COVARIANCE MATRIX XCOV'
! DO J=1, NX
!   PRINT 99, XCOV(1:NX,J)
! ENDDO
! DO J=1, NX
!   DO I=1, NX
!     XW1(I,J) = XCOV(I,J)/SQRT(XCOV(I,I)*XCOV(J,J))
!   ENDDO
! ENDDO
! PRINT *, 'PREDICTOR CORRELATION MATRIX'
! DO J=1, NX
!   PRINT 99, XW1(1:NX,J)
! ENDDO

! CALL F02ABF(XCOV,NX,NX,XVAL,XVEC,NX,W1,IFAIL)
  XVEC=XCOV
!  CALL F02FAF('V','L',NX,XVEC,NX,XVAL,W1,JWORK,IFAIL)
! tranform matrix to tridiagonal form
  call tred2(XVEC,NX,NX,XVAL,offdiag)
! QL decomposition
  call tqli(XVAL,offdiag,NX,NX,XVEC)

  IF (IFAIL /= 0) THEN 
    PRINT *, 'PROBLEM WITH PREDICTOR EIGENVALUE CALCULATION'
    STOP
  ENDIF

  PRINT 89
  89 FORMAT (/1X,'XVAL = EIGENVALUES OF PREDICTOR in one and two zero')
  PRINT 99, XVAL(1:NX)
  99 FORMAT (1X,10F12.4)

  PRINT *, 'EIGENVECTORS OF PREDICTOR BY COLUMN'
   XVEC(1:NX,1:(NXEIG-NXEIGS))=0
  DO I=1, NX
    PRINT 99, XVEC(I,1:NX)
    
  ENDDO

  XXBAR = MATMUL(XBAR,XVEC)
  PRINT *, 'MEAN VALUE OF PREDICTORS IN XVEC SPACE'
  PRINT 99, XXBAR(1:NX)

  XYW1 = MATMUL(XYCOV,XVEC)

! CALCULATE REGRESSION MATRIX OF EIGENVECTOR COEFFICIENTS:

  D(NXE:NXEIG) = XYW1(NXE:NXEIG)/XVAL(NXE:NXEIG)

! CALCULATE REGRESSION MATRIX OF Y AGAINST X :  CCOF :
! CCOF = XVEC * D

  CCOF = MATMUL(XVEC(:,NXE:NXEIG),D(NXE:NXEIG))

! ***     CALCULATE OFFSET VECTOR, CCOF0 :
!         Y - YBAR  =  CCOF . (X-XBAR)
!         THERFORE  Y = CCOF.X + CCOF0, WHERE CCOF0 = YBAR -CCOF.XBAR

  CCOF0 = YBAR - SUM(CCOF(NXE:NX)*XBAR(NXE:NX))

! PRINT 86
! 86 FORMAT (/1X,'PREDICTIVE MATRIX, CCOF')
! DO I=1, NX
!   PRINT 99, CCOF(I)
! ENDDO

! PRINT *, 'CCOF IN XVEC SPACE'
! DO I=1, NX
!   PRINT 99, D(I)
! ENDDO
  XYW1=0
  XYW1(NXE:NXEIG) = MATMUL(XYCOV,XVEC(:,NXE:NXEIG))
  XYW1(NXE:NXEIG) = XYW1(1:NXEIG) * XYW1(NXE:NXEIG)
  XYW1(NXE:NXEIG) = XYW1(1:NXEIG)/XVAL(NXE:NXEIG)

  PRINT *, 'EXPLANATION OF VARIANCE'
  PRINT 99, YCOV
  PRINT *, ' '
  PRINT 99, 1.0
  DO I=1, NXEIG
    PRINT 99, XYW1(I)/YCOV
  ENDDO
  PRINT 99, (YCOV - SUM(XYW1(1:NXEIG)))/YCOV
  PRINT *, ' '
  PRINT 99, YCOV - SUM(XYW1(1:NXEIG))

! PRINT 85
! 85 FORMAT (/1X,'OFFSET VECTOR, CCOF0')
! PRINT 99, CCOF0

! *** CALCULATE RESIDUAL COVARIANCE MATRIX
!     = YCOV + CCOF.XCOV.CCOF(TR) - 2.XYCOF.CCOF(TR)

  YXW1 = CCOF
  XYW1 = MATMUL(CCOF,XCOV)
  XYW1 = XYW1 - 2*XYCOV
  RESCOV = YCOV + DOT_PRODUCT(XYW1,YXW1)

! RESCOV NOW CONTAINS RESIDUAL COVARIANCE(CORRELATION) MATRIX
  RR = RESCOV
  IF (RR < 0.0) THEN
    PRINT 51, I, RR
    51 FORMAT (/1X,'RES ERR COV FOR ELEMENT',I5,' = ',E12.4/1X,'SET TO ZERO')
    RR=0.0
  ENDIF
  RESERR = SQRT(RR)

! PRINT 84
! 84 FORMAT (/1X,'RESIDUAL ERROR VECTOR, RESERR')
! PRINT 99, RESERR


  RETURN
  END SUBROUTINE REGRESS_ONE