      SUBROUTINE TRED2 (NM, N, A, D, E, Z)
C-----------------------------------------------------------------------
C! Reduces a real, symm. matrix to a symm. tridiagonal matrix.
C# Math
C-----------------------------------------------------------------------
C;  Copyright (C) 1995, 2022
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED2,
C     NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON.
C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
C
C     THIS SUBROUTINE REDUCES A REAL SYMMETRIC MATRIX TO A
C     SYMMETRIC TRIDIAGONAL MATRIX USING AND ACCUMULATING
C     ORTHOGONAL SIMILARITY TRANSFORMATIONS.
C
C     ON INPUT:
C
C        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
C          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM
C          DIMENSION STATEMENT;
C
C        N IS THE ORDER OF THE MATRIX;
C
C        A CONTAINS THE REAL SYMMETRIC INPUT MATRIX.  ONLY THE
C          LOWER TRIANGLE OF THE MATRIX NEED BE SUPPLIED.
C
C     ON OUTPUT:
C
C        D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX;
C
C        E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL
C          MATRIX IN ITS LAST N-1 POSITIONS.  E(1) IS SET TO ZERO;
C
C        Z CONTAINS THE ORTHOGONAL TRANSFORMATION MATRIX
C          PRODUCED IN THE REDUCTION;
C
C        A AND Z MAY COINCIDE.  IF DISTINCT, A IS UNALTERED.
C
C     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
C
C-----------------------------------------------------------------------
      INTEGER N, NM
      INTEGER   I, J, K, L, II, JP1
      DOUBLE PRECISION A(NM,N), D(N), E(N), Z(NM,N)
      DOUBLE PRECISION F, G, H, HH, SCALE
C-----------------------------------------------------------------------
C
      DO 100 I = 1, N
         DO 99 J = 1, I
            Z(I,J) = A(I,J)
 99         CONTINUE
 100     CONTINUE
C
      IF (N.EQ.1) GO TO 320
C     :::::::::: FOR I=N STEP -1 UNTIL 2 DO -- ::::::::::
      INCLUDE 'INCS:ZVD.INC'
      DO 300 II = 2, N
         I = N + 2 - II
         L = I - 1
         H = 0.0D0
         SCALE = 0.0D0
         IF (L.LT.2) GO TO 130
C     :::::::::: SCALE ROW (ALGOL TOL THEN NOT NEEDED) ::::::::::
      INCLUDE 'INCS:ZVD.INC'
         DO 120 K = 1, L
            SCALE = SCALE + ABS(Z(I,K))
 120        CONTINUE
C
         IF (SCALE .NE. 0.0D0) GO TO 140
  130    E(I) = Z(I,L)
         GO TO 290
C
      INCLUDE 'INCS:ZVD.INC'
  140    DO 150 K = 1, L
            Z(I,K) = Z(I,K) / SCALE
            H = H + Z(I,K) * Z(I,K)
  150       CONTINUE
C
         F = Z(I,L)
         G = -SIGN (SQRT (H), F)
         E(I) = SCALE * G
         H = H - F * G
         Z(I,L) = F - G
         F = 0.0D0
C
      INCLUDE 'INCS:ZVD.INC'
         DO 240 J = 1, L
            Z(J,I) = Z(I,J) / H
            G = 0.0D0
C     :::::::::: FORM ELEMENT OF A*U ::::::::::
      INCLUDE 'INCS:ZVD.INC'
            DO 180 K = 1, J
               G = G + Z(J,K) * Z(I,K)
 180           CONTINUE
C
            JP1 = J + 1
            IF (L.LT.JP1) GO TO 220
C
      INCLUDE 'INCS:ZVD.INC'
            DO 200 K = JP1, L
               G = G + Z(K,J) * Z(I,K)
 200           CONTINUE
C     :::::::::: FORM ELEMENT OF P ::::::::::
  220       E(J) = G / H
            F = F + E(J) * Z(I,J)
  240       CONTINUE
C
         HH = F / (H + H)
C     :::::::::: FORM REDUCED A ::::::::::
      INCLUDE 'INCS:ZVD.INC'
         DO 260 J = 1, L
            F = Z(I,J)
            G = E(J) - HH * F
            E(J) = G
C
      INCLUDE 'INCS:ZVD.INC'
            DO 259 K = 1, J
               Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K)
 259           CONTINUE
 260        CONTINUE
C
 290     D(I) = H
 300    CONTINUE
C
 320  D(1) = 0.0D0
      E(1) = 0.0D0
C     :::::::::: ACCUMULATION OF TRANSFORMATION MATRICES ::::::::::
      INCLUDE 'INCS:ZVD.INC'
      DO 500 I = 1, N
         L = I - 1
         IF (D(I).EQ.0.0D0) GO TO 380
C
      INCLUDE 'INCS:ZVD.INC'
         DO 360 J = 1, L
            G = 0.0D0
C
      INCLUDE 'INCS:ZVD.INC'
            DO 340 K = 1, L
               G = G + Z(I,K) * Z(K,J)
 340           CONTINUE
C
      INCLUDE 'INCS:ZVD.INC'
            DO 359 K = 1, L
               Z(K,J) = Z(K,J) - G * Z(K,I)
 359           CONTINUE
 360        CONTINUE
C
 380     D(I) = Z(I,I)
         Z(I,I) = 1.0D0
         IF (L.LT.1) GO TO 500
C
         DO 400 J = 1, L
            Z(I,J) = 0.0D0
            Z(J,I) = 0.0D0
  400       CONTINUE
C
  500 CONTINUE
C
      RETURN
      END
