195 SUBROUTINE dsytf2( 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, K, KK, KP, KSTEP
222 DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, R1,
223 $ rowmax, t, wk, wkm1, wkp1
226 LOGICAL LSAME, DISNAN
228 EXTERNAL lsame, idamax, disnan
234 INTRINSIC abs, max, sqrt
241 upper = lsame( uplo,
'U' )
242 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
244 ELSE IF( n.LT.0 )
THEN
246 ELSE IF( lda.LT.max( 1, n ) )
THEN
250 CALL
xerbla(
'DSYTF2', -info )
256 alpha = ( one+sqrt( sevten ) ) / eight
277 absakk = abs( a( k, k ) )
284 imax = idamax( k-1, a( 1, k ), 1 )
285 colmax = abs( a( imax, k ) )
290 IF( (max( absakk, colmax ).EQ.zero) .OR. disnan(absakk) )
THEN
299 IF( absakk.GE.alpha*colmax )
THEN
309 jmax = imax + idamax( k-imax, a( imax, imax+1 ), lda )
310 rowmax = abs( a( imax, jmax ) )
312 jmax = idamax( imax-1, a( 1, imax ), 1 )
313 rowmax = max( rowmax, abs( a( jmax, imax ) ) )
316 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
321 ELSE IF( abs( a( imax, imax ) ).GE.alpha*rowmax )
THEN
343 CALL
dswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
344 CALL
dswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
347 a( kk, kk ) = a( kp, kp )
349 IF( kstep.EQ.2 )
THEN
351 a( k-1, k ) = a( kp, k )
358 IF( kstep.EQ.1 )
THEN
371 CALL
dsyr( uplo, k-1, -r1, a( 1, k ), 1, a, lda )
375 CALL
dscal( k-1, r1, a( 1, k ), 1 )
393 d22 = a( k-1, k-1 ) / d12
394 d11 = a( k, k ) / d12
395 t = one / ( d11*d22-one )
398 DO 30 j = k - 2, 1, -1
399 wkm1 = d12*( d11*a( j, k-1 )-a( j, k ) )
400 wk = d12*( d22*a( j, k )-a( j, k-1 ) )
402 a( i, j ) = a( i, j ) - a( i, k )*wk -
416 IF( kstep.EQ.1 )
THEN
447 absakk = abs( a( k, k ) )
454 imax = k + idamax( n-k, a( k+1, k ), 1 )
455 colmax = abs( a( imax, k ) )
460 IF( (max( absakk, colmax ).EQ.zero) .OR. disnan(absakk) )
THEN
469 IF( absakk.GE.alpha*colmax )
THEN
479 jmax = k - 1 + idamax( imax-k, a( imax, k ), lda )
480 rowmax = abs( a( imax, jmax ) )
482 jmax = imax + idamax( n-imax, a( imax+1, imax ), 1 )
483 rowmax = max( rowmax, abs( a( jmax, imax ) ) )
486 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
491 ELSE IF( abs( a( imax, imax ) ).GE.alpha*rowmax )
THEN
514 $ CALL
dswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
515 CALL
dswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
518 a( kk, kk ) = a( kp, kp )
520 IF( kstep.EQ.2 )
THEN
522 a( k+1, k ) = a( kp, k )
529 IF( kstep.EQ.1 )
THEN
543 d11 = one / a( k, k )
544 CALL
dsyr( uplo, n-k, -d11, a( k+1, k ), 1,
545 $ a( k+1, k+1 ), lda )
549 CALL
dscal( n-k, d11, a( k+1, k ), 1 )
565 d11 = a( k+1, k+1 ) / d21
566 d22 = a( k, k ) / d21
567 t = one / ( d11*d22-one )
572 wk = d21*( d11*a( j, k )-a( j, k+1 ) )
573 wkp1 = d21*( d22*a( j, k+1 )-a( j, k ) )
576 a( i, j ) = a( i, j ) - a( i, k )*wk -
590 IF( kstep.EQ.1 )
THEN
subroutine dsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
DSYR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsytf2(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP