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 ) )
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 )