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