128 SUBROUTINE zhegs2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
137 INTEGER info, itype, lda, ldb, n
140 COMPLEX*16 a( lda, * ),
b( ldb, * )
146 DOUBLE PRECISION one, half
147 parameter( one = 1.0d+0, half = 0.5d+0 )
149 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
154 DOUBLE PRECISION akk, bkk
173 upper =
lsame( uplo,
'U' )
174 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
176 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
178 ELSE IF( n.LT.0 )
THEN
180 ELSE IF( lda.LT.max( 1, n ) )
THEN
182 ELSE IF( ldb.LT.max( 1, n ) )
THEN
186 CALL
xerbla(
'ZHEGS2', -info )
190 IF( itype.EQ.1 )
THEN
204 CALL
zdscal( n-k, one / bkk, a( k, k+1 ), lda )
206 CALL
zlacgv( n-k, a( k, k+1 ), lda )
207 CALL
zlacgv( n-k,
b( k, k+1 ), ldb )
208 CALL
zaxpy( n-k, ct,
b( k, k+1 ), ldb, a( k, k+1 ),
210 CALL
zher2( uplo, n-k, -cone, a( k, k+1 ), lda,
211 $
b( k, k+1 ), ldb, a( k+1, k+1 ), lda )
212 CALL
zaxpy( n-k, ct,
b( k, k+1 ), ldb, a( k, k+1 ),
214 CALL
zlacgv( n-k,
b( k, k+1 ), ldb )
215 CALL
ztrsv( uplo,
'Conjugate transpose',
'Non-unit',
216 $ n-k,
b( k+1, k+1 ), ldb, a( k, k+1 ),
218 CALL
zlacgv( n-k, a( k, k+1 ), lda )
234 CALL
zdscal( n-k, one / bkk, a( k+1, k ), 1 )
236 CALL
zaxpy( n-k, ct,
b( k+1, k ), 1, a( k+1, k ), 1 )
237 CALL
zher2( uplo, n-k, -cone, a( k+1, k ), 1,
238 $
b( k+1, k ), 1, a( k+1, k+1 ), lda )
239 CALL
zaxpy( n-k, ct,
b( k+1, k ), 1, a( k+1, k ), 1 )
240 CALL
ztrsv( uplo,
'No transpose',
'Non-unit', n-k,
241 $
b( k+1, k+1 ), ldb, a( k+1, k ), 1 )
256 CALL
ztrmv( uplo,
'No transpose',
'Non-unit', k-1,
b,
257 $ ldb, a( 1, k ), 1 )
259 CALL
zaxpy( k-1, ct,
b( 1, k ), 1, a( 1, k ), 1 )
260 CALL
zher2( uplo, k-1, cone, a( 1, k ), 1,
b( 1, k ), 1,
262 CALL
zaxpy( k-1, ct,
b( 1, k ), 1, a( 1, k ), 1 )
263 CALL
zdscal( k-1, bkk, a( 1, k ), 1 )
264 a( k, k ) = akk*bkk**2
276 CALL
zlacgv( k-1, a( k, 1 ), lda )
277 CALL
ztrmv( uplo,
'Conjugate transpose',
'Non-unit', k-1,
278 $
b, ldb, a( k, 1 ), lda )
280 CALL
zlacgv( k-1,
b( k, 1 ), ldb )
281 CALL
zaxpy( k-1, ct,
b( k, 1 ), ldb, a( k, 1 ), lda )
282 CALL
zher2( uplo, k-1, cone, a( k, 1 ), lda,
b( k, 1 ),
284 CALL
zaxpy( k-1, ct,
b( k, 1 ), ldb, a( k, 1 ), lda )
285 CALL
zlacgv( k-1,
b( k, 1 ), ldb )
286 CALL
zdscal( k-1, bkk, a( k, 1 ), lda )
287 CALL
zlacgv( k-1, a( k, 1 ), lda )
288 a( k, k ) = akk*bkk**2
LOGICAL function lsame(CA, CB)
LSAME
subroutine ztrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRSV
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zhegs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorizatio...
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2