128 SUBROUTINE chegst( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
137 INTEGER info, itype, lda, ldb, n
140 COMPLEX a( lda, * ),
b( ldb, * )
147 parameter( one = 1.0e+0 )
149 parameter( cone = ( 1.0e+0, 0.0e+0 ),
150 $ half = ( 0.5e+0, 0.0e+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(
'CHEGST', -info )
196 nb =
ilaenv( 1,
'CHEGST', uplo, n, -1, -1, -1 )
198 IF( nb.LE.1 .OR. nb.GE.n )
THEN
202 CALL
chegs2( itype, uplo, n, a, lda,
b, ldb, info )
207 IF( itype.EQ.1 )
THEN
213 kb = min( n-k+1, nb )
217 CALL
chegs2( itype, uplo, kb, a( k, k ), lda,
218 $
b( k, k ), ldb, info )
220 CALL
ctrsm(
'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
chemm(
'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
cher2k( 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
chemm(
'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
ctrsm(
'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
chegs2( itype, uplo, kb, a( k, k ), lda,
249 $
b( k, k ), ldb, info )
251 CALL
ctrsm(
'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
chemm(
'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
cher2k( 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
chemm(
'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
ctrsm(
'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
ctrmm(
'Left', uplo,
'No transpose',
'Non-unit',
282 $ k-1, kb, cone,
b, ldb, a( 1, k ), lda )
283 CALL
chemm(
'Right', uplo, k-1, kb, half, a( k, k ),
284 $ lda,
b( 1, k ), ldb, cone, a( 1, k ),
286 CALL
cher2k( uplo,
'No transpose', k-1, kb, cone,
287 $ a( 1, k ), lda,
b( 1, k ), ldb, one, a,
289 CALL
chemm(
'Right', uplo, k-1, kb, half, a( k, k ),
290 $ lda,
b( 1, k ), ldb, cone, a( 1, k ),
292 CALL
ctrmm(
'Right', uplo,
'Conjugate transpose',
293 $
'Non-unit', k-1, kb, cone,
b( k, k ), ldb,
295 CALL
chegs2( itype, uplo, kb, a( k, k ), lda,
296 $
b( k, k ), ldb, info )
303 kb = min( n-k+1, nb )
307 CALL
ctrmm(
'Right', uplo,
'No transpose',
'Non-unit',
308 $ kb, k-1, cone,
b, ldb, a( k, 1 ), lda )
309 CALL
chemm(
'Left', uplo, kb, k-1, half, a( k, k ),
310 $ lda,
b( k, 1 ), ldb, cone, a( k, 1 ),
312 CALL
cher2k( uplo,
'Conjugate transpose', k-1, kb,
313 $ cone, a( k, 1 ), lda,
b( k, 1 ), ldb,
315 CALL
chemm(
'Left', uplo, kb, k-1, half, a( k, k ),
316 $ lda,
b( k, 1 ), ldb, cone, a( k, 1 ),
318 CALL
ctrmm(
'Left', uplo,
'Conjugate transpose',
319 $
'Non-unit', kb, k-1, cone,
b( k, k ), ldb,
321 CALL
chegs2( itype, uplo, kb, a( k, k ), lda,
322 $
b( k, k ), ldb, info )
subroutine chegs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
CHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorizatio...
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine chegst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
CHEGST
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine cher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHER2K
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM