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 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
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL