136 SUBROUTINE cqlt02( M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK,
145 INTEGER k, lda, lwork, m, n
148 REAL result( * ), rwork( * )
149 COMPLEX a( lda, * ), af( lda, * ), l( lda, * ),
150 $ q( 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', m-k, k, af( 1, n-k+1 ), lda,
198 $ q( 1, n-k+1 ), lda )
200 $ CALL
clacpy(
'Upper', k-1, k-1, af( m-k+1, n-k+2 ), lda,
201 $ q( m-k+1, n-k+2 ), lda )
206 CALL
cungql( m, n, k, q, lda, tau( n-k+1 ), work, lwork, info )
210 CALL
claset(
'Full', n, k, cmplx( zero ), cmplx( zero ),
211 $ l( m-n+1, n-k+1 ), lda )
212 CALL
clacpy(
'Lower', k, k, af( m-k+1, n-k+1 ), lda,
213 $ l( m-k+1, n-k+1 ), lda )
217 CALL
cgemm(
'Conjugate transpose',
'No transpose', n, k, m,
218 $ cmplx( -one ), q, lda, a( 1, n-k+1 ), lda,
219 $ cmplx( one ), l( m-n+1, n-k+1 ), lda )
223 anorm =
clange(
'1', m, k, a( 1, n-k+1 ), lda, rwork )
224 resid =
clange(
'1', n, k, l( m-n+1, n-k+1 ), lda, rwork )
225 IF( anorm.GT.zero )
THEN
226 result( 1 ) = ( ( resid /
REAL( MAX( 1, M ) ) ) / anorm ) / eps
233 CALL
claset(
'Full', n, n, cmplx( zero ), cmplx( one ), l, lda )
234 CALL
cherk(
'Upper',
'Conjugate transpose', n, m, -one, q, lda,
239 resid =
clansy(
'1',
'Upper', n, l, lda, rwork )
241 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 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 cqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CQLT02
subroutine cungql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQL
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
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 cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK