SUBROUTINE TRED3(N,NV,A,D,E,E2)
USE Numeric_Kinds_Module
!   BEGIN PROLOGUE  TRED3
!   DATE WRITTEN   760101   (YYMMDD)
!   REVISION DATE  861211   (YYMMDD)
!   CATEGORY NO.  D4C1B1
!   KEYWORDS  LIBRARY=SLATEC(EISPACK),TYPE=SINGLE PRECISION(TRED3-S),
!             EIGENVALUES,EIGENVECTORS
!   AUTHOR  SMITH, B. T., ET AL.
!   PURPOSE  Reduce REAL symmetric matrix stored in packed form to
!            symmetric tridiagonal matrix using orthogonal
!            transformations.
!   DESCRIPTION
!
!     This SUBROUTINE is a translation of the ALGOL procedure TRED3,
!     NUM. MATH. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
!     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
!
!     This SUBROUTINE reduces a REAL SYMMETRIC matrix, stored as
!     a one-dimensional array, to a symmetric tridiagonal matrix
!     using orthogonal similarity transformations.
!
!     On Input
!
!        n is the order of the matrix.
!
!        NV must be set to the dimension of the array parameter A
!          as declared in the calling program dimension statement.
!
!        A contains the lower triangle of the REAL symmetric
!          input matrix, stored row-wise as a one-dimensional
!          array, in its first N*(N+1)/2 positions.
!
!     On Output
!
!        A contains information about the orthogonal
!          transformations used in the reduction.
!
!        D contains the diagonal elements of the tridiagonal matrix.
!
!        E contains the subdiagonal elements of the tridiagonal
!          matrix in its last N-1 positions.  E(1) is set to zero.
!
!        E2 contains the squares of the corresponding elements of E.
!          E2 may coincide with E IF the squares are not needed.
!
!     Questions and comments should be directed to B. S. Garbow,
!     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
!     ------------------------------------------------------------------
!   REFERENCES  B. T. SMITH, J. M. BOYLE, J. J. DONGARRA, B. S. GARBOW,
!                 Y. IKEBE, V. C. KLEMA, C. B. MOLER, *MATRIX EIGEN-
!                 SYSTEM ROUTINES - EISPACK GUIDE*, SPRINGER-VERLAG,
!                 1976.
!   ROUTINES CALLED  (NONE)
!   END PROLOGUE  TRED3
!
INTEGER I,J,K,L,N,II,IZ,JK,NV
REAL(Kind=WP_Kind) A(NV),D(N),E(N),E2(N)
REAL(Kind=WP_Kind) F,G,H,HH,SCALE
!
!     .......... FOR I=N STEP -1 UNTIL 1 DO -- ..........
!   FIRST EXECUTABLE STATEMENT  TRED3
DO  300 II = 1, N
   I = N + 1 - II
   L = I - 1
   IZ = (I * L) / 2
   H = 0.0D0
   SCALE = 0.0D0
   IF(L < 1) GO TO 130
!     .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) ..........
!$DOIT ASIS
   DO 120 K = 1, L
      IZ = IZ + 1
      D(K) = A(IZ)
      SCALE = SCALE + ABS(D(K))
  120    CONTINUE
!
   IF(SCALE /= 0.0D0) GO TO 140
  130    E(I) = 0.0D0
   E2(I) = 0.0D0
   GO TO 290
!
  140    DO 150 K = 1, L
      D(K) = D(K) / SCALE
      H = H + D(K) * D(K)
  150    CONTINUE
!
   E2(I) = SCALE * SCALE * H
   F = D(L)
   G = -SIGN(SQRT(H),F)
   E(I) = SCALE * G
   H = H - F * G
   D(L) = F - G
   A(IZ) = SCALE * D(L)
   IF(L == 1) GO TO 290
   F = 0.0D0
!
   DO 240 J = 1, L
      G = 0.0D0
      JK = (J * (J-1)) / 2
!     .......... FORM ELEMENT OF A*U
      DO 180 K = 1, L
         JK = JK + 1
         IF(K > J) JK = JK + K - 2
         G = G + A(JK) * D(K)
  180       CONTINUE
!     .......... FORM ELEMENT OF P
      E(J) = G / H
      F = F + E(J) * D(J)
  240    CONTINUE
!
   HH = F / (H + H)
   JK = 0
!     .......... FORM REDUCED A
   DO J = 1, L
      F = D(J)
      G = E(J) - HH * F
      E(J) = G
!
      DO K = 1, J
         JK = JK + 1
         A(JK) = A(JK) - F * E(K) - G * D(K)
      ENDDO
   ENDDO
!
  290    D(I) = A(IZ+1)
   A(IZ+1) = SCALE * SQRT(H)
  300 CONTINUE
!
RETURN
END