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 )
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine dspgst(ITYPE, UPLO, N, AP, BP, INFO)
DSPGST
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPSV
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
DSPR2
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV