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 dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRSM
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYMM
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYR2K
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 dsygst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
DSYGST