135 SUBROUTINE zlqt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
144 INTEGER K, LDA, LWORK, M, N
147 DOUBLE PRECISION RESULT( * ), RWORK( * )
148 COMPLEX*16 A( lda, * ), AF( lda, * ), L( lda, * ),
149 $ q( lda, * ), tau( * ), work( lwork )
155 DOUBLE PRECISION ZERO, ONE
156 parameter ( zero = 0.0d+0, one = 1.0d+0 )
158 parameter ( rogue = ( -1.0d+10, -1.0d+10 ) )
162 DOUBLE PRECISION ANORM, EPS, RESID
165 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY
166 EXTERNAL dlamch, zlange, zlansy
172 INTRINSIC dble, dcmplx, max
178 COMMON / srnamc / srnamt
182 eps = dlamch(
'Epsilon' )
186 CALL zlaset(
'Full', m, n, rogue, rogue, q, lda )
187 CALL zlacpy(
'Upper', k, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
192 CALL zunglq( m, n, k, q, lda, tau, work, lwork, info )
196 CALL zlaset(
'Full', k, m, dcmplx( zero ), dcmplx( zero ), l,
198 CALL zlacpy(
'Lower', k, m, af, lda, l, lda )
202 CALL zgemm(
'No transpose',
'Conjugate transpose', k, m, n,
203 $ dcmplx( -one ), a, lda, q, lda, dcmplx( one ), l,
208 anorm = zlange(
'1', k, n, a, lda, rwork )
209 resid = zlange(
'1', k, m, l, lda, rwork )
210 IF( anorm.GT.zero )
THEN
211 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
218 CALL zlaset(
'Full', m, m, dcmplx( zero ), dcmplx( one ), l, lda )
219 CALL zherk(
'Upper',
'No transpose', m, n, -one, q, lda, one, l,
224 resid = zlansy(
'1',
'Upper', m, l, lda, rwork )
226 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
subroutine zlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZLQT02
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 zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
subroutine zunglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGLQ