1 SUBROUTINE zlqt01( M, N, A, AF, Q, L, LDA, T, WORK, LWORK,
11 INTEGER lda, lwork, m, n
15 DOUBLE PRECISION result( * ), rwork( * )
16 COMPLEX*16 a( lda, * ), af( lda, * ), l( lda, * ),
17 $ q( lda, * ), work( lwork )
73 DOUBLE PRECISION zero, one
74 parameter( zero = 0.0d+0, one = 1.0d+0 )
76 parameter( rogue = ( -1.0d+10, -1.0d+10 ) )
80 DOUBLE PRECISION anorm, eps, resid
83 DOUBLE PRECISION dlamch, zlange, zlansy
84 EXTERNAL dlamch, zlange, zlansy
87 EXTERNAL zgelqf, zgemm, zherk, zlacpy,
zlaset, zunglq
90 INTRINSIC dble, dcmplx,
max,
min
96 common / srnamc / srnamt
101 eps = dlamch(
'Epsilon' )
105 CALL zlacpy(
'Full', m, n, a, lda, af, lda )
114 CALL
zlaset(
'Full', m, n, dcmplx( zero ), dcmplx( one ), q, lda )
123 CALL
zlaset(
'Full', m, m, dcmplx( zero ), dcmplx( zero ), l,
125 CALL zlacpy(
'Lower', m, n, af, lda, l, lda )
129 CALL zgemm(
'No transpose',
'Conjugate transpose', m, m, n,
130 $ dcmplx( -one ), a, lda, q, lda, dcmplx( one ), l,
135 anorm = zlange(
'1', m, n, a, lda, rwork )
136 resid = zlange(
'1', m, m, l, lda, rwork )
137 IF( anorm.GT.zero )
THEN
138 result( 1 ) = ( ( resid / dble(
max( 1, n ) ) ) / anorm ) / eps
145 CALL
zlaset(
'Full', m, m, dcmplx( zero ), dcmplx( one ), l, lda )
146 CALL zherk(
'Upper',
'No transpose', m, n, one, q, lda, -one, l,
151 resid = zlansy(
'1',
'Upper', m, l, lda, rwork )
153 result( 2 ) = ( resid / dble(
max( 1, m ) ) ) / eps