128 SUBROUTINE zhegst( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
137 INTEGER INFO, ITYPE, LDA, LDB, N
140 COMPLEX*16 A( lda, * ), B( ldb, * )
147 parameter ( one = 1.0d+0 )
148 COMPLEX*16 CONE, HALF
149 parameter ( cone = ( 1.0d+0, 0.0d+0 ),
150 $ half = ( 0.5d+0, 0.0d+0 ) )
165 EXTERNAL lsame, ilaenv
172 upper = lsame( uplo,
'U' )
173 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
175 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
177 ELSE IF( n.LT.0 )
THEN
179 ELSE IF( lda.LT.max( 1, n ) )
THEN
181 ELSE IF( ldb.LT.max( 1, n ) )
THEN
185 CALL xerbla(
'ZHEGST', -info )
196 nb = ilaenv( 1,
'ZHEGST', uplo, n, -1, -1, -1 )
198 IF( nb.LE.1 .OR. nb.GE.n )
THEN
202 CALL zhegs2( itype, uplo, n, a, lda, b, ldb, info )
207 IF( itype.EQ.1 )
THEN
213 kb = min( n-k+1, nb )
217 CALL zhegs2( itype, uplo, kb, a( k, k ), lda,
218 $ b( k, k ), ldb, info )
220 CALL ztrsm(
'Left', uplo,
'Conjugate transpose',
221 $
'Non-unit', kb, n-k-kb+1, cone,
222 $ b( k, k ), ldb, a( k, k+kb ), lda )
223 CALL zhemm(
'Left', uplo, kb, n-k-kb+1, -half,
224 $ a( k, k ), lda, b( k, k+kb ), ldb,
225 $ cone, a( k, k+kb ), lda )
226 CALL zher2k( uplo,
'Conjugate transpose', n-k-kb+1,
227 $ kb, -cone, a( k, k+kb ), lda,
228 $ b( k, k+kb ), ldb, one,
229 $ a( k+kb, k+kb ), lda )
230 CALL zhemm(
'Left', uplo, kb, n-k-kb+1, -half,
231 $ a( k, k ), lda, b( k, k+kb ), ldb,
232 $ cone, a( k, k+kb ), lda )
233 CALL ztrsm(
'Right', uplo,
'No transpose',
234 $
'Non-unit', kb, n-k-kb+1, cone,
235 $ b( k+kb, k+kb ), ldb, a( k, k+kb ),
244 kb = min( n-k+1, nb )
248 CALL zhegs2( itype, uplo, kb, a( k, k ), lda,
249 $ b( k, k ), ldb, info )
251 CALL ztrsm(
'Right', uplo,
'Conjugate transpose',
252 $
'Non-unit', n-k-kb+1, kb, cone,
253 $ b( k, k ), ldb, a( k+kb, k ), lda )
254 CALL zhemm(
'Right', uplo, n-k-kb+1, kb, -half,
255 $ a( k, k ), lda, b( k+kb, k ), ldb,
256 $ cone, a( k+kb, k ), lda )
257 CALL zher2k( uplo,
'No transpose', n-k-kb+1, kb,
258 $ -cone, a( k+kb, k ), lda,
259 $ b( k+kb, k ), ldb, one,
260 $ a( k+kb, k+kb ), lda )
261 CALL zhemm(
'Right', uplo, n-k-kb+1, kb, -half,
262 $ a( k, k ), lda, b( k+kb, k ), ldb,
263 $ cone, a( k+kb, k ), lda )
264 CALL ztrsm(
'Left', uplo,
'No transpose',
265 $
'Non-unit', n-k-kb+1, kb, cone,
266 $ b( k+kb, k+kb ), ldb, a( k+kb, k ),
277 kb = min( n-k+1, nb )
281 CALL ztrmm(
'Left', uplo,
'No transpose',
'Non-unit',
282 $ k-1, kb, cone, b, ldb, a( 1, k ), lda )
283 CALL zhemm(
'Right', uplo, k-1, kb, half, a( k, k ),
284 $ lda, b( 1, k ), ldb, cone, a( 1, k ),
286 CALL zher2k( uplo,
'No transpose', k-1, kb, cone,
287 $ a( 1, k ), lda, b( 1, k ), ldb, one, a,
289 CALL zhemm(
'Right', uplo, k-1, kb, half, a( k, k ),
290 $ lda, b( 1, k ), ldb, cone, a( 1, k ),
292 CALL ztrmm(
'Right', uplo,
'Conjugate transpose',
293 $
'Non-unit', k-1, kb, cone, b( k, k ), ldb,
295 CALL zhegs2( itype, uplo, kb, a( k, k ), lda,
296 $ b( k, k ), ldb, info )
303 kb = min( n-k+1, nb )
307 CALL ztrmm(
'Right', uplo,
'No transpose',
'Non-unit',
308 $ kb, k-1, cone, b, ldb, a( k, 1 ), lda )
309 CALL zhemm(
'Left', uplo, kb, k-1, half, a( k, k ),
310 $ lda, b( k, 1 ), ldb, cone, a( k, 1 ),
312 CALL zher2k( uplo,
'Conjugate transpose', k-1, kb,
313 $ cone, a( k, 1 ), lda, b( k, 1 ), ldb,
315 CALL zhemm(
'Left', uplo, kb, k-1, half, a( k, k ),
316 $ lda, b( k, 1 ), ldb, cone, a( k, 1 ),
318 CALL ztrmm(
'Left', uplo,
'Conjugate transpose',
319 $
'Non-unit', kb, k-1, cone, b( k, k ), ldb,
321 CALL zhegs2( itype, uplo, kb, a( k, k ), lda,
322 $ b( k, k ), ldb, info )
subroutine zhegst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
ZHEGST
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM
subroutine zhegs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorizatio...
subroutine zher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHER2K
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM