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
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