141 SUBROUTINE zhet01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
142 $ ldc, rwork, resid )
151 INTEGER LDA, LDAFAC, LDC, N
152 DOUBLE PRECISION RESID
156 DOUBLE PRECISION RWORK( * )
157 COMPLEX*16 A( lda, * ), AFAC( ldafac, * ), C( ldc, * ),
164 DOUBLE PRECISION ZERO, ONE
165 parameter ( zero = 0.0d+0, one = 1.0d+0 )
166 COMPLEX*16 CZERO, CONE
167 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
168 $ cone = ( 1.0d+0, 0.0d+0 ) )
172 DOUBLE PRECISION ANORM, EPS
176 DOUBLE PRECISION ZLANHE, DLAMCH
177 EXTERNAL lsame, zlanhe, dlamch
183 INTRINSIC dimag, dble
196 CALL zsyconvf_rook( uplo,
'R', n, afac, ldafac, e, ipiv, info )
200 eps = dlamch(
'Epsilon' )
201 anorm = zlanhe(
'1', uplo, n, a, lda, rwork )
207 IF( dimag( afac( j, j ) ).NE.zero )
THEN
215 CALL zlaset(
'Full', n, n, czero, cone, c, ldc )
219 CALL zlavhe_rook( uplo,
'Conjugate',
'Non-unit', n, n, afac,
220 $ ldafac, ipiv, c, ldc, info )
224 CALL zlavhe_rook( uplo,
'No transpose',
'Unit', n, n, afac,
225 $ ldafac, ipiv, c, ldc, info )
229 IF( lsame( uplo,
'U' ) )
THEN
232 c( i, j ) = c( i, j ) - a( i, j )
234 c( j, j ) = c( j, j ) - dble( a( j, j ) )
238 c( j, j ) = c( j, j ) - dble( a( j, j ) )
240 c( i, j ) = c( i, j ) - a( i, j )
247 resid = zlanhe(
'1', uplo, n, c, ldc, rwork )
249 IF( anorm.LE.zero )
THEN
253 resid = ( ( resid/dble( n ) )/anorm ) / eps
258 CALL zsyconvf_rook( uplo,
'C', n, afac, ldafac, e, ipiv, info )
subroutine zhet01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
ZHET01_3
subroutine zsyconvf_rook(UPLO, WAY, N, A, LDA, E, IPIV, INFO)
ZSYCONVF_ROOK
subroutine zlavhe_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZLAVHE_ROOK
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...