1 SUBROUTINE dsygst( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
10 INTEGER INFO, ITYPE, LDA, LDB, N
13 DOUBLE PRECISION A( LDA, * ), B( LDB, * )
75 DOUBLE PRECISION ONE, HALF
76 parameter( one = 1.0d0, half = 0.5d0 )
91 EXTERNAL lsame, ilaenv
98 upper = lsame( uplo,
'U' )
99 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
101 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
103 ELSE IF( n.LT.0 )
THEN
105 ELSE IF( lda.LT.max( 1, n ) )
THEN
107 ELSE IF( ldb.LT.max( 1, n ) )
THEN
111 CALL xerbla(
'DSYGST', -info )
122 nb = ilaenv( 1,
'DSYGST', uplo, n, -1, -1, -1 )
124 IF( nb.LE.1 .OR. nb.GE.n )
THEN
128 CALL dsygs2( itype, uplo, n, a, lda, b, ldb, info )
133 IF( itype.EQ.1 )
THEN
139 kb = min( n-k+1, nb )
143 CALL dsygs2( itype, uplo, kb, a( k, k ), lda,
144 $ b( k, k ), ldb, info )
146 CALL dtrsm(
'Left', uplo,
'Transpose',
'Non-unit',
147 $ kb, n-k-kb+1, one, b( k, k ), ldb,
148 $ a( k, k+kb ), lda )
149 CALL dsymm(
'Left', uplo, kb, n-k-kb+1, -half,
150 $ a( k, k ), lda, b( k, k+kb ), ldb, one,
151 $ a( k, k+kb ), lda )
152 CALL dsyr2k( uplo,
'Transpose', n-k-kb+1, kb, -one,
153 $ a( k, k+kb ), lda, b( k, k+kb ), ldb,
154 $ one, a( k+kb, k+kb ), lda )
155 CALL dsymm(
'Left', uplo, kb, n-k-kb+1, -half,
156 $ a( k, k ), lda, b( k, k+kb ), ldb, one,
157 $ a( k, k+kb ), lda )
158 CALL dtrsm(
'Right', uplo,
'No transpose',
159 $
'Non-unit', kb, n-k-kb+1, one,
160 $ b( k+kb, k+kb ), ldb, a( k, k+kb ),
169 kb = min( n-k+1, nb )
173 CALL dsygs2( itype, uplo, kb, a( k, k ), lda,
174 $ b( k, k ), ldb, info )
176 CALL dtrsm(
'Right', uplo,
'Transpose',
'Non-unit',
177 $ n-k-kb+1, kb, one, b( k, k ), ldb,
178 $ a( k+kb, k ), lda )
179 CALL dsymm(
'Right', uplo, n-k-kb+1, kb, -half,
180 $ a( k, k ), lda, b( k+kb, k ), ldb, one,
181 $ a( k+kb, k ), lda )
182 CALL dsyr2k( uplo,
'No transpose', n-k-kb+1, kb,
183 $ -one, a( k+kb, k ), lda, b( k+kb, k ),
184 $ ldb, one, a( k+kb, k+kb ), lda )
185 CALL dsymm(
'Right', uplo, n-k-kb+1, kb, -half,
186 $ a( k, k ), lda, b( k+kb, k ), ldb, one,
187 $ a( k+kb, k ), lda )
188 CALL dtrsm(
'Left', uplo,
'No transpose',
189 $
'Non-unit', n-k-kb+1, kb, one,
190 $ b( k+kb, k+kb ), ldb, a( k+kb, k ),
201 kb = min( n-k+1, nb )
205 CALL dtrmm(
'Left', uplo,
'No transpose',
'Non-unit',
206 $ k-1, kb, one, b, ldb, a( 1, k ), lda )
207 CALL dsymm(
'Right', uplo, k-1, kb, half, a( k, k ),
208 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
209 CALL dsyr2k( uplo,
'No transpose', k-1, kb, one,
210 $ a( 1, k ), lda, b( 1, k ), ldb, one, a,
212 CALL dsymm(
'Right', uplo, k-1, kb, half, a( k, k ),
213 $ lda, b( 1, k ), ldb, one, a( 1, k ), lda )
214 CALL dtrmm(
'Right', uplo,
'Transpose',
'Non-unit',
215 $ k-1, kb, one, b( k, k ), ldb, a( 1, k ),
217 CALL dsygs2( itype, uplo, kb, a( k, k ), lda,
218 $ b( k, k ), ldb, info )
225 kb = min( n-k+1, nb )
229 CALL dtrmm(
'Right', uplo,
'No transpose',
'Non-unit',
230 $ kb, k-1, one, b, ldb, a( k, 1 ), lda )
231 CALL dsymm(
'Left', uplo, kb, k-1, half, a( k, k ),
232 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
233 CALL dsyr2k( uplo,
'Transpose', k-1, kb, one,
234 $ a( k, 1 ), lda, b( k, 1 ), ldb, one, a,
236 CALL dsymm(
'Left', uplo, kb, k-1, half, a( k, k ),
237 $ lda, b( k, 1 ), ldb, one, a( k, 1 ), lda )
238 CALL dtrmm(
'Left', uplo,
'Transpose',
'Non-unit', kb,
239 $ k-1, one, b( k, k ), ldb, a( k, 1 ), lda )
240 CALL dsygs2( itype, uplo, kb, a( k, k ), lda,
241 $ b( k, k ), ldb, info )
subroutine dsygs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
subroutine dsygst(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine xerbla(SRNAME, INFO)