125 SUBROUTINE zhet01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
126 $ ldc, rwork, resid )
135 INTEGER LDA, LDAFAC, LDC, N
136 DOUBLE PRECISION RESID
140 DOUBLE PRECISION RWORK( * )
141 COMPLEX*16 A( lda, * ), AFAC( ldafac, * ), C( ldc, * )
147 COMPLEX*16 CZERO, CONE
148 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
149 $ cone = ( 1.0d+0, 0.0d+0 ) )
150 DOUBLE PRECISION ZERO, ONE
151 parameter ( zero = 0.0d+0, one = 1.0d+0 )
155 DOUBLE PRECISION ANORM, EPS
159 DOUBLE PRECISION DLAMCH, ZLANHE
160 EXTERNAL lsame, dlamch, zlanhe
179 eps = dlamch(
'Epsilon' )
180 anorm = zlanhe(
'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 ),
192 CALL zlacgv( n-1, c( 2, 1 ), ldc+1 )
194 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
196 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
198 CALL zlacgv( n-1, c( 1, 2 ), ldc+1 )
203 IF( lsame( uplo,
'U' ) )
THEN
204 CALL ztrmm(
'Left', uplo,
'Conjugate transpose',
'Unit',
205 $ n-1, n, cone, afac( 1, 2 ), ldafac, c( 2, 1 ),
208 CALL ztrmm(
'Left', uplo,
'No transpose',
'Unit', n-1, n,
209 $ cone, afac( 2, 1 ), ldafac, c( 2, 1 ), ldc )
214 IF( lsame( uplo,
'U' ) )
THEN
215 CALL ztrmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
216 $ cone, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
218 CALL ztrmm(
'Right', uplo,
'Conjugate transpose',
'Unit', n,
219 $ n-1, cone, afac( 2, 1 ), ldafac, c( 1, 2 ),
228 $
CALL zswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
233 $
CALL zswap( n, c( 1, j ), 1, c( 1, i ), 1 )
240 IF( lsame( uplo,
'U' ) )
THEN
243 c( i, j ) = c( i, j ) - a( i, j )
249 c( i, j ) = c( i, j ) - a( i, j )
256 resid = zlanhe(
'1', uplo, n, c, ldc, rwork )
258 IF( anorm.LE.zero )
THEN
262 resid = ( ( resid / dble( n ) ) / anorm ) / eps
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 zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zlavhe(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVHE
subroutine zhet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_AA