122 SUBROUTINE zhet01_aa( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C,
123 $ LDC, RWORK, RESID )
131 INTEGER LDA, LDAFAC, LDC, N
132 DOUBLE PRECISION RESID
136 DOUBLE PRECISION RWORK( * )
137 COMPLEX*16 A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * )
143 COMPLEX*16 CZERO, CONE
144 parameter( czero = ( 0.0d+0, 0.0d+0 ),
145 $ cone = ( 1.0d+0, 0.0d+0 ) )
146 DOUBLE PRECISION ZERO, ONE
147 parameter( zero = 0.0d+0, one = 1.0d+0 )
151 DOUBLE PRECISION ANORM, EPS
155 DOUBLE PRECISION DLAMCH, ZLANHE
156 EXTERNAL lsame, dlamch, zlanhe
175 eps = dlamch(
'Epsilon' )
176 anorm = zlanhe(
'1', uplo, n, a, lda, rwork )
180 CALL zlaset(
'Full', n, n, czero, czero, c, ldc )
181 CALL zlacpy(
'F', 1, n, afac( 1, 1 ), ldafac+1, c( 1, 1 ), ldc+1 )
183 IF( lsame( uplo,
'U' ) )
THEN
184 CALL zlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 1, 2 ),
186 CALL zlacpy(
'F', 1, n-1, afac( 1, 2 ), ldafac+1, c( 2, 1 ),
188 CALL zlacgv( n-1, c( 2, 1 ), ldc+1 )
190 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 1, 2 ),
192 CALL zlacpy(
'F', 1, n-1, afac( 2, 1 ), ldafac+1, c( 2, 1 ),
194 CALL zlacgv( n-1, c( 1, 2 ), ldc+1 )
199 IF( lsame( uplo,
'U' ) )
THEN
200 CALL ztrmm(
'Left', uplo,
'Conjugate transpose',
'Unit',
201 $ n-1, n, cone, afac( 1, 2 ), ldafac, c( 2, 1 ),
204 CALL ztrmm(
'Left', uplo,
'No transpose',
'Unit', n-1, n,
205 $ cone, afac( 2, 1 ), ldafac, c( 2, 1 ), ldc )
210 IF( lsame( uplo,
'U' ) )
THEN
211 CALL ztrmm(
'Right', uplo,
'No transpose',
'Unit', n, n-1,
212 $ cone, afac( 1, 2 ), ldafac, c( 1, 2 ), ldc )
214 CALL ztrmm(
'Right', uplo,
'Conjugate transpose',
'Unit', n,
215 $ n-1, cone, afac( 2, 1 ), ldafac, c( 1, 2 ),
224 $
CALL zswap( n, c( j, 1 ), ldc, c( i, 1 ), ldc )
229 $
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 = zlanhe(
'1', uplo, n, c, ldc, rwork )
254 IF( anorm.LE.zero )
THEN
258 resid = ( ( resid / dble( n ) ) / anorm ) / eps
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
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
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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.