138 SUBROUTINE chst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
139 $ LWORK, RWORK, RESULT )
146 INTEGER IHI, ILO, LDA, LDH, LDQ, LWORK, N
149 REAL RESULT( 2 ), RWORK( * )
150 COMPLEX A( LDA, * ), H( LDH, * ), Q( LDQ, * ),
158 parameter( one = 1.0e+0, zero = 0.0e+0 )
162 REAL ANORM, EPS, OVFL, SMLNUM, UNFL, WNORM
166 EXTERNAL clange, slamch
172 INTRINSIC cmplx, max, min
184 unfl = slamch(
'Safe minimum' )
185 eps = slamch(
'Precision' )
188 smlnum = unfl*n / eps
195 CALL clacpy(
' ', n, n, a, lda, work, ldwork )
199 CALL cgemm(
'No transpose',
'No transpose', n, n, n, cmplx( one ),
200 $ q, ldq, h, ldh, cmplx( zero ), work( ldwork*n+1 ),
205 CALL cgemm(
'No transpose',
'Conjugate transpose', n, n, n,
206 $ cmplx( -one ), work( ldwork*n+1 ), ldwork, q, ldq,
207 $ cmplx( one ), work, ldwork )
209 anorm = max( clange(
'1', n, n, a, lda, rwork ), unfl )
210 wnorm = clange(
'1', n, n, work, ldwork, rwork )
214 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
218 CALL cunt01(
'Columns', n, n, q, ldq, work, lwork, rwork,
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.