128 SUBROUTINE dsygst( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
137 INTEGER INFO, ITYPE, LDA, LDB, N
140 DOUBLE PRECISION A( lda, * ), B( ldb, * )
146 DOUBLE PRECISION ONE, HALF
147 parameter( one = 1.0d0, half = 0.5d0 )
162 EXTERNAL lsame, ilaenv
169 upper = lsame( uplo,
'U' )
170 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
172 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
174 ELSE IF( n.LT.0 )
THEN
176 ELSE IF( lda.LT.max( 1, n ) )
THEN
178 ELSE IF( ldb.LT.max( 1, n ) )
THEN
182 CALL
xerbla(
'DSYGST', -info )
193 nb = ilaenv( 1,
'DSYGST', uplo, n, -1, -1, -1 )
195 IF( nb.LE.1 .OR. nb.GE.n )
THEN
199 CALL
dsygs2( itype, uplo, n, a, lda, b, ldb, info )
204 IF( itype.EQ.1 )
THEN
210 kb = min( n-k+1, nb )
214 CALL
dsygs2( itype, uplo, kb, a( k, k ), lda,
215 $ b( k, k ), ldb, info )
217 CALL
dtrsm(
'Left', uplo,
'Transpose',
'Non-unit',
218 $ kb, n-k-kb+1, one, b( k, k ), ldb,
219 $ a( k, k+kb ), lda )
220 CALL
dsymm(
'Left', uplo, kb, n-k-kb+1, -half,
221 $ a( k, k ), lda, b( k, k+kb ), ldb, one,
222 $ a( k, k+kb ), lda )
223 CALL
dsyr2k( uplo,
'Transpose', n-k-kb+1, kb, -one,
224 $ a( k, k+kb ), lda, b( k, k+kb ), ldb,
225 $ one, a( k+kb, k+kb ), lda )
226 CALL
dsymm(
'Left', uplo, kb, n-k-kb+1, -half,
227 $ a( k, k ), lda, b( k, k+kb ), ldb, one,
228 $ a( k, k+kb ), lda )
229 CALL
dtrsm(
'Right', uplo,
'No transpose',
230 $
'Non-unit', kb, n-k-kb+1, one,
231 $ b( k+kb, k+kb ), ldb, a( k, k+kb ),
240 kb = min( n-k+1, nb )
244 CALL
dsygs2( itype, uplo, kb, a( k, k ), lda,
245 $ b( k, k ), ldb, info )
247 CALL
dtrsm(
'Right', uplo,
'Transpose',
'Non-unit',
248 $ n-k-kb+1, kb, one, b( k, k ), ldb,
249 $ a( k+kb, k ), lda )
250 CALL
dsymm(
'Right', uplo, n-k-kb+1, kb, -half,
251 $ a( k, k ), lda, b( k+kb, k ), ldb, one,
252 $ a( k+kb, k ), lda )
253 CALL
dsyr2k( uplo,
'No transpose', n-k-kb+1, kb,
254 $ -one, a( k+kb, k ), lda, b( k+kb, k ),
255 $ ldb, one, a( k+kb, k+kb ), lda )
256 CALL
dsymm(
'Right', uplo, n-k-kb+1, kb, -half,
257 $ a( k, k ), lda, b( k+kb, k ), ldb, one,
258 $ a( k+kb, k ), lda )
259 CALL
dtrsm(
'Left', uplo,
'No transpose',
260 $
'Non-unit', n-k-kb+1, kb, one,
261 $ b( k+kb, k+kb ), ldb, a( k+kb, k ),
272 kb = min( n-k+1, nb )
276 CALL
dtrmm(
'Left', uplo,
'No transpose',
'Non-unit',
277 $ k-1, kb, one, b, ldb, a( 1, k ), lda )
278 CALL
dsymm(
'Right', uplo, k-1, kb, half, a( k, k ),
279 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
280 CALL
dsyr2k( uplo,
'No transpose', k-1, kb, one,
281 $ a( 1, k ), lda, b( 1, k ), ldb, one, a,
283 CALL
dsymm(
'Right', uplo, k-1, kb, half, a( k, k ),
284 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
285 CALL
dtrmm(
'Right', uplo,
'Transpose',
'Non-unit',
286 $ k-1, kb, one, b( k, k ), ldb, a( 1, k ),
288 CALL
dsygs2( itype, uplo, kb, a( k, k ), lda,
289 $ b( k, k ), ldb, info )
296 kb = min( n-k+1, nb )
300 CALL
dtrmm(
'Right', uplo,
'No transpose',
'Non-unit',
301 $ kb, k-1, one, b, ldb, a( k, 1 ), lda )
302 CALL
dsymm(
'Left', uplo, kb, k-1, half, a( k, k ),
303 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
304 CALL
dsyr2k( uplo,
'Transpose', k-1, kb, one,
305 $ a( k, 1 ), lda, b( k, 1 ), ldb, one, a,
307 CALL
dsymm(
'Left', uplo, kb, k-1, half, a( k, k ),
308 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
309 CALL
dtrmm(
'Left', uplo,
'Transpose',
'Non-unit', kb,
310 $ k-1, one, b( k, k ), ldb, a( k, 1 ), lda )
311 CALL
dsygs2( itype, uplo, kb, a( k, k ), lda,
312 $ b( k, k ), ldb, info )
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsygs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
DSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorizatio...
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dsygst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
DSYGST
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYR2K
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM