132 SUBROUTINE cstt21( N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RWORK,
141 INTEGER KBAND, LDU, N
144 REAL AD( * ), AE( * ), RESULT( 2 ), RWORK( * ),
146 COMPLEX U( ldu, * ), WORK( * )
153 parameter ( zero = 0.0e+0, one = 1.0e+0 )
155 parameter ( czero = ( 0.0e+0, 0.0e+0 ),
156 $ cone = ( 1.0e+0, 0.0e+0 ) )
160 REAL ANORM, TEMP1, TEMP2, ULP, UNFL, WNORM
163 REAL CLANGE, CLANHE, SLAMCH
164 EXTERNAL clange, clanhe, slamch
170 INTRINSIC abs, cmplx, max, min, real
181 unfl = slamch(
'Safe minimum' )
182 ulp = slamch(
'Precision' )
188 CALL claset(
'Full', n, n, czero, czero, work, n )
194 work( ( n+1 )*( j-1 )+1 ) = ad( j )
195 work( ( n+1 )*( j-1 )+2 ) = ae( j )
196 temp2 = abs( ae( j ) )
197 anorm = max( anorm, abs( ad( j ) )+temp1+temp2 )
201 work( n**2 ) = ad( n )
202 anorm = max( anorm, abs( ad( n ) )+temp1, unfl )
207 CALL cher(
'L', n, -sd( j ), u( 1, j ), 1, work, n )
210 IF( n.GT.1 .AND. kband.EQ.1 )
THEN
212 CALL cher2(
'L', n, -cmplx( se( j ) ), u( 1, j ), 1,
213 $ u( 1, j+1 ), 1, work, n )
217 wnorm = clanhe(
'1',
'L', n, work, n, rwork )
219 IF( anorm.GT.wnorm )
THEN
220 result( 1 ) = ( wnorm / anorm ) / ( n*ulp )
222 IF( anorm.LT.one )
THEN
223 result( 1 ) = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
225 result( 1 ) = min( wnorm / anorm,
REAL( N ) ) / ( N*ULP )
233 CALL cgemm(
'N',
'C', n, n, n, cone, u, ldu, u, ldu, czero, work,
237 work( ( n+1 )*( j-1 )+1 ) = work( ( n+1 )*( j-1 )+1 ) - cone
240 result( 2 ) = min(
REAL( N ), CLANGE(
'1', n, n, work, n,
241 $ rwork ) ) / ( n*ulp )
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
subroutine cher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CHER2
subroutine cstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RWORK, RESULT)
CSTT21
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM