sstevd.f

*> \brief <b> SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SSTEVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sstevd.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sstevd.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sstevd.f">
*> [TXT]</a>
*> \endhtmlonly
*
*  Definition:
*  ===========
*
*       SUBROUTINE SSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
*                          LIWORK, INFO )
*
*       .. Scalar Arguments ..
*       CHARACTER          JOBZ
*       INTEGER            INFO, LDZ, LIWORK, LWORK, N
*       ..
*       .. Array Arguments ..
*       INTEGER            IWORK( * )
*       REAL               D( * ), E( * ), WORK( * ), Z( LDZ, * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> SSTEVD computes all eigenvalues and, optionally, eigenvectors of a
*> real symmetric tridiagonal matrix. If eigenvectors are desired, it
*> uses a divide and conquer algorithm.
*>
*> The divide and conquer algorithm makes very mild assumptions about
*> floating point arithmetic. It will work on machines with a guard
*> digit in add/subtract, or on those binary machines without guard
*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
*> without guard digits, but we know of none.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] JOBZ
*> \verbatim
*>          JOBZ is CHARACTER*1
*>          = 'N':  Compute eigenvalues only;
*>          = 'V':  Compute eigenvalues and eigenvectors.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The order of the matrix.  N >= 0.
*> \endverbatim
*>
*> \param[in,out] D
*> \verbatim
*>          D is REAL array, dimension (N)
*>          On entry, the n diagonal elements of the tridiagonal matrix
*>          A.
*>          On exit, if INFO = 0, the eigenvalues in ascending order.
*> \endverbatim
*>
*> \param[in,out] E
*> \verbatim
*>          E is REAL array, dimension (N-1)
*>          On entry, the (n-1) subdiagonal elements of the tridiagonal
*>          matrix A, stored in elements 1 to N-1 of E.
*>          On exit, the contents of E are destroyed.
*> \endverbatim
*>
*> \param[out] Z
*> \verbatim
*>          Z is REAL array, dimension (LDZ, N)
*>          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
*>          eigenvectors of the matrix A, with the i-th column of Z
*>          holding the eigenvector associated with D(i).
*>          If JOBZ = 'N', then Z is not referenced.
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
*>          LDZ is INTEGER
*>          The leading dimension of the array Z.  LDZ >= 1, and if
*>          JOBZ = 'V', LDZ >= max(1,N).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is REAL array,
*>                                         dimension (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.
*>          If JOBZ  = 'N' or N <= 1 then LWORK must be at least 1.
*>          If JOBZ  = 'V' and N > 1 then LWORK must be at least
*>                         ( 1 + 4*N + N**2 ).
*>
*>          If LWORK = -1, then a workspace query is assumed; the routine
*>          only calculates the optimal sizes of the WORK and IWORK
*>          arrays, returns these values as the first entries of the WORK
*>          and IWORK arrays, and no error message related to LWORK or
*>          LIWORK is issued by XERBLA.
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
*>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
*>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*> \endverbatim
*>
*> \param[in] LIWORK
*> \verbatim
*>          LIWORK is INTEGER
*>          The dimension of the array IWORK.
*>          If JOBZ  = 'N' or N <= 1 then LIWORK must be at least 1.
*>          If JOBZ  = 'V' and N > 1 then LIWORK must be at least 3+5*N.
*>
*>          If LIWORK = -1, then a workspace query is assumed; the
*>          routine only calculates the optimal sizes of the WORK and
*>          IWORK arrays, returns these values as the first entries of
*>          the WORK and IWORK arrays, and no error message related to
*>          LWORK or LIWORK 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
*>          > 0:  if INFO = i, the algorithm failed to converge; i
*>                off-diagonal elements of E did not converge to zero.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup stevd
*
*  =====================================================================
      SUBROUTINE sstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
     $                   LIWORK, INFO )
*
*  -- LAPACK driver routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          JOBZ
      INTEGER            INFO, LDZ, LIWORK, LWORK, N
*     ..
*     .. Array Arguments ..
      INTEGER            IWORK( * )
      REAL               D( * ), E( * ), WORK( * ), Z( ldz, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e0, one = 1.0e0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LQUERY, WANTZ
      INTEGER            ISCALE, LIWMIN, LWMIN
      REAL               BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
     $                   tnrm
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      REAL               SLAMCH, SLANST
      EXTERNAL           lsame, slamch, slanst
*     ..
*     .. External Subroutines ..
      EXTERNAL           sscal, sstedc, ssterf, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          sqrt
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      wantz = lsame( jobz, 'V' )
      lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
*
      info = 0
      liwmin = 1
      lwmin = 1
      IF( n.GT.1 .AND. wantz ) THEN
         lwmin = 1 + 4*n + n**2
         liwmin = 3 + 5*n
      END IF
*
      IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
         info = -1
      ELSE IF( n.LT.0 ) THEN
         info = -2
      ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) THEN
         info = -6
      END IF
*
      IF( info.EQ.0 ) THEN
         work( 1 ) = lwmin
         iwork( 1 ) = liwmin
*
         IF( lwork.LT.lwmin .AND. .NOT.lquery ) THEN
            info = -8
         ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) THEN
            info = -10
         END IF
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SSTEVD', -info )
         RETURN
      ELSE IF( lquery ) THEN
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( n.EQ.0 )
     $   RETURN
*
      IF( n.EQ.1 ) THEN
         IF( wantz )
     $      z( 1, 1 ) = one
         RETURN
      END IF
*
*     Get machine constants.
*
      safmin = slamch( 'Safe minimum' )
      eps = slamch( 'Precision' )
      smlnum = safmin / eps
      bignum = one / smlnum
      rmin = sqrt( smlnum )
      rmax = sqrt( bignum )
*
*     Scale matrix to allowable range, if necessary.
*
      iscale = 0
      tnrm = slanst( 'M', n, d, e )
      IF( tnrm.GT.zero .AND. tnrm.LT.rmin ) THEN
         iscale = 1
         sigma = rmin / tnrm
      ELSE IF( tnrm.GT.rmax ) THEN
         iscale = 1
         sigma = rmax / tnrm
      END IF
      IF( iscale.EQ.1 ) THEN
         CALL sscal( n, sigma, d, 1 )
         CALL sscal( n-1, sigma, e( 1 ), 1 )
      END IF
*
*     For eigenvalues only, call SSTERF.  For eigenvalues and
*     eigenvectors, call SSTEDC.
*
      IF( .NOT.wantz ) THEN
         CALL ssterf( n, d, e, info )
      ELSE
         CALL sstedc( 'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
     $                info )
      END IF
*
*     If matrix was scaled, then rescale eigenvalues appropriately.
*
      IF( iscale.EQ.1 )
     $   CALL sscal( n, one / sigma, d, 1 )
*
      work( 1 ) = lwmin
      iwork( 1 ) = liwmin
*
      RETURN
*
*     End of SSTEVD
*
      END