192 SUBROUTINE csytf2( UPLO, N, A, LDA, IPIV, INFO )
212 parameter ( zero = 0.0e+0, one = 1.0e+0 )
214 parameter ( eight = 8.0e+0, sevten = 17.0e+0 )
216 parameter ( cone = ( 1.0e+0, 0.0e+0 ) )
220 INTEGER I, IMAX, J, JMAX, K, KK, KP, KSTEP
221 REAL ABSAKK, ALPHA, COLMAX, ROWMAX
222 COMPLEX D11, D12, D21, D22, R1, T, WK, WKM1, WKP1, Z
225 LOGICAL LSAME, SISNAN
227 EXTERNAL lsame, icamax, sisnan
233 INTRINSIC abs, aimag, max,
REAL, SQRT
239 cabs1( z ) = abs(
REAL( Z ) ) + abs( AIMAG( 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(
'CSYTF2', -info )
261 alpha = ( one+sqrt( sevten ) ) / eight
282 absakk = cabs1( a( k, k ) )
289 imax = icamax( k-1, a( 1, k ), 1 )
290 colmax = cabs1( a( imax, k ) )
295 IF( max( absakk, colmax ).EQ.zero .OR. sisnan(absakk) )
THEN
304 IF( absakk.GE.alpha*colmax )
THEN
314 jmax = imax + icamax( k-imax, a( imax, imax+1 ), lda )
315 rowmax = cabs1( a( imax, jmax ) )
317 jmax = icamax( 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 cswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
349 CALL cswap( 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 csyr( uplo, k-1, -r1, a( 1, k ), 1, a, lda )
380 CALL cscal( 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 + icamax( n-k, a( k+1, k ), 1 )
460 colmax = cabs1( a( imax, k ) )
465 IF( max( absakk, colmax ).EQ.zero .OR. sisnan(absakk) )
THEN
474 IF( absakk.GE.alpha*colmax )
THEN
484 jmax = k - 1 + icamax( imax-k, a( imax, k ), lda )
485 rowmax = cabs1( a( imax, jmax ) )
487 jmax = imax + icamax( 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 cswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
520 CALL cswap( 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 csyr( uplo, n-k, -r1, a( k+1, k ), 1,
550 $ a( k+1, k+1 ), lda )
554 CALL cscal( 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 csyr(UPLO, N, ALPHA, X, INCX, A, LDA)
CSYR performs the symmetric rank-1 update of a complex symmetric matrix.
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine csytf2(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...