128 SUBROUTINE ssygst( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
137 INTEGER INFO, ITYPE, LDA, LDB, N
140 REAL A( lda, * ), B( ldb, * )
147 parameter( one = 1.0, half = 0.5 )
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(
'SSYGST', -info )
193 nb = ilaenv( 1,
'SSYGST', uplo, n, -1, -1, -1 )
195 IF( nb.LE.1 .OR. nb.GE.n )
THEN
199 CALL
ssygs2( itype, uplo, n, a, lda, b, ldb, info )
204 IF( itype.EQ.1 )
THEN
210 kb = min( n-k+1, nb )
214 CALL
ssygs2( itype, uplo, kb, a( k, k ), lda,
215 $ b( k, k ), ldb, info )
217 CALL
strsm(
'Left', uplo,
'Transpose',
'Non-unit',
218 $ kb, n-k-kb+1, one, b( k, k ), ldb,
219 $ a( k, k+kb ), lda )
220 CALL
ssymm(
'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
ssyr2k( 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
ssymm(
'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
strsm(
'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
ssygs2( itype, uplo, kb, a( k, k ), lda,
245 $ b( k, k ), ldb, info )
247 CALL
strsm(
'Right', uplo,
'Transpose',
'Non-unit',
248 $ n-k-kb+1, kb, one, b( k, k ), ldb,
249 $ a( k+kb, k ), lda )
250 CALL
ssymm(
'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
ssyr2k( 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
ssymm(
'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
strsm(
'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
strmm(
'Left', uplo,
'No transpose',
'Non-unit',
277 $ k-1, kb, one, b, ldb, a( 1, k ), lda )
278 CALL
ssymm(
'Right', uplo, k-1, kb, half, a( k, k ),
279 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
280 CALL
ssyr2k( uplo,
'No transpose', k-1, kb, one,
281 $ a( 1, k ), lda, b( 1, k ), ldb, one, a,
283 CALL
ssymm(
'Right', uplo, k-1, kb, half, a( k, k ),
284 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
285 CALL
strmm(
'Right', uplo,
'Transpose',
'Non-unit',
286 $ k-1, kb, one, b( k, k ), ldb, a( 1, k ),
288 CALL
ssygs2( itype, uplo, kb, a( k, k ), lda,
289 $ b( k, k ), ldb, info )
296 kb = min( n-k+1, nb )
300 CALL
strmm(
'Right', uplo,
'No transpose',
'Non-unit',
301 $ kb, k-1, one, b, ldb, a( k, 1 ), lda )
302 CALL
ssymm(
'Left', uplo, kb, k-1, half, a( k, k ),
303 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
304 CALL
ssyr2k( uplo,
'Transpose', k-1, kb, one,
305 $ a( k, 1 ), lda, b( k, 1 ), ldb, one, a,
307 CALL
ssymm(
'Left', uplo, kb, k-1, half, a( k, k ),
308 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
309 CALL
strmm(
'Left', uplo,
'Transpose',
'Non-unit', kb,
310 $ k-1, one, b( k, k ), ldb, a( k, 1 ), lda )
311 CALL
ssygs2( itype, uplo, kb, a( k, k ), lda,
312 $ b( k, k ), ldb, info )
subroutine ssymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SSYMM
subroutine ssyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SSYR2K
subroutine ssygs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
SSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorizatio...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
subroutine ssygst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
SSYGST
subroutine strsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRSM