126 SUBROUTINE cqrt01p( M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK,
135 INTEGER lda, lwork, m, n
138 REAL result( * ), rwork( * )
139 COMPLEX a( lda, * ), af( lda, * ), q( lda, * ),
140 $ r( lda, * ), tau( * ), work( lwork )
147 parameter( zero = 0.0e+0, one = 1.0e+0 )
149 parameter( rogue = ( -1.0e+10, -1.0e+10 ) )
153 REAL anorm, eps, resid
163 INTRINSIC cmplx, max, min, real
169 COMMON / srnamc / srnamt
178 CALL
clacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
cgeqrfp( m, n, af, lda, tau, work, lwork, info )
187 CALL
claset(
'Full', m, m, rogue, rogue, q, lda )
188 CALL
clacpy(
'Lower', m-1, n, af( 2, 1 ), lda, q( 2, 1 ), lda )
193 CALL
cungqr( m, m, minmn, q, lda, tau, work, lwork, info )
197 CALL
claset(
'Full', m, n, cmplx( zero ), cmplx( zero ), r, lda )
198 CALL
clacpy(
'Upper', m, n, af, lda, r, lda )
202 CALL
cgemm(
'Conjugate transpose',
'No transpose', m, n, m,
203 $ cmplx( -one ), q, lda, a, lda, cmplx( one ), r, lda )
207 anorm =
clange(
'1', m, n, a, lda, rwork )
208 resid =
clange(
'1', m, n, r, lda, rwork )
209 IF( anorm.GT.zero )
THEN
210 result( 1 ) = ( ( resid /
REAL( MAX( 1, M ) ) ) / anorm ) / eps
217 CALL
claset(
'Full', m, m, cmplx( zero ), cmplx( one ), r, lda )
218 CALL
cherk(
'Upper',
'Conjugate transpose', m, m, -one, q, lda,
223 resid =
clansy(
'1',
'Upper', m, r, lda, rwork )
225 result( 2 ) = ( resid /
REAL( MAX( 1, M ) ) ) / 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 cqrt01p(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQRT01P
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 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
subroutine cgeqrfp(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRFP
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR