155 SUBROUTINE dsyt22( ITYPE, UPLO, N, M, KBAND, A, LDA, D, E, U, LDU,
156 $ V, LDV, TAU, WORK, RESULT )
164 INTEGER ITYPE, KBAND, LDA, LDU, LDV, M, N
167 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), RESULT( 2 ),
168 $ tau( * ), u( ldu, * ), v( ldv, * ), work( * )
174 DOUBLE PRECISION ZERO, ONE
175 parameter( zero = 0.0d0, one = 1.0d0 )
178 INTEGER J, JJ, JJ1, JJ2, NN, NNP1
179 DOUBLE PRECISION ANORM, ULP, UNFL, WNORM
182 DOUBLE PRECISION DLAMCH, DLANSY
195 IF( n.LE.0 .OR. m.LE.0 )
198 unfl = dlamch(
'Safe minimum' )
199 ulp = dlamch(
'Precision' )
205 anorm =
max( dlansy(
'1', uplo, n, a, lda, work ), unfl )
211 CALL dsymm(
'L', uplo, n, m, one, a, lda, u, ldu, zero, work, n )
214 CALL dgemm( 't
', 'n
', M, M, N, ONE, U, LDU, WORK, N, ZERO,
217 JJ = NN + ( J-1 )*N + J
218 WORK( JJ ) = WORK( JJ ) - D( J )
220.EQ..AND..GT.
IF( KBAND1 N1 ) THEN
222 JJ1 = NN + ( J-1 )*N + J - 1
223 JJ2 = NN + ( J-2 )*N + J
224 WORK( JJ1 ) = WORK( JJ1 ) - E( J-1 )
225 WORK( JJ2 ) = WORK( JJ2 ) - E( J-1 )
228 WNORM = DLANSY( '1
', UPLO, M, WORK( NNP1 ), N, WORK( 1 ) )
230.GT.
IF( ANORMWNORM ) THEN
231 RESULT( 1 ) = ( WNORM / ANORM ) / ( M*ULP )
233.LT.
IF( ANORMONE ) THEN
234 RESULT( 1 ) = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*ULP )
236 RESULT( 1 ) = MIN( WNORM / ANORM, DBLE( M ) ) / ( M*ULP )
245 $ CALL DORT01( 'columns
', N, M, U, LDU, WORK, 2*N*N,
subroutine dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
DGEMM
subroutine dsymm(side, uplo, m, n, alpha, a, lda, b, ldb, beta, c, ldc)
DSYMM
subroutine dsyt22(itype, uplo, n, m, kband, a, lda, d, e, u, ldu, v, ldv, tau, work, result)
DSYT22
subroutine dort01(rowcol, m, n, u, ldu, work, lwork, resid)
DORT01