122 SUBROUTINE dsyt01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
123 $ LDC, RWORK, RESID )
131 INTEGER LDA, LDAFAC, LDC, N
132 DOUBLE PRECISION RESID
136 DOUBLE PRECISION A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ),
143 DOUBLE PRECISION ZERO, ONE
144 parameter( zero = 0.0d+0, one = 1.0d+0 )
148 DOUBLE PRECISION ANORM, EPS
152 DOUBLE PRECISION DLAMCH, DLANSY
153 EXTERNAL lsame, dlamch, dlansy
172 eps = dlamch(
'Epsilon' )
173 anorm = dlansy(
'1', uplo, n, a, lda, rwork )
177 CALL dlaset(
'Full', n, n, zero, zero, c, ldc )
178 CALL dlacpy(
'F', 1, n, afac( 1, 1 ), ldafac+1, c( 1, 1 ), ldc+1 )
180 IF( lsame( uplo,
'U' ) )
THEN
181 CALL dlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 1, 2 ),
183 CALL dlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 2, 1 ),
186 CALL dlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
188 CALL dlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
194 IF( lsame( uplo,
'U' ) )
THEN
195 CALL dtrmm(
'Left', uplo,
'Transpose',
'Unit', n-1, n,
196 $ one, afac( 1, 2 ), ldafac, c( 2, 1 ), ldc )
198 CALL dtrmm(
'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 dtrmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
206 $ one, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
208 CALL dtrmm(
'Right', uplo,
'Transpose',
'Unit', n, n-1,
209 $ one, afac( 2, 1 ), ldafac, c( 1, 2 ), ldc )
218 $
CALL dswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
223 $
CALL dswap( 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 = dlansy(
'1', uplo, n, c, ldc, rwork )
247 IF( anorm.LE.zero )
THEN
251 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
subroutine dlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DLAVSY
subroutine dsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01