126 SUBROUTINE zsyt01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
127 $ ldc, rwork, resid )
136 INTEGER LDA, LDAFAC, LDC, N
137 DOUBLE PRECISION RESID
141 COMPLEX*16 A( lda, * ), AFAC( ldafac, * ), C( ldc, * )
142 DOUBLE PRECISION RWORK( * )
148 DOUBLE PRECISION ZERO, ONE
149 parameter ( zero = 0.0d+0, one = 1.0d+0 )
150 COMPLEX*16 CZERO, CONE
151 parameter ( czero = 0.0e+0, cone = 1.0e+0 )
155 DOUBLE PRECISION ANORM, EPS
159 DOUBLE PRECISION DLAMCH, ZLANSY
160 EXTERNAL lsame, dlamch, zlansy
179 eps = dlamch(
'Epsilon' )
180 anorm = zlansy(
'1', uplo, n, a, lda, rwork )
184 CALL zlaset(
'Full', n, n, czero, czero, c, ldc )
185 CALL zlacpy(
'F', 1, n, afac( 1, 1 ), ldafac+1, c( 1, 1 ), ldc+1 )
187 IF( lsame( uplo,
'U' ) )
THEN
188 CALL zlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 1, 2 ),
190 CALL zlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 2, 1 ),
193 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
195 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
201 IF( lsame( uplo,
'U' ) )
THEN
202 CALL ztrmm(
'Left', uplo,
'Transpose',
'Unit', n-1, n,
203 $ cone, afac( 1, 2 ), ldafac, c( 2, 1 ), ldc )
205 CALL ztrmm(
'Left', uplo,
'No transpose',
'Unit', n-1, n,
206 $ cone, afac( 2, 1 ), ldafac, c( 2, 1 ), ldc )
211 IF( lsame( uplo,
'U' ) )
THEN
212 CALL ztrmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
213 $ cone, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
215 CALL ztrmm(
'Right', uplo,
'Transpose',
'Unit', n, n-1,
216 $ cone, afac( 2, 1 ), ldafac, c( 1, 2 ), ldc )
225 $
CALL zswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
230 $
CALL zswap( n, c( 1, j ), 1, c( 1, i ), 1 )
236 IF( lsame( uplo,
'U' ) )
THEN
239 c( i, j ) = c( i, j ) - a( i, j )
245 c( i, j ) = c( i, j ) - a( i, j )
252 resid = zlansy(
'1', uplo, n, c, ldc, rwork )
254 IF( anorm.LE.zero )
THEN
258 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine zlavsy(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVSY
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
subroutine zsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...