126 SUBROUTINE dsyt01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
127 $ ldc, rwork, resid )
136 INTEGER LDA, LDAFAC, LDC, N
137 DOUBLE PRECISION RESID
141 DOUBLE PRECISION A( lda, * ), AFAC( ldafac, * ), C( ldc, * ),
148 DOUBLE PRECISION ZERO, ONE
149 parameter ( zero = 0.0d+0, one = 1.0d+0 )
153 DOUBLE PRECISION ANORM, EPS
157 DOUBLE PRECISION DLAMCH, DLANSY
158 EXTERNAL lsame, dlamch, dlansy
177 eps = dlamch(
'Epsilon' )
178 anorm = dlansy(
'1', uplo, n, a, lda, rwork )
182 CALL dlaset(
'Full', n, n, zero, zero, c, ldc )
183 CALL dlacpy(
'F', 1, n, afac( 1, 1 ), ldafac+1, c( 1, 1 ), ldc+1 )
185 IF( lsame( uplo,
'U' ) )
THEN
186 CALL dlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 1, 2 ),
188 CALL dlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 2, 1 ),
191 CALL dlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
193 CALL dlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
199 IF( lsame( uplo,
'U' ) )
THEN
200 CALL dtrmm(
'Left', uplo,
'Transpose',
'Unit', n-1, n,
201 $ one, afac( 1, 2 ), ldafac, c( 2, 1 ), ldc )
203 CALL dtrmm(
'Left', uplo,
'No transpose',
'Unit', n-1, n,
204 $ one, afac( 2, 1 ), ldafac, c( 2, 1 ), ldc )
209 IF( lsame( uplo,
'U' ) )
THEN
210 CALL dtrmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
211 $ one, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
213 CALL dtrmm(
'Right', uplo,
'Transpose',
'Unit', n, n-1,
214 $ one, afac( 2, 1 ), ldafac, c( 1, 2 ), ldc )
223 $
CALL dswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
228 $
CALL dswap( n, c( 1, j ), 1, c( 1, i ), 1 )
234 IF( lsame( uplo,
'U' ) )
THEN
237 c( i, j ) = c( i, j ) - a( i, j )
243 c( i, j ) = c( i, j ) - a( i, j )
250 resid = dlansy(
'1', uplo, n, c, ldc, rwork )
252 IF( anorm.LE.zero )
THEN
256 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 dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
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 dsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
subroutine dlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DLAVSY