141 SUBROUTINE chet01_3( UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C,
142 $ ldc, rwork, resid )
151 INTEGER LDA, LDAFAC, LDC, N
157 COMPLEX A( lda, * ), AFAC( ldafac, * ), C( ldc, * ),
165 parameter ( zero = 0.0e+0, one = 1.0e+0 )
167 parameter ( czero = ( 0.0e+0, 0.0e+0 ),
168 $ cone = ( 1.0e+0, 0.0e+0 ) )
177 EXTERNAL lsame, clanhe, slamch
183 INTRINSIC aimag, real
196 CALL csyconvf_rook( uplo,
'R', n, afac, ldafac, e, ipiv, info )
200 eps = slamch(
'Epsilon' )
201 anorm = clanhe(
'1', uplo, n, a, lda, rwork )
207 IF( aimag( afac( j, j ) ).NE.zero )
THEN
215 CALL claset(
'Full', n, n, czero, cone, c, ldc )
219 CALL clavhe_rook( uplo,
'Conjugate',
'Non-unit', n, n, afac,
220 $ ldafac, ipiv, c, ldc, info )
224 CALL clavhe_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 ) -
REAL( A( J, J ) )
238 c( j, j ) = c( j, j ) -
REAL( A( J, J ) )
240 c( i, j ) = c( i, j ) - a( i, j )
247 resid = clanhe(
'1', uplo, n, c, ldc, rwork )
249 IF( anorm.LE.zero )
THEN
253 resid = ( ( resid/
REAL( N ) )/anorm ) / eps
258 CALL csyconvf_rook( uplo,
'C', n, afac, ldafac, e, ipiv, info )
subroutine csyconvf_rook(UPLO, WAY, N, A, LDA, E, IPIV, INFO)
CSYCONVF_ROOK
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine chet01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
CHET01_3
subroutine clavhe_rook(UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CLAVHE_ROOK