132 SUBROUTINE shst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
140 INTEGER IHI, ILO, LDA, LDH, LDQ, LWORK, N
143 REAL A( LDA, * ), H( LDH, * ), Q( LDQ, * ),
144 $ result( 2 ), work( lwork )
151 parameter( one = 1.0e+0, zero = 0.0e+0 )
155 REAL ANORM, EPS, OVFL, SMLNUM, UNFL, WNORM
159 EXTERNAL slamch, slange
177 unfl = slamch(
'Safe minimum' )
178 eps = slamch(
'Precision' )
181 smlnum = unfl*n / eps
188 CALL slacpy(
' ', n, n, a, lda, work, ldwork )
192 CALL sgemm(
'No transpose',
'No transpose', n, n, n, one, q, ldq,
193 $ h, ldh, zero, work( ldwork*n+1 ), ldwork )
197 CALL sgemm(
'No transpose',
'Transpose', n, n, n, -one,
198 $ work( ldwork*n+1 ), ldwork, q, ldq, one, work,
201 anorm = max( slange(
'1', n, n, a, lda, work( ldwork*n+1 ) ),
203 wnorm = slange(
'1', n, n, work, ldwork, work( ldwork*n+1 ) )
207 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
211 CALL sort01(
'Columns', n, n, q, ldq, work, lwork, result( 2 ) )
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
subroutine shst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RESULT)
SHST01