143 COMPLEX*16 a( lda, * ), work( * )
149 COMPLEX*16 cone, czero
150 parameter( cone = ( 1.0d+0, 0.0d+0 ),
151 $ czero = ( 0.0d+0, 0.0d+0 ) )
156 COMPLEX*16 ak, akkp1, akp1, d, t, temp
174 upper =
lsame( uplo,
'U' )
175 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
177 ELSE IF( n.LT.0 )
THEN
179 ELSE IF( lda.LT.max( 1, n ) )
THEN
183 CALL
xerbla(
'ZSYTRI_ROOK', -info )
198 DO 10 info = n, 1, -1
199 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.czero )
207 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.czero )
228 IF( ipiv( k ).GT.0 )
THEN
234 a( k, k ) = cone / a( k, k )
239 CALL
zcopy( k-1, a( 1, k ), 1, work, 1 )
240 CALL
zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
242 a( k, k ) = a( k, k ) -
zdotu( k-1, work, 1, a( 1, k ),
254 akp1 = a( k+1, k+1 ) / t
255 akkp1 = a( k, k+1 ) / t
256 d = t*( ak*akp1-cone )
258 a( k+1, k+1 ) = ak / d
259 a( k, k+1 ) = -akkp1 / d
264 CALL
zcopy( k-1, a( 1, k ), 1, work, 1 )
265 CALL
zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
267 a( k, k ) = a( k, k ) -
zdotu( k-1, work, 1, a( 1, k ),
269 a( k, k+1 ) = a( k, k+1 ) -
270 $
zdotu( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
271 CALL
zcopy( k-1, a( 1, k+1 ), 1, work, 1 )
272 CALL
zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
274 a( k+1, k+1 ) = a( k+1, k+1 ) -
275 $
zdotu( k-1, work, 1, a( 1, k+1 ), 1 )
280 IF( kstep.EQ.1 )
THEN
288 $ CALL
zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
289 CALL
zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
291 a( k, k ) = a( kp, kp )
302 $ CALL
zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
303 CALL
zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
306 a( k, k ) = a( kp, kp )
309 a( k, k+1 ) = a( kp, k+1 )
317 $ CALL
zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
318 CALL
zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
320 a( k, k ) = a( kp, kp )
344 IF( ipiv( k ).GT.0 )
THEN
350 a( k, k ) = cone / a( k, k )
355 CALL
zcopy( n-k, a( k+1, k ), 1, work, 1 )
356 CALL
zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work, 1,
357 $ czero, a( k+1, k ), 1 )
358 a( k, k ) = a( k, k ) -
zdotu( n-k, work, 1, a( k+1, k ),
369 ak = a( k-1, k-1 ) / t
371 akkp1 = a( k, k-1 ) / t
372 d = t*( ak*akp1-cone )
373 a( k-1, k-1 ) = akp1 / d
375 a( k, k-1 ) = -akkp1 / d
380 CALL
zcopy( n-k, a( k+1, k ), 1, work, 1 )
381 CALL
zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work, 1,
382 $ czero, a( k+1, k ), 1 )
383 a( k, k ) = a( k, k ) -
zdotu( n-k, work, 1, a( k+1, k ),
385 a( k, k-1 ) = a( k, k-1 ) -
386 $
zdotu( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
388 CALL
zcopy( n-k, a( k+1, k-1 ), 1, work, 1 )
389 CALL
zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work, 1,
390 $ czero, a( k+1, k-1 ), 1 )
391 a( k-1, k-1 ) = a( k-1, k-1 ) -
392 $
zdotu( n-k, work, 1, a( k+1, k-1 ), 1 )
397 IF( kstep.EQ.1 )
THEN
405 $ CALL
zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
406 CALL
zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
408 a( k, k ) = a( kp, kp )
419 $ CALL
zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
420 CALL
zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
423 a( k, k ) = a( kp, kp )
426 a( k, k-1 ) = a( kp, k-1 )
434 $ CALL
zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
435 CALL
zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
437 a( k, k ) = a( kp, kp )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
LOGICAL function lsame(CA, CB)
LSAME
COMPLEX *16 function zdotu(N, ZX, INCX, ZY, INCY)
ZDOTU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine zsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI_ROOK