126 SUBROUTINE zqlt01( M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK,
135 INTEGER LDA, LWORK, M, N
138 DOUBLE PRECISION RESULT( * ), RWORK( * )
139 COMPLEX*16 A( lda, * ), AF( lda, * ), L( lda, * ),
140 $ q( lda, * ), tau( * ), work( lwork )
146 DOUBLE PRECISION ZERO, ONE
147 parameter ( zero = 0.0d+0, one = 1.0d+0 )
149 parameter ( rogue = ( -1.0d+10, -1.0d+10 ) )
153 DOUBLE PRECISION ANORM, EPS, RESID
156 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY
157 EXTERNAL dlamch, zlange, zlansy
163 INTRINSIC dble, dcmplx, max, min
169 COMMON / srnamc / srnamt
174 eps = dlamch(
'Epsilon' )
178 CALL zlacpy(
'Full', m, n, a, lda, af, lda )
183 CALL zgeqlf( m, n, af, lda, tau, work, lwork, info )
187 CALL zlaset(
'Full', m, m, rogue, rogue, q, lda )
189 IF( n.LT.m .AND. n.GT.0 )
190 $
CALL zlacpy(
'Full', m-n, n, af, lda, q( 1, m-n+1 ), lda )
192 $
CALL zlacpy(
'Upper', n-1, n-1, af( m-n+1, 2 ), lda,
193 $ q( m-n+1, m-n+2 ), lda )
196 $
CALL zlacpy(
'Upper', m-1, m-1, af( 1, n-m+2 ), lda,
203 CALL zungql( m, m, minmn, q, lda, tau, work, lwork, info )
207 CALL zlaset(
'Full', m, n, dcmplx( zero ), dcmplx( zero ), l,
211 $
CALL zlacpy(
'Lower', n, n, af( m-n+1, 1 ), lda,
212 $ l( m-n+1, 1 ), lda )
214 IF( n.GT.m .AND. m.GT.0 )
215 $
CALL zlacpy(
'Full', m, n-m, af, lda, l, lda )
217 $
CALL zlacpy(
'Lower', m, m, af( 1, n-m+1 ), lda,
218 $ l( 1, n-m+1 ), lda )
223 CALL zgemm(
'Conjugate transpose',
'No transpose', m, n, m,
224 $ dcmplx( -one ), q, lda, a, lda, dcmplx( one ), l,
229 anorm = zlange(
'1', m, n, a, lda, rwork )
230 resid = zlange(
'1', m, n, l, lda, rwork )
231 IF( anorm.GT.zero )
THEN
232 result( 1 ) = ( ( resid / dble( max( 1, m ) ) ) / anorm ) / eps
239 CALL zlaset(
'Full', m, m, dcmplx( zero ), dcmplx( one ), l, lda )
240 CALL zherk(
'Upper',
'Conjugate transpose', m, m, -one, q, lda,
245 resid = zlansy(
'1',
'Upper', m, l, lda, rwork )
247 result( 2 ) = ( resid / dble( max( 1, m ) ) ) / eps
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZQLT01
subroutine zungql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQL
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
subroutine zgeqlf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
ZGEQLF