114 SUBROUTINE sspgst( ITYPE, UPLO, N, AP, BP, INFO )
123 INTEGER INFO, ITYPE, N
126 REAL AP( * ), BP( * )
133 parameter ( one = 1.0, half = 0.5 )
137 INTEGER J, J1, J1J1, JJ, K, K1, K1K1, KK
138 REAL AJJ, AKK, BJJ, BKK, CT
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(
'SSPGST', -info )
167 IF( itype.EQ.1 )
THEN
182 CALL stpsv( uplo,
'Transpose',
'Nonunit', j, bp,
184 CALL sspmv( uplo, j-1, -one, ap, bp( j1 ), 1, one,
186 CALL sscal( j-1, one / bjj, ap( j1 ), 1 )
187 ap( jj ) = ( ap( jj )-sdot( j-1, ap( j1 ), 1, bp( j1 ),
198 k1k1 = kk + n - k + 1
207 CALL sscal( n-k, one / bkk, ap( kk+1 ), 1 )
209 CALL saxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
210 CALL sspr2( uplo, n-k, -one, ap( kk+1 ), 1,
211 $ bp( kk+1 ), 1, ap( k1k1 ) )
212 CALL saxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
213 CALL stpsv( uplo,
'No transpose',
'Non-unit', n-k,
214 $ bp( k1k1 ), ap( kk+1 ), 1 )
235 CALL stpmv( uplo,
'No transpose',
'Non-unit', k-1, bp,
238 CALL saxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
239 CALL sspr2( uplo, k-1, one, ap( k1 ), 1, bp( k1 ), 1,
241 CALL saxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
242 CALL sscal( k-1, bkk, ap( k1 ), 1 )
243 ap( kk ) = akk*bkk**2
253 j1j1 = jj + n - j + 1
259 ap( jj ) = ajj*bjj + sdot( n-j, ap( jj+1 ), 1,
261 CALL sscal( n-j, bjj, ap( jj+1 ), 1 )
262 CALL sspmv( uplo, n-j, one, ap( j1j1 ), bp( jj+1 ), 1,
263 $ one, ap( jj+1 ), 1 )
264 CALL stpmv( uplo,
'Transpose',
'Non-unit', n-j+1,
265 $ bp( jj ), ap( jj ), 1 )
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sspgst(ITYPE, UPLO, N, AP, BP, INFO)
SSPGST