140 SUBROUTINE zhst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
141 $ lwork, rwork, result )
149 INTEGER ihi, ilo, lda, ldh, ldq, lwork, n
152 DOUBLE PRECISION result( 2 ), rwork( * )
153 COMPLEX*16 a( lda, * ), h( ldh, * ), q( ldq, * ),
160 DOUBLE PRECISION one, zero
161 parameter( one = 1.0d+0, zero = 0.0d+0 )
165 DOUBLE PRECISION anorm, eps, ovfl, smlnum, unfl, wnorm
175 INTRINSIC dcmplx, max, min
187 unfl =
dlamch(
'Safe minimum' )
188 eps =
dlamch(
'Precision' )
191 smlnum = unfl*n / eps
198 CALL
zlacpy(
' ', n, n, a, lda, work, ldwork )
202 CALL
zgemm(
'No transpose',
'No transpose', n, n, n,
203 $ dcmplx( one ), q, ldq, h, ldh, dcmplx( zero ),
204 $ work( ldwork*n+1 ), ldwork )
208 CALL
zgemm(
'No transpose',
'Conjugate transpose', n, n, n,
209 $ dcmplx( -one ), work( ldwork*n+1 ), ldwork, q, ldq,
210 $ dcmplx( one ), work, ldwork )
212 anorm = max(
zlange(
'1', n, n, a, lda, rwork ), unfl )
213 wnorm =
zlange(
'1', n, n, work, ldwork, rwork )
217 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
221 CALL
zunt01(
'Columns', n, n, q, ldq, work, lwork, rwork,
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine dlabad(SMALL, LARGE)
DLABAD
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zhst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
ZHST01