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 )
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
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
logical function lsame(CA, CB)
LSAME
subroutine zhegst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
ZHEGST
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM
subroutine zher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHER2K
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM