196 SUBROUTINE ssytf2( UPLO, N, A, LDA, IPIV, INFO )
216 parameter( zero = 0.0e+0, one = 1.0e+0 )
218 parameter( eight = 8.0e+0, sevten = 17.0e+0 )
222 INTEGER i, imax,
j, jmax, k, kk, kp, kstep
223 REAL absakk, alpha, colmax, d11, d12, d21, d22, r1,
224 $ rowmax, t, wk, wkm1, wkp1
235 INTRINSIC abs, max, sqrt
242 upper =
lsame( uplo,
'U' )
243 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
245 ELSE IF( n.LT.0 )
THEN
247 ELSE IF( lda.LT.max( 1, n ) )
THEN
251 CALL
xerbla(
'SSYTF2', -info )
257 alpha = ( one+sqrt( sevten ) ) / eight
278 absakk = abs( a( k, k ) )
285 imax =
isamax( k-1, a( 1, k ), 1 )
286 colmax = abs( a( imax, k ) )
291 IF( (max( absakk, colmax ).EQ.zero) .OR.
sisnan(absakk) )
THEN
300 IF( absakk.GE.alpha*colmax )
THEN
310 jmax = imax +
isamax( k-imax, a( imax, imax+1 ), lda )
311 rowmax = abs( a( imax, jmax ) )
313 jmax =
isamax( imax-1, a( 1, imax ), 1 )
314 rowmax = max( rowmax, abs( a( jmax, imax ) ) )
317 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
322 ELSE IF( abs( a( imax, imax ) ).GE.alpha*rowmax )
THEN
344 CALL
sswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
345 CALL
sswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
348 a( kk, kk ) = a( kp, kp )
350 IF( kstep.EQ.2 )
THEN
352 a( k-1, k ) = a( kp, k )
359 IF( kstep.EQ.1 )
THEN
372 CALL
ssyr( uplo, k-1, -r1, a( 1, k ), 1, a, lda )
376 CALL
sscal( k-1, r1, a( 1, k ), 1 )
394 d22 = a( k-1, k-1 ) / d12
395 d11 = a( k, k ) / d12
396 t = one / ( d11*d22-one )
399 DO 30
j = k - 2, 1, -1
400 wkm1 = d12*( d11*a(
j, k-1 )-a(
j, k ) )
401 wk = d12*( d22*a(
j, k )-a(
j, k-1 ) )
403 a( i,
j ) = a( i,
j ) - a( i, k )*wk -
417 IF( kstep.EQ.1 )
THEN
448 absakk = abs( a( k, k ) )
455 imax = k +
isamax( n-k, a( k+1, k ), 1 )
456 colmax = abs( a( imax, k ) )
461 IF( (max( absakk, colmax ).EQ.zero) .OR.
sisnan(absakk) )
THEN
470 IF( absakk.GE.alpha*colmax )
THEN
480 jmax = k - 1 +
isamax( imax-k, a( imax, k ), lda )
481 rowmax = abs( a( imax, jmax ) )
483 jmax = imax +
isamax( n-imax, a( imax+1, imax ), 1 )
484 rowmax = max( rowmax, abs( a( jmax, imax ) ) )
487 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
492 ELSE IF( abs( a( imax, imax ) ).GE.alpha*rowmax )
THEN
515 $ CALL
sswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
516 CALL
sswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
519 a( kk, kk ) = a( kp, kp )
521 IF( kstep.EQ.2 )
THEN
523 a( k+1, k ) = a( kp, k )
530 IF( kstep.EQ.1 )
THEN
544 d11 = one / a( k, k )
545 CALL
ssyr( uplo, n-k, -d11, a( k+1, k ), 1,
546 $ a( k+1, k+1 ), lda )
550 CALL
sscal( n-k, d11, a( k+1, k ), 1 )
566 d11 = a( k+1, k+1 ) / d21
567 d22 = a( k, k ) / d21
568 t = one / ( d11*d22-one )
573 wk = d21*( d11*a(
j, k )-a(
j, k+1 ) )
574 wkp1 = d21*( d22*a(
j, k+1 )-a(
j, k ) )
577 a( i,
j ) = a( i,
j ) - a( i, k )*wk -
591 IF( kstep.EQ.1 )
THEN
subroutine ssytf2(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
logical function sisnan(SIN)
SISNAN tests input for NaN.
subroutine sscal(N, SA, SX, INCX)
SSCAL