143 COMPLEX a( lda, * ), work( * )
150 parameter( cone = ( 1.0e+0, 0.0e+0 ),
151 $ czero = ( 0.0e+0, 0.0e+0 ) )
156 COMPLEX 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(
'CSYTRI_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
ccopy( k-1, a( 1, k ), 1, work, 1 )
240 CALL
csymv( uplo, k-1, -cone, a, lda, work, 1, czero,
242 a( k, k ) = a( k, k ) -
cdotu( 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
ccopy( k-1, a( 1, k ), 1, work, 1 )
265 CALL
csymv( uplo, k-1, -cone, a, lda, work, 1, czero,
267 a( k, k ) = a( k, k ) -
cdotu( k-1, work, 1, a( 1, k ),
269 a( k, k+1 ) = a( k, k+1 ) -
270 $
cdotu( k-1, a( 1, k ), 1, a( 1, k+1 ), 1 )
271 CALL
ccopy( k-1, a( 1, k+1 ), 1, work, 1 )
272 CALL
csymv( uplo, k-1, -cone, a, lda, work, 1, czero,
274 a( k+1, k+1 ) = a( k+1, k+1 ) -
275 $
cdotu( k-1, work, 1, a( 1, k+1 ), 1 )
280 IF( kstep.EQ.1 )
THEN
288 $ CALL
cswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
289 CALL
cswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ), lda )
291 a( k, k ) = a( kp, kp )
302 $ CALL
cswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
303 CALL
cswap( 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
cswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
318 CALL
cswap( 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
ccopy( n-k, a( k+1, k ), 1, work, 1 )
356 CALL
csymv( 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 ) -
cdotu( 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
ccopy( n-k, a( k+1, k ), 1, work, 1 )
381 CALL
csymv( 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 ) -
cdotu( n-k, work, 1, a( k+1, k ),
385 a( k, k-1 ) = a( k, k-1 ) -
386 $
cdotu( n-k, a( k+1, k ), 1, a( k+1, k-1 ),
388 CALL
ccopy( n-k, a( k+1, k-1 ), 1, work, 1 )
389 CALL
csymv( 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 $
cdotu( n-k, work, 1, a( k+1, k-1 ), 1 )
397 IF( kstep.EQ.1 )
THEN
405 $ CALL
cswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
406 CALL
cswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
408 a( k, k ) = a( kp, kp )
419 $ CALL
cswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
420 CALL
cswap( 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
cswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ), 1 )
435 CALL
cswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ), lda )
437 a( k, k ) = a( kp, kp )
subroutine csymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CSYMV computes a matrix-vector product for a complex symmetric matrix.
complex function cdotu(N, CX, INCX, CY, INCY)
CDOTU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
logical function lsame(CA, CB)
LSAME
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK