192 SUBROUTINE zsytf2( UPLO, N, A, LDA, IPIV, INFO )
205 COMPLEX*16 A( lda, * )
211 DOUBLE PRECISION ZERO, ONE
212 parameter ( zero = 0.0d+0, one = 1.0d+0 )
213 DOUBLE PRECISION EIGHT, SEVTEN
214 parameter ( eight = 8.0d+0, sevten = 17.0d+0 )
216 parameter ( cone = ( 1.0d+0, 0.0d+0 ) )
220 INTEGER I, IMAX, J, JMAX, K, KK, KP, KSTEP
221 DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, ROWMAX
222 COMPLEX*16 D11, D12, D21, D22, R1, T, WK, WKM1, WKP1, Z
225 LOGICAL DISNAN, LSAME
227 EXTERNAL disnan, lsame, izamax
233 INTRINSIC abs, dble, dimag, max, sqrt
236 DOUBLE PRECISION CABS1
239 cabs1( z ) = abs( dble( z ) ) + abs( dimag( z ) )
246 upper = lsame( uplo,
'U' )
247 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
249 ELSE IF( n.LT.0 )
THEN
251 ELSE IF( lda.LT.max( 1, n ) )
THEN
255 CALL xerbla(
'ZSYTF2', -info )
261 alpha = ( one+sqrt( sevten ) ) / eight
282 absakk = cabs1( a( k, k ) )
289 imax = izamax( k-1, a( 1, k ), 1 )
290 colmax = cabs1( a( imax, k ) )
295 IF( max( absakk, colmax ).EQ.zero .OR. disnan(absakk) )
THEN
304 IF( absakk.GE.alpha*colmax )
THEN
314 jmax = imax + izamax( k-imax, a( imax, imax+1 ), lda )
315 rowmax = cabs1( a( imax, jmax ) )
317 jmax = izamax( imax-1, a( 1, imax ), 1 )
318 rowmax = max( rowmax, cabs1( a( jmax, imax ) ) )
321 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
326 ELSE IF( cabs1( a( imax, imax ) ).GE.alpha*rowmax )
THEN
348 CALL zswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
349 CALL zswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
352 a( kk, kk ) = a( kp, kp )
354 IF( kstep.EQ.2 )
THEN
356 a( k-1, k ) = a( kp, k )
363 IF( kstep.EQ.1 )
THEN
375 r1 = cone / a( k, k )
376 CALL zsyr( uplo, k-1, -r1, a( 1, k ), 1, a, lda )
380 CALL zscal( k-1, r1, a( 1, k ), 1 )
398 d22 = a( k-1, k-1 ) / d12
399 d11 = a( k, k ) / d12
400 t = cone / ( d11*d22-cone )
403 DO 30 j = k - 2, 1, -1
404 wkm1 = d12*( d11*a( j, k-1 )-a( j, k ) )
405 wk = d12*( d22*a( j, k )-a( j, k-1 ) )
407 a( i, j ) = a( i, j ) - a( i, k )*wk -
421 IF( kstep.EQ.1 )
THEN
452 absakk = cabs1( a( k, k ) )
459 imax = k + izamax( n-k, a( k+1, k ), 1 )
460 colmax = cabs1( a( imax, k ) )
465 IF( max( absakk, colmax ).EQ.zero .OR. disnan(absakk) )
THEN
474 IF( absakk.GE.alpha*colmax )
THEN
484 jmax = k - 1 + izamax( imax-k, a( imax, k ), lda )
485 rowmax = cabs1( a( imax, jmax ) )
487 jmax = imax + izamax( n-imax, a( imax+1, imax ), 1 )
488 rowmax = max( rowmax, cabs1( a( jmax, imax ) ) )
491 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
496 ELSE IF( cabs1( a( imax, imax ) ).GE.alpha*rowmax )
THEN
519 $
CALL zswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
520 CALL zswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
523 a( kk, kk ) = a( kp, kp )
525 IF( kstep.EQ.2 )
THEN
527 a( k+1, k ) = a( kp, k )
534 IF( kstep.EQ.1 )
THEN
548 r1 = cone / a( k, k )
549 CALL zsyr( uplo, n-k, -r1, a( k+1, k ), 1,
550 $ a( k+1, k+1 ), lda )
554 CALL zscal( n-k, r1, a( k+1, k ), 1 )
571 d11 = a( k+1, k+1 ) / d21
572 d22 = a( k, k ) / d21
573 t = cone / ( d11*d22-cone )
577 wk = d21*( d11*a( j, k )-a( j, k+1 ) )
578 wkp1 = d21*( d22*a( j, k+1 )-a( j, k ) )
580 a( i, j ) = a( i, j ) - a( i, k )*wk -
592 IF( kstep.EQ.1 )
THEN
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
ZSYR performs the symmetric rank-1 update of a complex symmetric matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zsytf2(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL