1 SUBROUTINE dsygs2( 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 )
81 DOUBLE PRECISION AKK, BKK, CT
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(
'DSYGS2', -info )
115 IF( itype.EQ.1 )
THEN
129 CALL dscal( n-k, one / bkk, a( k, k+1 ), lda )
131 CALL daxpy( n-k, ct, b( k, k+1 ), ldb, a( k, k+1 ),
133 CALL dsyr2( uplo, n-k, -one, a( k, k+1 ), lda,
134 $ b( k, k+1 ), ldb, a( k+1, k+1 ), lda )
135 CALL daxpy( n-k, ct, b( k, k+1 ), ldb, a( k, k+1 ),
137 CALL dtrsv( uplo,
'Transpose',
'Non-unit', n-k,
138 $ b( k+1, k+1 ), ldb, a( k, k+1 ), lda )
154 CALL dscal( n-k, one / bkk, a( k+1, k ), 1 )
156 CALL daxpy( n-k, ct, b( k+1, k ), 1, a( k+1, k ), 1 )
157 CALL dsyr2( uplo, n-k, -one, a( k+1, k ), 1,
158 $ b( k+1, k ), 1, a( k+1, k+1 ), lda )
159 CALL daxpy( n-k, ct, b( k+1, k ), 1, a( k+1, k ), 1 )
160 CALL dtrsv( uplo,
'No transpose',
'Non-unit', n-k,
161 $ b( k+1, k+1 ), ldb, a( k+1, k ), 1 )
176 CALL dtrmv( uplo,
'No transpose',
'Non-unit', k-1, b,
177 $ ldb, a( 1, k ), 1 )
179 CALL daxpy( k-1, ct, b( 1, k ), 1, a( 1, k ), 1 )
180 CALL dsyr2( uplo, k-1, one, a( 1, k ), 1, b( 1, k ), 1,
182 CALL daxpy( k-1, ct, b( 1, k ), 1, a( 1, k ), 1 )
183 CALL dscal( k-1, bkk, a( 1, k ), 1 )
184 a( k, k ) = akk*bkk**2
196 CALL dtrmv( uplo,
'Transpose',
'Non-unit', k-1, b, ldb,
199 CALL daxpy( k-1, ct, b( k, 1 ), ldb, a( k, 1 ), lda )
200 CALL dsyr2( uplo, k-1, one, a( k, 1 ), lda, b( k, 1 ),
202 CALL daxpy( k-1, ct, b( k, 1 ), ldb, a( k, 1 ), lda )
203 CALL dscal( k-1, bkk, a( k, 1 ), lda )
204 a( k, k ) = akk*bkk**2
subroutine daxpy(n, da, dx, incx, dy, incy)
subroutine dscal(n, da, dx, incx)
subroutine dsygs2(ITYPE, UPLO, N, A, LDA, B, LDB, INFO)
subroutine dsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine dtrsv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
subroutine xerbla(SRNAME, INFO)