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
168 DOUBLE PRECISION DLAMCH, ZLANGE
169 EXTERNAL dlamch, zlange
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 zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zhst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
ZHST01
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
subroutine dlabad(SMALL, LARGE)
DLABAD