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
183 EXTERNAL dlamch, dlansy
189 INTRINSIC dble, max, min
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 IF( kband.EQ.1 .AND. n.GT.1 )
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 IF( anorm.GT.wnorm )
THEN
231 result( 1 ) = ( wnorm / anorm ) / ( m*ulp )
233 IF( anorm.LT.one )
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 dort01(rowcol, m, n, u, ldu, work, lwork, resid)
DORT01
subroutine dsyt22(itype, uplo, n, m, kband, a, lda, d, e, u, ldu, v, ldv, tau, work, result)
DSYT22
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