134 SUBROUTINE shst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
143 INTEGER ihi, ilo, lda, ldh, ldq, lwork, n
146 REAL a( lda, * ), h( ldh, * ), q( ldq, * ),
147 $ result( 2 ), work( lwork )
154 parameter( one = 1.0e+0, zero = 0.0e+0 )
158 REAL anorm, eps, ovfl, smlnum, unfl, wnorm
180 unfl =
slamch(
'Safe minimum' )
181 eps =
slamch(
'Precision' )
184 smlnum = unfl*n / eps
191 CALL
slacpy(
' ', n, n, a, lda, work, ldwork )
195 CALL
sgemm(
'No transpose',
'No transpose', n, n, n, one, q, ldq,
196 $ h, ldh, zero, work( ldwork*n+1 ), ldwork )
200 CALL
sgemm(
'No transpose',
'Transpose', n, n, n, -one,
201 $ work( ldwork*n+1 ), ldwork, q, ldq, one, work,
204 anorm = max(
slange(
'1', n, n, a, lda, work( ldwork*n+1 ) ),
206 wnorm =
slange(
'1', n, n, work, ldwork, work( ldwork*n+1 ) )
210 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
214 CALL
sort01(
'Columns', n, n, q, ldq, work, lwork, result( 2 ) )
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine shst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RESULT)
SHST01
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function slamch(CMACH)
SLAMCH
subroutine slabad(SMALL, LARGE)
SLABAD