192 SUBROUTINE zsytf2( UPLO, N, A, LDA, IPIV, INFO )
205 COMPLEX*16 a( lda, * )
211 DOUBLE PRECISION zero, one
212 parameter( zero = 0.0d+0, one = 1.0d+0 )
213 DOUBLE PRECISION eight, sevten
214 parameter( eight = 8.0d+0, sevten = 17.0d+0 )
216 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
220 INTEGER i, imax,
j, jmax, k, kk, kp, kstep
221 DOUBLE PRECISION absakk, alpha, colmax, rowmax
222 COMPLEX*16 d11, d12, d21, d22, r1, t, wk, wkm1, wkp1, z
233 INTRINSIC abs, dble, dimag, max, sqrt
236 DOUBLE PRECISION cabs1
239 cabs1( z ) = abs( dble( z ) ) + abs( dimag( z ) )
246 upper =
lsame( uplo,
'U' )
247 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
249 ELSE IF( n.LT.0 )
THEN
251 ELSE IF( lda.LT.max( 1, n ) )
THEN
255 CALL
xerbla(
'ZSYTF2', -info )
261 alpha = ( one+sqrt( sevten ) ) / eight
282 absakk = cabs1( a( k, k ) )
289 imax =
izamax( k-1, a( 1, k ), 1 )
290 colmax = cabs1( a( imax, k ) )
295 IF( max( absakk, colmax ).EQ.zero .OR.
disnan(absakk) )
THEN
304 IF( absakk.GE.alpha*colmax )
THEN
314 jmax = imax +
izamax( k-imax, a( imax, imax+1 ), lda )
315 rowmax = cabs1( a( imax, jmax ) )
317 jmax =
izamax( imax-1, a( 1, imax ), 1 )
318 rowmax = max( rowmax, cabs1( a( jmax, imax ) ) )
321 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
326 ELSE IF( cabs1( a( imax, imax ) ).GE.alpha*rowmax )
THEN
348 CALL
zswap( kp-1, a( 1, kk ), 1, a( 1, kp ), 1 )
349 CALL
zswap( kk-kp-1, a( kp+1, kk ), 1, a( kp, kp+1 ),
352 a( kk, kk ) = a( kp, kp )
354 IF( kstep.EQ.2 )
THEN
356 a( k-1, k ) = a( kp, k )
363 IF( kstep.EQ.1 )
THEN
375 r1 = cone / a( k, k )
376 CALL
zsyr( uplo, k-1, -r1, a( 1, k ), 1, a, lda )
380 CALL
zscal( k-1, r1, a( 1, k ), 1 )
398 d22 = a( k-1, k-1 ) / d12
399 d11 = a( k, k ) / d12
400 t = cone / ( d11*d22-cone )
403 DO 30
j = k - 2, 1, -1
404 wkm1 = d12*( d11*a(
j, k-1 )-a(
j, k ) )
405 wk = d12*( d22*a(
j, k )-a(
j, k-1 ) )
407 a( i,
j ) = a( i,
j ) - a( i, k )*wk -
421 IF( kstep.EQ.1 )
THEN
452 absakk = cabs1( a( k, k ) )
459 imax = k +
izamax( n-k, a( k+1, k ), 1 )
460 colmax = cabs1( a( imax, k ) )
465 IF( max( absakk, colmax ).EQ.zero .OR.
disnan(absakk) )
THEN
474 IF( absakk.GE.alpha*colmax )
THEN
484 jmax = k - 1 +
izamax( imax-k, a( imax, k ), lda )
485 rowmax = cabs1( a( imax, jmax ) )
487 jmax = imax +
izamax( n-imax, a( imax+1, imax ), 1 )
488 rowmax = max( rowmax, cabs1( a( jmax, imax ) ) )
491 IF( absakk.GE.alpha*colmax*( colmax / rowmax ) )
THEN
496 ELSE IF( cabs1( a( imax, imax ) ).GE.alpha*rowmax )
THEN
519 $ CALL
zswap( n-kp, a( kp+1, kk ), 1, a( kp+1, kp ), 1 )
520 CALL
zswap( kp-kk-1, a( kk+1, kk ), 1, a( kp, kk+1 ),
523 a( kk, kk ) = a( kp, kp )
525 IF( kstep.EQ.2 )
THEN
527 a( k+1, k ) = a( kp, k )
534 IF( kstep.EQ.1 )
THEN
548 r1 = cone / a( k, k )
549 CALL
zsyr( uplo, n-k, -r1, a( k+1, k ), 1,
550 $ a( k+1, k+1 ), lda )
554 CALL
zscal( n-k, r1, a( k+1, k ), 1 )
571 d11 = a( k+1, k+1 ) / d21
572 d22 = a( k, k ) / d21
573 t = cone / ( d11*d22-cone )
577 wk = d21*( d11*a(
j, k )-a(
j, k+1 ) )
578 wkp1 = d21*( d22*a(
j, k+1 )-a(
j, k ) )
580 a( i,
j ) = a( i,
j ) - a( i, k )*wk -
592 IF( kstep.EQ.1 )
THEN
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zsytf2(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
integer function izamax(N, ZX, INCX)
IZAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zsyr(UPLO, N, ALPHA, X, INCX, A, LDA)
ZSYR performs the symmetric rank-1 update of a complex symmetric matrix.
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
logical function disnan(DIN)
DISNAN tests input for NaN.
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL