126 SUBROUTINE sqrt01( M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK,
135 INTEGER lda, lwork, m, n
138 REAL a( lda, * ), af( lda, * ), q( lda, * ),
139 $ r( lda, * ), result( * ), rwork( * ), tau( * ),
147 parameter( zero = 0.0e+0, one = 1.0e+0 )
149 parameter( rogue = -1.0e+10 )
153 REAL anorm, eps, resid
163 INTRINSIC max, min, real
169 COMMON / srnamc / srnamt
178 CALL
slacpy(
'Full', m, n, a, lda, af, lda )
183 CALL
sgeqrf( m, n, af, lda, tau, work, lwork, info )
187 CALL
slaset(
'Full', m, m, rogue, rogue, q, lda )
188 CALL
slacpy(
'Lower', m-1, n, af( 2, 1 ), lda, q( 2, 1 ), lda )
193 CALL
sorgqr( m, m, minmn, q, lda, tau, work, lwork, info )
197 CALL
slaset(
'Full', m, n, zero, zero, r, lda )
198 CALL
slacpy(
'Upper', m, n, af, lda, r, lda )
202 CALL
sgemm(
'Transpose',
'No transpose', m, n, m, -one, q, lda, a,
207 anorm =
slange(
'1', m, n, a, lda, rwork )
208 resid =
slange(
'1', m, n, r, lda, rwork )
209 IF( anorm.GT.zero )
THEN
210 result( 1 ) = ( ( resid /
REAL( MAX( 1, M ) ) ) / anorm ) / eps
217 CALL
slaset(
'Full', m, m, zero, one, r, lda )
218 CALL
ssyrk(
'Upper',
'Transpose', m, m, -one, q, lda, one, r,
223 resid =
slansy(
'1',
'Upper', m, r, lda, rwork )
225 result( 2 ) = ( resid /
REAL( MAX( 1, M ) ) ) / eps
subroutine sqrt01(M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
SQRT01
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function slamch(CMACH)
SLAMCH
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY 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 sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR