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 )