126 SUBROUTINE dlqt01( M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK,
135 INTEGER lda, lwork, m, n
138 DOUBLE PRECISION a( lda, * ), af( lda, * ), l( lda, * ),
139 $ q( lda, * ), result( * ), rwork( * ), tau( * ),
146 DOUBLE PRECISION zero, one
147 parameter( zero = 0.0d+0, one = 1.0d+0 )
148 DOUBLE PRECISION rogue
149 parameter( rogue = -1.0d+10 )
153 DOUBLE PRECISION anorm, eps, resid
163 INTRINSIC dble, max, min
169 COMMON / srnamc / srnamt
178 CALL
dlacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
dgelqf( m, n, af, lda, tau, work, lwork, info )
187 CALL
dlaset(
'Full', n, n, rogue, rogue, q, lda )
189 $ CALL
dlacpy(
'Upper', m, n-1, af( 1, 2 ), lda, q( 1, 2 ), lda )
194 CALL
dorglq( n, n, minmn, q, lda, tau, work, lwork, info )
198 CALL
dlaset(
'Full', m, n, zero, zero, l, lda )
199 CALL
dlacpy(
'Lower', m, n, af, lda, l, lda )
203 CALL
dgemm(
'No transpose',
'Transpose', m, n, n, -one, a, lda, q,
208 anorm =
dlange(
'1', m, n, a, lda, rwork )
209 resid =
dlange(
'1', m, n, l, lda, rwork )
210 IF( anorm.GT.zero )
THEN
211 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
218 CALL
dlaset(
'Full', n, n, zero, one, l, lda )
219 CALL
dsyrk(
'Upper',
'No transpose', n, n, -one, q, lda, one, l,
224 resid =
dlansy(
'1',
'Upper', n, l, lda, rwork )
226 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
subroutine dgelqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGELQF
subroutine dlqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT01
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGLQ
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
DOUBLE PRECISION function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...