127 SUBROUTINE zhegs2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
135 INTEGER INFO, ITYPE, LDA, LDB, N
138 COMPLEX*16 A( LDA, * ), B( LDB, * )
144 DOUBLE PRECISION ONE, HALF
145 parameter( one = 1.0d+0, half = 0.5d+0 )
147 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
152 DOUBLE PRECISION AKK, BKK
171 upper = lsame( uplo,
'U' )
172 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
174 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
176 ELSE IF( n.LT.0 )
THEN
178 ELSE IF( lda.LT.max( 1, n ) )
THEN
180 ELSE IF( ldb.LT.max( 1, n ) )
THEN
184 CALL xerbla(
'ZHEGS2', -info )
188 IF( itype.EQ.1 )
THEN
197 akk = dble( a( k, k ) )
198 bkk = dble( b( k, k ) )
202 CALL zdscal( n-k, one / bkk, a( k, k+1 ), lda )
204 CALL zlacgv( n-k, a( k, k+1 ), lda )
205 CALL zlacgv( n-k, b( k, k+1 ), ldb )
206 CALL zaxpy( n-k, ct, b( k, k+1 ), ldb, a( k, k+1 ),
208 CALL zher2( uplo, n-k, -cone, a( k, k+1 ), lda,
209 $ b( k, k+1 ), ldb, a( k+1, k+1 ), lda )
210 CALL zaxpy( n-k, ct, b( k, k+1 ), ldb, a( k, k+1 ),
212 CALL zlacgv( n-k, b( k, k+1 ), ldb )
213 CALL ztrsv( uplo,
'Conjugate transpose',
'Non-unit',
214 $ n-k, b( k+1, k+1 ), ldb, a( k, k+1 ),
216 CALL zlacgv( n-k, a( k, k+1 ), lda )
227 akk = dble( a( k, k ) )
228 bkk = dble( b( k, k ) )
232 CALL zdscal( n-k, one / bkk, a( k+1, k ), 1 )
234 CALL zaxpy( n-k, ct, b( k+1, k ), 1, a( k+1, k ), 1 )
235 CALL zher2( uplo, n-k, -cone, a( k+1, k ), 1,
236 $ b( k+1, k ), 1, a( k+1, k+1 ), lda )
237 CALL zaxpy( n-k, ct, b( k+1, k ), 1, a( k+1, k ), 1 )
238 CALL ztrsv( uplo,
'No transpose',
'Non-unit', n-k,
239 $ b( k+1, k+1 ), ldb, a( k+1, k ), 1 )
252 akk = dble( a( k, k ) )
253 bkk = dble( b( k, k ) )
254 CALL ztrmv( uplo,
'No transpose',
'Non-unit', k-1, b,
255 $ ldb, a( 1, k ), 1 )
257 CALL zaxpy( k-1, ct, b( 1, k ), 1, a( 1, k ), 1 )
258 CALL zher2( uplo, k-1, cone, a( 1, k ), 1, b( 1, k ), 1,
260 CALL zaxpy( k-1, ct, b( 1, k ), 1, a( 1, k ), 1 )
261 CALL zdscal( k-1, bkk, a( 1, k ), 1 )
262 a( k, k ) = akk*bkk**2
272 akk = dble( a( k, k ) )
273 bkk = dble( b( k, k ) )
274 CALL zlacgv( k-1, a( k, 1 ), lda )
275 CALL ztrmv( uplo,
'Conjugate transpose',
'Non-unit', k-1,
276 $ b, ldb, a( k, 1 ), lda )
278 CALL zlacgv( k-1, b( k, 1 ), ldb )
279 CALL zaxpy( k-1, ct, b( k, 1 ), ldb, a( k, 1 ), lda )
280 CALL zher2( uplo, k-1, cone, a( k, 1 ), lda, b( k, 1 ),
282 CALL zaxpy( k-1, ct, b( k, 1 ), ldb, a( k, 1 ), lda )
283 CALL zlacgv( k-1, b( k, 1 ), ldb )
284 CALL zdscal( k-1, bkk, a( k, 1 ), lda )
285 CALL zlacgv( k-1, a( k, 1 ), lda )
286 a( k, k ) = akk*bkk**2
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
subroutine ztrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRSV
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2
subroutine zhegs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorizatio...
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.