242 SUBROUTINE csytf2_rk( UPLO, N, A, LDA, E, IPIV, INFO )
255 COMPLEX A( lda, * ), E( * )
262 parameter ( zero = 0.0e+0, one = 1.0e+0 )
264 parameter ( eight = 8.0e+0, sevten = 17.0e+0 )
266 parameter ( cone = ( 1.0e+0, 0.0e+0 ),
267 $ czero = ( 0.0e+0, 0.0e+0 ) )
271 INTEGER I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
273 REAL ABSAKK, ALPHA, COLMAX, ROWMAX, STEMP, SFMIN
274 COMPLEX D11, D12, D21, D22, T, WK, WKM1, WKP1, Z
280 EXTERNAL lsame, icamax, slamch
286 INTRINSIC abs, max, sqrt, aimag, real
292 cabs1( z ) = abs(
REAL( Z ) ) + abs( AIMAG( z ) )
299 upper = lsame( uplo,
'U' )
300 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
302 ELSE IF( n.LT.0 )
THEN
304 ELSE IF( lda.LT.max( 1, n ) )
THEN
308 CALL xerbla(
'CSYTF2_RK', -info )
314 alpha = ( one+sqrt( sevten ) ) / eight
318 sfmin = slamch(
'S' )
345 absakk = cabs1( a( k, k ) )
352 imax = icamax( k-1, a( 1, k ), 1 )
353 colmax = cabs1( a( imax, k ) )
358 IF( (max( absakk, colmax ).EQ.zero) )
THEN
378 IF( .NOT.( absakk.LT.alpha*colmax ) )
THEN
399 jmax = imax + icamax( k-imax, a( imax, imax+1 ),
401 rowmax = cabs1( a( imax, jmax ) )
407 itemp = icamax( imax-1, a( 1, imax ), 1 )
408 stemp = cabs1( a( itemp, imax ) )
409 IF( stemp.GT.rowmax )
THEN
418 IF( .NOT.( cabs1( a( imax, imax ) ).LT.alpha*rowmax ))
430 ELSE IF( ( p.EQ.jmax ).OR.( rowmax.LE.colmax ) )
THEN
449 IF( .NOT. done )
GOTO 12
457 IF( ( kstep.EQ.2 ) .AND. ( p.NE.k ) )
THEN
463 $
CALL cswap( p-1, a( 1, k ), 1, a( 1, p ), 1 )
465 $
CALL cswap( k-p-1, a( p+1, k ), 1, a( p, p+1 ),
468 a( k, k ) = a( p, p )
475 $
CALL cswap( n-k, a( k, k+1 ), lda, a( p, k+1 ), lda )
488 $
CALL cswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
489 IF( ( kk.GT.1 ) .AND. ( kp.LT.(kk-1) ) )
490 $
CALL cswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
493 a( kk, kk ) = a( kp, kp )
495 IF( kstep.EQ.2 )
THEN
497 a( k-1, k ) = a( kp, k )
505 $
CALL cswap( n-k, a( kk, k+1 ), lda, a( kp, k+1 ),
512 IF( kstep.EQ.1 )
THEN
525 IF( cabs1( a( k, k ) ).GE.sfmin )
THEN
531 d11 = cone / a( k, k )
532 CALL csyr( uplo, k-1, -d11, a( 1, k ), 1, a, lda )
536 CALL cscal( k-1, d11, a( 1, k ), 1 )
543 a( ii, k ) = a( ii, k ) / d11
551 CALL csyr( uplo, k-1, -d11, a( 1, k ), 1, a, lda )
579 d22 = a( k-1, k-1 ) / d12
580 d11 = a( k, k ) / d12
581 t = cone / ( d11*d22-cone )
583 DO 30 j = k - 2, 1, -1
585 wkm1 = t*( d11*a( j, k-1 )-a( j, k ) )
586 wk = t*( d22*a( j, k )-a( j, k-1 ) )
589 a( i, j ) = a( i, j ) - (a( i, k ) / d12 )*wk -
590 $ ( a( i, k-1 ) / d12 )*wkm1
596 a( j, k-1 ) = wkm1 / d12
617 IF( kstep.EQ.1 )
THEN
655 absakk = cabs1( a( k, k ) )
662 imax = k + icamax( n-k, a( k+1, k ), 1 )
663 colmax = cabs1( a( imax, k ) )
668 IF( ( max( absakk, colmax ).EQ.zero ) )
THEN
688 IF( .NOT.( absakk.LT.alpha*colmax ) )
THEN
709 jmax = k - 1 + icamax( imax-k, a( imax, k ), lda )
710 rowmax = cabs1( a( imax, jmax ) )
716 itemp = imax + icamax( n-imax, a( imax+1, imax ),
718 stemp = cabs1( a( itemp, imax ) )
719 IF( stemp.GT.rowmax )
THEN
728 IF( .NOT.( cabs1( a( imax, imax ) ).LT.alpha*rowmax ))
740 ELSE IF( ( p.EQ.jmax ).OR.( rowmax.LE.colmax ) )
THEN
759 IF( .NOT. done )
GOTO 42
767 IF( ( kstep.EQ.2 ) .AND. ( p.NE.k ) )
THEN
773 $
CALL cswap( n-p, a( p+1, k ), 1, a( p+1, p ), 1 )
775 $
CALL cswap( p-k-1, a( k+1, k ), 1, a( p, k+1 ), lda )
777 a( k, k ) = a( p, p )
784 $
CALL cswap( k-1, a( k, 1 ), lda, a( p, 1 ), lda )
797 $
CALL cswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
798 IF( ( kk.LT.n ) .AND. ( kp.GT.(kk+1) ) )
799 $
CALL cswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
802 a( kk, kk ) = a( kp, kp )
804 IF( kstep.EQ.2 )
THEN
806 a( k+1, k ) = a( kp, k )
814 $
CALL cswap( k-1, a( kk, 1 ), lda, a( kp, 1 ), lda )
820 IF( kstep.EQ.1 )
THEN
833 IF( cabs1( a( k, k ) ).GE.sfmin )
THEN
839 d11 = cone / a( k, k )
840 CALL csyr( uplo, n-k, -d11, a( k+1, k ), 1,
841 $ a( k+1, k+1 ), lda )
845 CALL cscal( n-k, d11, a( k+1, k ), 1 )
852 a( ii, k ) = a( ii, k ) / d11
860 CALL csyr( uplo, n-k, -d11, a( k+1, k ), 1,
861 $ a( k+1, k+1 ), lda )
890 d11 = a( k+1, k+1 ) / d21
891 d22 = a( k, k ) / d21
892 t = cone / ( d11*d22-cone )
898 wk = t*( d11*a( j, k )-a( j, k+1 ) )
899 wkp1 = t*( d22*a( j, k+1 )-a( j, k ) )
904 a( i, j ) = a( i, j ) - ( a( i, k ) / d21 )*wk -
905 $ ( a( i, k+1 ) / d21 )*wkp1
911 a( j, k+1 ) = wkp1 / d21
932 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 csytf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP