122 SUBROUTINE ssyt01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
123 $ LDC, RWORK, RESID )
131 INTEGER LDA, LDAFAC, LDC, N
136 REAL A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
144 parameter( zero = 0.0e+0, one = 1.0e+0 )
153 EXTERNAL lsame, slamch, slansy
172 eps = slamch(
'Epsilon' )
173 anorm = slansy(
'1', uplo, n, a, lda, rwork )
177 CALL slaset(
'Full', n, n, zero, zero, c, ldc )
178 CALL slacpy(
'F', 1, n, afac( 1, 1 ), ldafac+1, c( 1, 1 ), ldc+1 )
180 IF( lsame( uplo,
'U' ) )
THEN
181 CALL slacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 1, 2 ),
183 CALL slacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 2, 1 ),
186 CALL slacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
188 CALL slacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
194 IF( lsame( uplo,
'U' ) )
THEN
195 CALL strmm(
'Left', uplo,
'Transpose',
'Unit', n-1, n,
196 $ one, afac( 1, 2 ), ldafac, c( 2, 1 ), ldc )
198 CALL strmm(
'Left', uplo,
'No transpose',
'Unit', n-1, n,
199 $ one, afac( 2, 1 ), ldafac, c( 2, 1 ), ldc )
204 IF( lsame( uplo,
'U' ) )
THEN
205 CALL strmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
206 $ one, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
208 CALL strmm(
'Right', uplo,
'Transpose',
'Unit', n, n-1,
209 $ one, afac( 2, 1 ), ldafac, c( 1, 2 ), ldc )
218 $
CALL sswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
223 $
CALL sswap( n, c( 1, j ), 1, c( 1, i ), 1 )
229 IF( lsame( uplo,
'U' ) )
THEN
232 c( i, j ) = c( i, j ) - a( i, j )
238 c( i, j ) = c( i, j ) - a( i, j )
245 resid = slansy(
'1', uplo, n, c, ldc, rwork )
247 IF( anorm.LE.zero )
THEN
251 resid = ( ( resid / real( n ) ) / anorm ) / eps