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 sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine sspgst(ITYPE, UPLO, N, AP, BP, INFO)
SSPGST
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine stpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPMV
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2
subroutine sscal(N, SA, SX, INCX)
SSCAL