126 SUBROUTINE drqt01( M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK,
135 INTEGER LDA, LWORK, M, N
138 DOUBLE PRECISION A( lda, * ), AF( lda, * ), Q( lda, * ),
139 $ r( 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
156 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY
157 EXTERNAL dlamch, dlange, dlansy
163 INTRINSIC dble, max, min
169 COMMON / srnamc / srnamt
174 eps = dlamch(
'Epsilon' )
178 CALL
dlacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
dgerqf( m, n, af, lda, tau, work, lwork, info )
187 CALL
dlaset(
'Full', n, n, rogue, rogue, q, lda )
189 IF( m.GT.0 .AND. m.LT.n )
190 $ CALL
dlacpy(
'Full', m, n-m, af, lda, q( n-m+1, 1 ), lda )
192 $ CALL
dlacpy(
'Lower', m-1, m-1, af( 2, n-m+1 ), lda,
193 $ q( n-m+2, n-m+1 ), lda )
196 $ CALL
dlacpy(
'Lower', n-1, n-1, af( m-n+2, 1 ), lda,
203 CALL
dorgrq( n, n, minmn, q, lda, tau, work, lwork, info )
207 CALL
dlaset(
'Full', m, n, zero, zero, r, lda )
210 $ CALL
dlacpy(
'Upper', m, m, af( 1, n-m+1 ), lda,
211 $ r( 1, n-m+1 ), lda )
213 IF( m.GT.n .AND. n.GT.0 )
214 $ CALL
dlacpy(
'Full', m-n, n, af, lda, r, lda )
216 $ CALL
dlacpy(
'Upper', n, n, af( m-n+1, 1 ), lda,
217 $ r( m-n+1, 1 ), lda )
222 CALL
dgemm(
'No transpose',
'Transpose', m, n, n, -one, a, lda, q,
227 anorm = dlange(
'1', m, n, a, lda, rwork )
228 resid = dlange(
'1', m, n, r, lda, rwork )
229 IF( anorm.GT.zero )
THEN
230 result( 1 ) = ( ( resid / dble( max( 1, n ) ) ) / anorm ) / eps
237 CALL
dlaset(
'Full', n, n, zero, one, r, lda )
238 CALL
dsyrk(
'Upper',
'No transpose', n, n, -one, q, lda, one, r,
243 resid = dlansy(
'1',
'Upper', n, r, lda, rwork )
245 result( 2 ) = ( resid / dble( max( 1, n ) ) ) / eps
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
subroutine dgerqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGERQF
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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...
subroutine dorgrq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGRQ
subroutine drqt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DRQT01