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 ) )