126 SUBROUTINE zrqt01( M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK,
135 INTEGER LDA, LWORK, M, N
138 DOUBLE PRECISION RESULT( * ), RWORK( * )
139 COMPLEX*16 A( lda, * ), AF( lda, * ), Q( lda, * ),
140 $ r( lda, * ), tau( * ), work( lwork )
146 DOUBLE PRECISION ZERO, ONE
147 parameter( zero = 0.0d+0, one = 1.0d+0 )
149 parameter( rogue = ( -1.0d+10, -1.0d+10 ) )
153 DOUBLE PRECISION ANORM, EPS, RESID
156 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY
157 EXTERNAL dlamch, zlange, zlansy
163 INTRINSIC dble, dcmplx, max, min
169 COMMON / srnamc / srnamt
174 eps = dlamch(
'Epsilon' )
178 CALL
zlacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
zgerqf( m, n, af, lda, tau, work, lwork, info )
187 CALL
zlaset(
'Full', n, n, rogue, rogue, q, lda )
189 IF( m.GT.0 .AND. m.LT.n )
190 $ CALL
zlacpy(
'Full', m, n-m, af, lda, q( n-m+1, 1 ), lda )
192 $ CALL
zlacpy(
'Lower', m-1, m-1, af( 2, n-m+1 ), lda,
193 $ q( n-m+2, n-m+1 ), lda )
196 $ CALL
zlacpy(
'Lower', n-1, n-1, af( m-n+2, 1 ), lda,
203 CALL
zungrq( n, n, minmn, q, lda, tau, work, lwork, info )
207 CALL
zlaset(
'Full', m, n, dcmplx( zero ), dcmplx( zero ), r,
211 $ CALL
zlacpy(
'Upper', m, m, af( 1, n-m+1 ), lda,
212 $ r( 1, n-m+1 ), lda )
214 IF( m.GT.n .AND. n.GT.0 )
215 $ CALL
zlacpy(
'Full', m-n, n, af, lda, r, lda )
217 $ CALL
zlacpy(
'Upper', n, n, af( m-n+1, 1 ), lda,
218 $ r( m-n+1, 1 ), lda )
223 CALL
zgemm(
'No transpose',
'Conjugate transpose', m, n, n,
224 $ dcmplx( -one ), a, lda, q, lda, dcmplx( one ), r,
229 anorm = zlange(
'1', m, n, a, lda, rwork )
230 resid = zlange(
'1', m, n, r, lda, rwork )
231 IF( anorm.GT.zero )
THEN
232 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
239 CALL
zlaset(
'Full', n, n, dcmplx( zero ), dcmplx( one ), r, lda )
240 CALL
zherk(
'Upper',
'No transpose', n, n, -one, q, lda, one, r,
245 resid = zlansy(
'1',
'Upper', n, r, lda, rwork )
247 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
subroutine zgerqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGERQF
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
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 zrqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZRQT01
subroutine zungrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGRQ