127 SUBROUTINE sstt21( N, KBAND, AD, AE, SD, SE, U, LDU, WORK,
136 INTEGER kband, ldu, n
139 REAL ad( * ), ae( * ), result( 2 ), sd( * ),
140 $ se( * ), u( ldu, * ), work( * )
147 parameter( zero = 0.0e0, one = 1.0e0 )
151 REAL anorm, temp1, temp2, ulp, unfl, wnorm
161 INTRINSIC abs, max, min, real
172 unfl =
slamch(
'Safe minimum' )
173 ulp =
slamch(
'Precision' )
179 CALL
slaset(
'Full', n, n, zero, zero, work, n )
185 work( ( n+1 )*(
j-1 )+1 ) = ad(
j )
186 work( ( n+1 )*(
j-1 )+2 ) = ae(
j )
187 temp2 = abs( ae(
j ) )
188 anorm = max( anorm, abs( ad(
j ) )+temp1+temp2 )
192 work( n**2 ) = ad( n )
193 anorm = max( anorm, abs( ad( n ) )+temp1, unfl )
198 CALL
ssyr(
'L', n, -sd(
j ), u( 1,
j ), 1, work, n )
201 IF( n.GT.1 .AND. kband.EQ.1 )
THEN
203 CALL
ssyr2(
'L', n, -se(
j ), u( 1,
j ), 1, u( 1,
j+1 ), 1,
208 wnorm =
slansy(
'1',
'L', n, work, n, work( n**2+1 ) )
210 IF( anorm.GT.wnorm )
THEN
211 result( 1 ) = ( wnorm / anorm ) / ( n*ulp )
213 IF( anorm.LT.one )
THEN
214 result( 1 ) = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
216 result( 1 ) = min( wnorm / anorm,
REAL( N ) ) / ( n*ulp )
224 CALL
sgemm(
'N',
'C', n, n, n, one, u, ldu, u, ldu, zero, work,
228 work( ( n+1 )*(
j-1 )+1 ) = work( ( n+1 )*(
j-1 )+1 ) - one
231 result( 2 ) = min(
REAL( N ),
slange(
'1', n, n, work, n,
232 $ work( n**2+1 ) ) ) / ( n*ulp )
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 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.
REAL function slamch(CMACH)
SLAMCH
subroutine sstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
SSTT21
subroutine ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SSYR2
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 sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR