136 SUBROUTINE crqt02( M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 REAL result( * ), rwork( * )
149 COMPLEX a( lda, * ), af( lda, * ), q( lda, * ),
150 $ r( lda, * ), tau( * ), work( lwork )
157 parameter( zero = 0.0e+0, one = 1.0e+0 )
159 parameter( rogue = ( -1.0e+10, -1.0e+10 ) )
163 REAL anorm, eps, resid
173 INTRINSIC cmplx, max, real
179 COMMON / srnamc / srnamt
185 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 )
THEN
195 CALL
claset(
'Full', m, n, rogue, rogue, q, lda )
197 $ CALL
clacpy(
'Full', k, n-k, af( m-k+1, 1 ), lda,
198 $ q( m-k+1, 1 ), lda )
200 $ CALL
clacpy(
'Lower', k-1, k-1, af( m-k+2, n-k+1 ), lda,
201 $ q( m-k+2, n-k+1 ), lda )
206 CALL
cungrq( m, n, k, q, lda, tau( m-k+1 ), work, lwork, info )
210 CALL
claset(
'Full', k, m, cmplx( zero ), cmplx( zero ),
211 $ r( m-k+1, n-m+1 ), lda )
212 CALL
clacpy(
'Upper', k, k, af( m-k+1, n-k+1 ), lda,
213 $ r( m-k+1, n-k+1 ), lda )
217 CALL
cgemm(
'No transpose',
'Conjugate transpose', k, m, n,
218 $ cmplx( -one ), a( m-k+1, 1 ), lda, q, lda,
219 $ cmplx( one ), r( m-k+1, n-m+1 ), lda )
223 anorm =
clange(
'1', k, n, a( m-k+1, 1 ), lda, rwork )
224 resid =
clange(
'1', k, m, r( m-k+1, n-m+1 ), lda, rwork )
225 IF( anorm.GT.zero )
THEN
226 result( 1 ) = ( ( resid /
REAL( MAX( 1, N ) ) ) / anorm ) / eps
233 CALL
claset(
'Full', m, m, cmplx( zero ), cmplx( one ), r, lda )
234 CALL
cherk(
'Upper',
'No transpose', m, n, -one, q, lda, one, r,
239 resid =
clansy(
'1',
'Upper', m, r, lda, rwork )
241 result( 2 ) = ( resid /
REAL( MAX( 1, N ) ) ) / eps
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
REAL function slamch(CMACH)
SLAMCH
subroutine cungrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGRQ
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine crqt02(M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CRQT02
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
REAL function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK