140 SUBROUTINE chst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
141 $ lwork, rwork, result )
149 INTEGER IHI, ILO, LDA, LDH, LDQ, LWORK, N
152 REAL RESULT( 2 ), RWORK( * )
153 COMPLEX A( lda, * ), H( ldh, * ), Q( ldq, * ),
161 parameter ( one = 1.0e+0, zero = 0.0e+0 )
165 REAL ANORM, EPS, OVFL, SMLNUM, UNFL, WNORM
169 EXTERNAL clange, slamch
175 INTRINSIC cmplx, max, min
187 unfl = slamch(
'Safe minimum' )
188 eps = slamch(
'Precision' )
191 smlnum = unfl*n / eps
198 CALL clacpy(
' ', n, n, a, lda, work, ldwork )
202 CALL cgemm(
'No transpose',
'No transpose', n, n, n, cmplx( one ),
203 $ q, ldq, h, ldh, cmplx( zero ), work( ldwork*n+1 ),
208 CALL cgemm(
'No transpose',
'Conjugate transpose', n, n, n,
209 $ cmplx( -one ), work( ldwork*n+1 ), ldwork, q, ldq,
210 $ cmplx( one ), work, ldwork )
212 anorm = max( clange(
'1', n, n, a, lda, rwork ), unfl )
213 wnorm = clange(
'1', n, n, work, ldwork, rwork )
217 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
221 CALL cunt01(
'Columns', n, n, q, ldq, work, lwork, rwork,
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01