114 SUBROUTINE dspgst( ITYPE, UPLO, N, AP, BP, INFO )
123 INTEGER info, itype, n
126 DOUBLE PRECISION ap( * ), bp( * )
132 DOUBLE PRECISION one, half
133 parameter( one = 1.0d0, half = 0.5d0 )
137 INTEGER j, j1, j1j1, jj, k, k1, k1k1, kk
138 DOUBLE PRECISION ajj, akk, bjj, bkk, ct
146 DOUBLE PRECISION ddot
154 upper =
lsame( uplo,
'U' )
155 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
157 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
159 ELSE IF( n.LT.0 )
THEN
163 CALL
xerbla(
'DSPGST', -info )
167 IF( itype.EQ.1 )
THEN
182 CALL
dtpsv( uplo,
'Transpose',
'Nonunit', j, bp,
184 CALL
dspmv( uplo, j-1, -one, ap, bp( j1 ), 1, one,
186 CALL
dscal( j-1, one / bjj, ap( j1 ), 1 )
187 ap( jj ) = ( ap( jj )-
ddot( j-1, ap( j1 ), 1, bp( j1 ),
198 k1k1 = kk + n - k + 1
207 CALL
dscal( n-k, one / bkk, ap( kk+1 ), 1 )
209 CALL
daxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
210 CALL
dspr2( uplo, n-k, -one, ap( kk+1 ), 1,
211 $ bp( kk+1 ), 1, ap( k1k1 ) )
212 CALL
daxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
213 CALL
dtpsv( uplo,
'No transpose',
'Non-unit', n-k,
214 $ bp( k1k1 ), ap( kk+1 ), 1 )
235 CALL
dtpmv( uplo,
'No transpose',
'Non-unit', k-1, bp,
238 CALL
daxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
239 CALL
dspr2( uplo, k-1, one, ap( k1 ), 1, bp( k1 ), 1,
241 CALL
daxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
242 CALL
dscal( k-1, bkk, ap( k1 ), 1 )
243 ap( kk ) = akk*bkk**2
253 j1j1 = jj + n - j + 1
259 ap( jj ) = ajj*bjj +
ddot( n-j, ap( jj+1 ), 1,
261 CALL
dscal( n-j, bjj, ap( jj+1 ), 1 )
262 CALL
dspmv( uplo, n-j, one, ap( j1j1 ), bp( jj+1 ), 1,
263 $ one, ap( jj+1 ), 1 )
264 CALL
dtpmv( uplo,
'Transpose',
'Non-unit', n-j+1,
265 $ bp( jj ), ap( jj ), 1 )