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
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,
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01
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.
real function slamch(CMACH)
SLAMCH
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM