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 xerbla(SRNAME, INFO)
XERBLA
subroutine dtpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPSV
subroutine dspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
DSPR2
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dtpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPMV
double precision function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dspgst(ITYPE, UPLO, N, AP, BP, INFO)
DSPGST
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY