134 SUBROUTINE dhst01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK,
143 INTEGER IHI, ILO, LDA, LDH, LDQ, LWORK, N
146 DOUBLE PRECISION A( lda, * ), H( ldh, * ), Q( ldq, * ),
147 $ result( 2 ), work( lwork )
153 DOUBLE PRECISION ONE, ZERO
154 parameter( one = 1.0d+0, zero = 0.0d+0 )
158 DOUBLE PRECISION ANORM, EPS, OVFL, SMLNUM, UNFL, WNORM
161 DOUBLE PRECISION DLAMCH, DLANGE
162 EXTERNAL dlamch, dlange
180 unfl = dlamch(
'Safe minimum' )
181 eps = dlamch(
'Precision' )
184 smlnum = unfl*n / eps
191 CALL
dlacpy(
' ', n, n, a, lda, work, ldwork )
195 CALL
dgemm(
'No transpose',
'No transpose', n, n, n, one, q, ldq,
196 $ h, ldh, zero, work( ldwork*n+1 ), ldwork )
200 CALL
dgemm(
'No transpose',
'Transpose', n, n, n, -one,
201 $ work( ldwork*n+1 ), ldwork, q, ldq, one, work,
204 anorm = max( dlange(
'1', n, n, a, lda, work( ldwork*n+1 ) ),
206 wnorm = dlange(
'1', n, n, work, ldwork, work( ldwork*n+1 ) )
210 result( 1 ) = min( wnorm, anorm ) / max( smlnum, anorm*eps ) / n
214 CALL
dort01(
'Columns', n, n, q, ldq, work, lwork, result( 2 ) )
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dhst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RESULT)
DHST01
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01