171      SUBROUTINE ssyevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
 
  181      INTEGER            INFO, LDA, LIWORK, LWORK, N
 
  185      REAL               A( LDA, * ), W( * ), WORK( * )
 
  192      PARAMETER          ( ZERO = 0.0e+0, one = 1.0e+0 )
 
  196      LOGICAL            LOWER, LQUERY, WANTZ
 
  197      INTEGER            IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
 
  198     $                   liopt, liwmin, llwork, llwrk2, lopt, lwmin
 
  199      REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
 
  205      REAL               SLAMCH, SLANSY, SROUNDUP_LWORK
 
  206      EXTERNAL           ilaenv, lsame, slamch,
 
  207     $                   slansy, sroundup_lwork
 
  221      wantz = lsame( jobz, 
'V' )
 
  222      lower = lsame( uplo, 
'L' )
 
  223      lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
 
  226      IF( .NOT.( wantz .OR. lsame( jobz, 
'N' ) ) ) 
THEN 
  228      ELSE IF( .NOT.( lower .OR. lsame( uplo, 
'U' ) ) ) 
THEN 
  230      ELSE IF( n.LT.0 ) 
THEN 
  232      ELSE IF( lda.LT.max( 1, n ) ) 
THEN 
  245               lwmin = 1 + 6*n + 2*n**2
 
  250            lopt = max( lwmin, 2*n +
 
  251     $                  n*ilaenv( 1, 
'SSYTRD', uplo, n, -1, -1,
 
  255         work( 1 ) = sroundup_lwork( lopt )
 
  258         IF( lwork.LT.lwmin .AND. .NOT.lquery ) 
THEN 
  260         ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) 
THEN 
  266         CALL xerbla( 
'SSYEVD', -info )
 
  268      ELSE IF( lquery ) 
THEN 
  286      safmin = slamch( 
'Safe minimum' )
 
  287      eps = slamch( 
'Precision' )
 
  288      smlnum = safmin / eps
 
  289      bignum = one / smlnum
 
  290      rmin = sqrt( smlnum )
 
  291      rmax = sqrt( bignum )
 
  295      anrm = slansy( 
'M', uplo, n, a, lda, work )
 
  297      IF( anrm.GT.zero .AND. anrm.LT.rmin ) 
THEN 
  300      ELSE IF( anrm.GT.rmax ) 
THEN 
  305     $   
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
 
  312      llwork = lwork - indwrk + 1
 
  313      indwk2 = indwrk + n*n
 
  314      llwrk2 = lwork - indwk2 + 1
 
  316      CALL ssytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
 
  317     $             work( indwrk ), llwork, iinfo )
 
  324      IF( .NOT.wantz ) 
THEN 
  325         CALL ssterf( n, w, work( inde ), info )
 
  327         CALL sstedc( 
'I', n, w, work( inde ), work( indwrk ), n,
 
  328     $                work( indwk2 ), llwrk2, iwork, liwork, info )
 
  329         CALL sormtr( 
'L', uplo, 
'N', n, n, a, lda, work( indtau ),
 
  330     $                work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
 
  331         CALL slacpy( 
'A', n, n, work( indwrk ), n, a, lda )
 
  337     $   
CALL sscal( n, one / sigma, w, 1 )
 
  339      work( 1 ) = sroundup_lwork( lopt )
 
 
subroutine ssyevd(jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork, info)
SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine sormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
SORMTR