d7/d49/ssytrd_8f_source.html

 *> \brief \b SSYTRD
 *
 *  =========== DOCUMENTATION ===========
 *
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
 *> Download SSYTRD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrd.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrd.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrd.f">
 *> [TXT]</a>
 *> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       INTEGER            INFO, LDA, LWORK, N
 *       ..
 *       .. Array Arguments ..
 *       REAL               A( LDA, * ), D( * ), E( * ), TAU( * ),
 *      $                   WORK( * )
 *       ..
 *
 *
 *> \par Purpose:
 *  =============
 *>
 *> \verbatim
 *>
 *> SSYTRD reduces a real symmetric matrix A to real symmetric
 *> tridiagonal form T by an orthogonal similarity transformation:
 *> Q**T * A * Q = T.
 *> \endverbatim
 *
 *  Arguments:
 *  ==========
 *
 *> \param[in] UPLO
 *> \verbatim
 *>          UPLO is CHARACTER*1
 *>          = 'U':  Upper triangle of A is stored;
 *>          = 'L':  Lower triangle of A is stored.
 *> \endverbatim
 *>
 *> \param[in] N
 *> \verbatim
 *>          N is INTEGER
 *>          The order of the matrix A.  N >= 0.
 *> \endverbatim
 *>
 *> \param[in,out] A
 *> \verbatim
 *>          A is REAL array, dimension (LDA,N)
 *>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
 *>          N-by-N upper triangular part of A contains the upper
 *>          triangular part of the matrix A, and the strictly lower
 *>          triangular part of A is not referenced.  If UPLO = 'L', the
 *>          leading N-by-N lower triangular part of A contains the lower
 *>          triangular part of the matrix A, and the strictly upper
 *>          triangular part of A is not referenced.
 *>          On exit, if UPLO = 'U', the diagonal and first superdiagonal
 *>          of A are overwritten by the corresponding elements of the
 *>          tridiagonal matrix T, and the elements above the first
 *>          superdiagonal, with the array TAU, represent the orthogonal
 *>          matrix Q as a product of elementary reflectors; if UPLO
 *>          = 'L', the diagonal and first subdiagonal of A are over-
 *>          written by the corresponding elements of the tridiagonal
 *>          matrix T, and the elements below the first subdiagonal, with
 *>          the array TAU, represent the orthogonal matrix Q as a product
 *>          of elementary reflectors. See Further Details.
 *> \endverbatim
 *>
 *> \param[in] LDA
 *> \verbatim
 *>          LDA is INTEGER
 *>          The leading dimension of the array A.  LDA >= max(1,N).
 *> \endverbatim
 *>
 *> \param[out] D
 *> \verbatim
 *>          D is REAL array, dimension (N)
 *>          The diagonal elements of the tridiagonal matrix T:
 *>          D(i) = A(i,i).
 *> \endverbatim
 *>
 *> \param[out] E
 *> \verbatim
 *>          E is REAL array, dimension (N-1)
 *>          The off-diagonal elements of the tridiagonal matrix T:
 *>          E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
 *> \endverbatim
 *>
 *> \param[out] TAU
 *> \verbatim
 *>          TAU is REAL array, dimension (N-1)
 *>          The scalar factors of the elementary reflectors (see Further
 *>          Details).
 *> \endverbatim
 *>
 *> \param[out] WORK
 *> \verbatim
 *>          WORK is REAL array, dimension (MAX(1,LWORK))
 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *> \endverbatim
 *>
 *> \param[in] LWORK
 *> \verbatim
 *>          LWORK is INTEGER
 *>          The dimension of the array WORK.  LWORK >= 1.
 *>          For optimum performance LWORK >= N*NB, where NB is the
 *>          optimal blocksize.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
 *>          only calculates the optimal size of the WORK array, returns
 *>          this value as the first entry of the WORK array, and no error
 *>          message related to LWORK is issued by XERBLA.
 *> \endverbatim
 *>
 *> \param[out] INFO
 *> \verbatim
 *>          INFO is INTEGER
 *>          = 0:  successful exit
 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 *> \endverbatim
 *
 *  Authors:
 *  ========
 *
 *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
 *> \date December 2016
 *
 *> \ingroup realSYcomputational
 *
 *> \par Further Details:
 *  =====================
 *>
 *> \verbatim
 *>
 *>  If UPLO = 'U', the matrix Q is represented as a product of elementary
 *>  reflectors
 *>
 *>     Q = H(n-1) . . . H(2) H(1).
 *>
 *>  Each H(i) has the form
 *>
 *>     H(i) = I - tau * v * v**T
 *>
 *>  where tau is a real scalar, and v is a real vector with
 *>  v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
 *>  A(1:i-1,i+1), and tau in TAU(i).
 *>
 *>  If UPLO = 'L', the matrix Q is represented as a product of elementary
 *>  reflectors
 *>
 *>     Q = H(1) H(2) . . . H(n-1).
 *>
 *>  Each H(i) has the form
 *>
 *>     H(i) = I - tau * v * v**T
 *>
 *>  where tau is a real scalar, and v is a real vector with
 *>  v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
 *>  and tau in TAU(i).
 *>
 *>  The contents of A on exit are illustrated by the following examples
 *>  with n = 5:
 *>
 *>  if UPLO = 'U':                       if UPLO = 'L':
 *>
 *>    (  d   e   v2  v3  v4 )              (  d                  )
 *>    (      d   e   v3  v4 )              (  e   d              )
 *>    (          d   e   v4 )              (  v1  e   d          )
 *>    (              d   e  )              (  v1  v2  e   d      )
 *>    (                  d  )              (  v1  v2  v3  e   d  )
 *>
 *>  where d and e denote diagonal and off-diagonal elements of T, and vi
 *>  denotes an element of the vector defining H(i).
 *> \endverbatim
 *>
 *  =====================================================================
       SUBROUTINE ssytrd( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
 *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     December 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
       INTEGER            INFO, LDA, LWORK, N
 *     ..
 *     .. Array Arguments ..
       REAL               A( lda, * ), D( * ), E( * ), TAU( * ),
      $                   work( * )
 *     ..
 *
 *  =====================================================================
 *
 *     .. Parameters ..
       REAL               ONE
       parameter( one = 1.0e+0 )
 *     ..
 *     .. Local Scalars ..
       LOGICAL            LQUERY, UPPER
       INTEGER            I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
      $                   nbmin, nx
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           slatrd, ssyr2k, ssytd2, xerbla
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          max
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV
       EXTERNAL           lsame, ilaenv
 *     ..
 *     .. Executable Statements ..
 *
 *     Test the input parameters
 *
       info = 0
       upper = lsame( uplo, 'U' )
       lquery = ( lwork.EQ.-1 )
       IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
          info = -1
       ELSE IF( n.LT.0 ) THEN
          info = -2
       ELSE IF( lda.LT.max( 1, n ) ) THEN
          info = -4
       ELSE IF( lwork.LT.1 .AND. .NOT.lquery ) THEN
          info = -9
       END IF
 *
       IF( info.EQ.0 ) THEN
 *
 *        Determine the block size.
 *
          nb = ilaenv( 1, 'SSYTRD', uplo, n, -1, -1, -1 )
          lwkopt = n*nb
          work( 1 ) = lwkopt
       END IF
 *
       IF( info.NE.0 ) THEN
          CALL xerbla( 'SSYTRD', -info )
          RETURN
       ELSE IF( lquery ) THEN
          RETURN
       END IF
 *
 *     Quick return if possible
 *
       IF( n.EQ.0 ) THEN
          work( 1 ) = 1
          RETURN
       END IF
 *
       nx = n
       iws = 1
       IF( nb.GT.1 .AND. nb.LT.n ) THEN
 *
 *        Determine when to cross over from blocked to unblocked code
 *        (last block is always handled by unblocked code).
 *
          nx = max( nb, ilaenv( 3, 'SSYTRD', uplo, n, -1, -1, -1 ) )
          IF( nx.LT.n ) THEN
 *
 *           Determine if workspace is large enough for blocked code.
 *
             ldwork = n
             iws = ldwork*nb
             IF( lwork.LT.iws ) THEN
 *
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
 *              unblocked code by setting NX = N.
 *
                nb = max( lwork / ldwork, 1 )
                nbmin = ilaenv( 2, 'SSYTRD', uplo, n, -1, -1, -1 )
                IF( nb.LT.nbmin )
      $            nx = n
             END IF
          ELSE
             nx = n
          END IF
       ELSE
          nb = 1
       END IF
 *
       IF( upper ) THEN
 *
 *        Reduce the upper triangle of A.
 *        Columns 1:kk are handled by the unblocked method.
 *
          kk = n - ( ( n-nx+nb-1 ) / nb )*nb
          DO 20 i = n - nb + 1, kk + 1, -nb
 *
 *           Reduce columns i:i+nb-1 to tridiagonal form and form the
 *           matrix W which is needed to update the unreduced part of
 *           the matrix
 *
             CALL slatrd( uplo, i+nb-1, nb, a, lda, e, tau, work,
      $                   ldwork )
 *
 *           Update the unreduced submatrix A(1:i-1,1:i-1), using an
 *           update of the form:  A := A - V*W**T - W*V**T
 *
             CALL ssyr2k( uplo, 'No transpose', i-1, nb, -one, a( 1, i ),
      $                   lda, work, ldwork, one, a, lda )
 *
 *           Copy superdiagonal elements back into A, and diagonal
 *           elements into D
 *
             DO 10 j = i, i + nb - 1
                a( j-1, j ) = e( j-1 )
                d( j ) = a( j, j )
    10       CONTINUE
    20    CONTINUE
 *
 *        Use unblocked code to reduce the last or only block
 *
          CALL ssytd2( uplo, kk, a, lda, d, e, tau, iinfo )
       ELSE
 *
 *        Reduce the lower triangle of A
 *
          DO 40 i = 1, n - nx, nb
 *
 *           Reduce columns i:i+nb-1 to tridiagonal form and form the
 *           matrix W which is needed to update the unreduced part of
 *           the matrix
 *
             CALL slatrd( uplo, n-i+1, nb, a( i, i ), lda, e( i ),
      $                   tau( i ), work, ldwork )
 *
 *           Update the unreduced submatrix A(i+ib:n,i+ib:n), using
 *           an update of the form:  A := A - V*W**T - W*V**T
 *
             CALL ssyr2k( uplo, 'No transpose', n-i-nb+1, nb, -one,
      $                   a( i+nb, i ), lda, work( nb+1 ), ldwork, one,
      $                   a( i+nb, i+nb ), lda )
 *
 *           Copy subdiagonal elements back into A, and diagonal
 *           elements into D
 *
             DO 30 j = i, i + nb - 1
                a( j+1, j ) = e( j )
                d( j ) = a( j, j )
    30       CONTINUE
    40    CONTINUE
 *
 *        Use unblocked code to reduce the last or only block
 *
          CALL ssytd2( uplo, n-i+1, a( i, i ), lda, d( i ), e( i ),
      $                tau( i ), iinfo )
       END IF
 *
       work( 1 ) = lwkopt
       RETURN
 *
 *     End of SSYTRD
 *
       END
ssytd2
subroutine ssytd2(UPLO, N, A, LDA, D, E, TAU, INFO)
SSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity tran...
Definition: ssytd2.f:175

ssytrd
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
Definition: ssytrd.f:194

xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62

ssyr2k
subroutine ssyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SSYR2K
Definition: ssyr2k.f:194

slatrd
subroutine slatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
SLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
Definition: slatrd.f:200