195 SUBROUTINE dsytf2_rook( UPLO, N, A, LDA, IPIV, INFO )
208 DOUBLE PRECISION A( lda, * )
214 DOUBLE PRECISION ZERO, ONE
215 parameter ( zero = 0.0d+0, one = 1.0d+0 )
216 DOUBLE PRECISION EIGHT, SEVTEN
217 parameter ( eight = 8.0d+0, sevten = 17.0d+0 )
221 INTEGER I, IMAX, J, JMAX, ITEMP, K, KK, KP, KSTEP,
223 DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22,
224 $ rowmax, dtemp, t, wk, wkm1, wkp1, sfmin
229 DOUBLE PRECISION DLAMCH
230 EXTERNAL lsame, idamax, dlamch
236 INTRINSIC abs, max, sqrt
243 upper = lsame( uplo,
'U' )
244 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
246 ELSE IF( n.LT.0 )
THEN
248 ELSE IF( lda.LT.max( 1, n ) )
THEN
252 CALL xerbla(
'DSYTF2_ROOK', -info )
258 alpha = ( one+sqrt( sevten ) ) / eight
262 sfmin = dlamch(
'S' )
284 absakk = abs( a( k, k ) )
291 imax = idamax( k-1, a( 1, k ), 1 )
292 colmax = abs( a( imax, k ) )
297 IF( (max( absakk, colmax ).EQ.zero) )
THEN
311 IF( .NOT.( absakk.LT.alpha*colmax ) )
THEN
332 jmax = imax + idamax( k-imax, a( imax, imax+1 ),
334 rowmax = abs( a( imax, jmax ) )
340 itemp = idamax( imax-1, a( 1, imax ), 1 )
341 dtemp = abs( a( itemp, imax ) )
342 IF( dtemp.GT.rowmax )
THEN
351 IF( .NOT.( abs( a( imax, imax ) ).LT.alpha*rowmax ) )
363 ELSE IF( ( p.EQ.jmax ).OR.( rowmax.LE.colmax ) )
THEN
382 IF( .NOT. done )
GOTO 12
390 IF( ( kstep.EQ.2 ) .AND. ( p.NE.k ) )
THEN
396 $
CALL dswap( p-1, a( 1, k ), 1, a( 1, p ), 1 )
398 $
CALL dswap( k-p-1, a( p+1, k ), 1, a( p, p+1 ),
401 a( k, k ) = a( p, p )
414 $
CALL dswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
415 IF( ( kk.GT.1 ) .AND. ( kp.LT.(kk-1) ) )
416 $
CALL dswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
419 a( kk, kk ) = a( kp, kp )
421 IF( kstep.EQ.2 )
THEN
423 a( k-1, k ) = a( kp, k )
430 IF( kstep.EQ.1 )
THEN
443 IF( abs( a( k, k ) ).GE.sfmin )
THEN
449 d11 = one / a( k, k )
450 CALL dsyr( uplo, k-1, -d11, a( 1, k ), 1, a, lda )
454 CALL dscal( k-1, d11, a( 1, k ), 1 )
461 a( ii, k ) = a( ii, k ) / d11
469 CALL dsyr( uplo, k-1, -d11, a( 1, k ), 1, a, lda )
492 d22 = a( k-1, k-1 ) / d12
493 d11 = a( k, k ) / d12
494 t = one / ( d11*d22-one )
496 DO 30 j = k - 2, 1, -1
498 wkm1 = t*( d11*a( j, k-1 )-a( j, k ) )
499 wk = t*( d22*a( j, k )-a( j, k-1 ) )
502 a( i, j ) = a( i, j ) - (a( i, k ) / d12 )*wk -
503 $ ( a( i, k-1 ) / d12 )*wkm1
509 a( j, k-1 ) = wkm1 / d12
520 IF( kstep.EQ.1 )
THEN
552 absakk = abs( a( k, k ) )
559 imax = k + idamax( n-k, a( k+1, k ), 1 )
560 colmax = abs( a( imax, k ) )
565 IF( ( max( absakk, colmax ).EQ.zero ) )
THEN
579 IF( .NOT.( absakk.LT.alpha*colmax ) )
THEN
599 jmax = k - 1 + idamax( imax-k, a( imax, k ), lda )
600 rowmax = abs( a( imax, jmax ) )
606 itemp = imax + idamax( n-imax, a( imax+1, imax ),
608 dtemp = abs( a( itemp, imax ) )
609 IF( dtemp.GT.rowmax )
THEN
618 IF( .NOT.( abs( a( imax, imax ) ).LT.alpha*rowmax ) )
630 ELSE IF( ( p.EQ.jmax ).OR.( rowmax.LE.colmax ) )
THEN
649 IF( .NOT. done )
GOTO 42
657 IF( ( kstep.EQ.2 ) .AND. ( p.NE.k ) )
THEN
663 $
CALL dswap( n-p, a( p+1, k ), 1, a( p+1, p ), 1 )
665 $
CALL dswap( p-k-1, a( k+1, k ), 1, a( p, k+1 ), lda )
667 a( k, k ) = a( p, p )
680 $
CALL dswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
681 IF( ( kk.LT.n ) .AND. ( kp.GT.(kk+1) ) )
682 $
CALL dswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
685 a( kk, kk ) = a( kp, kp )
687 IF( kstep.EQ.2 )
THEN
689 a( k+1, k ) = a( kp, k )
696 IF( kstep.EQ.1 )
THEN
709 IF( abs( a( k, k ) ).GE.sfmin )
THEN
715 d11 = one / a( k, k )
716 CALL dsyr( uplo, n-k, -d11, a( k+1, k ), 1,
717 $ a( k+1, k+1 ), lda )
721 CALL dscal( n-k, d11, a( k+1, k ), 1 )
728 a( ii, k ) = a( ii, k ) / d11
736 CALL dsyr( uplo, n-k, -d11, a( k+1, k ), 1,
737 $ a( k+1, k+1 ), lda )
761 d11 = a( k+1, k+1 ) / d21
762 d22 = a( k, k ) / d21
763 t = one / ( d11*d22-one )
769 wk = t*( d11*a( j, k )-a( j, k+1 ) )
770 wkp1 = t*( d22*a( j, k+1 )-a( j, k ) )
775 a( i, j ) = a( i, j ) - ( a( i, k ) / d21 )*wk -
776 $ ( a( i, k+1 ) / d21 )*wkp1
782 a( j, k+1 ) = wkp1 / d21
793 IF( kstep.EQ.1 )
THEN
subroutine dsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
DSYR
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...