138 COMPLEX*16 A( LDA, * ), WORK( * )
144 COMPLEX*16 CONE, CZERO
145 parameter( cone = ( 1.0d+0, 0.0d+0 ),
146 $ czero = ( 0.0d+0, 0.0d+0 ) )
151 COMPLEX*16 AK, AKKP1, AKP1, D, T, TEMP
156 EXTERNAL lsame, zdotu
169 upper = lsame( uplo,
'U' )
170 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
172 ELSE IF( n.LT.0 )
THEN
174 ELSE IF( lda.LT.max( 1, n ) )
THEN
178 CALL xerbla(
'ZSYTRI_ROOK', -info )
193 DO 10 info = n, 1, -1
194 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.czero )
202 IF( ipiv( info ).GT.0 .AND. a( info, info ).EQ.czero )
223 IF( ipiv( k ).GT.0 )
THEN
229 a( k, k ) = cone / a( k, k )
234 CALL zcopy( k-1, a( 1, k ), 1, work, 1 )
235 CALL zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
237 a( k, k ) = a( k, k ) - zdotu( k-1, work, 1, a( 1,
250 akp1 = a( k+1, k+1 ) / t
251 akkp1 = a( k, k+1 ) / t
252 d = t*( ak*akp1-cone )
254 a( k+1, k+1 ) = ak / d
255 a( k, k+1 ) = -akkp1 / d
260 CALL zcopy( k-1, a( 1, k ), 1, work, 1 )
261 CALL zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
263 a( k, k ) = a( k, k ) - zdotu( k-1, work, 1, a( 1,
266 a( k, k+1 ) = a( k, k+1 ) -
267 $ zdotu( k-1, a( 1, k ), 1, a( 1, k+1 ),
269 CALL zcopy( k-1, a( 1, k+1 ), 1, work, 1 )
270 CALL zsymv( uplo, k-1, -cone, a, lda, work, 1, czero,
272 a( k+1, k+1 ) = a( k+1, k+1 ) -
273 $ zdotu( k-1, work, 1, a( 1, k+1 ), 1 )
278 IF( kstep.EQ.1 )
THEN
286 $
CALL zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
287 CALL zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ),
290 a( k, k ) = a( kp, kp )
301 $
CALL zswap( kp-1, a( 1, k ), 1, a( 1, kp ), 1 )
302 CALL zswap( k-kp-1, a( kp+1, k ), 1, a( kp, kp+1 ),
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 ),
321 a( k, k ) = a( kp, kp )
345 IF( ipiv( k ).GT.0 )
THEN
351 a( k, k ) = cone / a( k, k )
356 CALL zcopy( n-k, a( k+1, k ), 1, work, 1 )
357 CALL zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work,
359 $ czero, a( k+1, k ), 1 )
360 a( k, k ) = a( k, k ) - zdotu( n-k, work, 1, a( k+1,
372 ak = a( k-1, k-1 ) / t
374 akkp1 = a( k, k-1 ) / t
375 d = t*( ak*akp1-cone )
376 a( k-1, k-1 ) = akp1 / d
378 a( k, k-1 ) = -akkp1 / d
383 CALL zcopy( n-k, a( k+1, k ), 1, work, 1 )
384 CALL zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work,
386 $ czero, a( k+1, k ), 1 )
387 a( k, k ) = a( k, k ) - zdotu( n-k, work, 1, a( k+1,
390 a( k, k-1 ) = a( k, k-1 ) -
391 $ zdotu( n-k, a( k+1, k ), 1, a( k+1,
394 CALL zcopy( n-k, a( k+1, k-1 ), 1, work, 1 )
395 CALL zsymv( uplo, n-k,-cone, a( k+1, k+1 ), lda, work,
397 $ czero, a( k+1, k-1 ), 1 )
398 a( k-1, k-1 ) = a( k-1, k-1 ) -
399 $ zdotu( n-k, work, 1, a( k+1, k-1 ),
405 IF( kstep.EQ.1 )
THEN
413 $
CALL zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ),
415 CALL zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ),
418 a( k, k ) = a( kp, kp )
429 $
CALL zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ),
431 CALL zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ),
435 a( k, k ) = a( kp, kp )
438 a( k, k-1 ) = a( kp, k-1 )
446 $
CALL zswap( n-kp, a( kp+1, k ), 1, a( kp+1, kp ),
448 CALL zswap( kp-k-1, a( k+1, k ), 1, a( kp, k+1 ),
451 a( k, k ) = a( kp, kp )