126 SUBROUTINE zqrt01p( 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
zgeqrfp( m, n, af, lda, tau, work, lwork, info )
187 CALL
zlaset(
'Full', m, m, rogue, rogue, q, lda )
188 CALL
zlacpy(
'Lower', m-1, n, af( 2, 1 ), lda, q( 2, 1 ), lda )
193 CALL
zungqr( m, m, minmn, q, lda, tau, work, lwork, info )
197 CALL
zlaset(
'Full', m, n, dcmplx( zero ), dcmplx( zero ), r,
199 CALL
zlacpy(
'Upper', m, n, af, lda, r, lda )
203 CALL
zgemm(
'Conjugate transpose',
'No transpose', m, n, m,
204 $ dcmplx( -one ), q, lda, a, lda, dcmplx( one ), r,
209 anorm = zlange(
'1', m, n, a, lda, rwork )
210 resid = zlange(
'1', m, n, r, lda, rwork )
211 IF( anorm.GT.zero )
THEN
212 result( 1 ) = ( ( resid / dble( max( 1, m ) ) ) / anorm ) / eps
219 CALL
zlaset(
'Full', m, m, dcmplx( zero ), dcmplx( one ), r, lda )
220 CALL
zherk(
'Upper',
'Conjugate transpose', m, m, -one, q, lda,
225 resid = zlansy(
'1',
'Upper', m, r, lda, rwork )
227 result( 2 ) = ( resid / dble( max( 1, m ) ) ) / eps
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 zgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGEQRFP
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
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 zqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQRT01P