134 SUBROUTINE spst01( UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM,
135 $ piv, rwork, resid, rank )
144 INTEGER lda, ldafac, ldperm, n, rank
148 REAL a( lda, * ), afac( ldafac, * ),
149 $ perm( ldperm, * ), rwork( * )
157 parameter( zero = 0.0e+0, one = 1.0e+0 )
186 anorm =
slansy(
'1', uplo, n, a, lda, rwork )
187 IF( anorm.LE.zero )
THEN
194 IF(
lsame( uplo,
'U' ) )
THEN
197 DO 110
j = rank + 1, n
198 DO 100 i = rank + 1,
j
208 t =
sdot( k, afac( 1, k ), 1, afac( 1, k ), 1 )
213 CALL
strmv(
'Upper',
'Transpose',
'Non-unit', k-1, afac,
214 $ ldafac, afac( 1, k ), 1 )
223 DO 140
j = rank + 1, n
235 $ CALL
ssyr(
'Lower', n-k, one, afac( k+1, k ), 1,
236 $ afac( k+1, k+1 ), ldafac )
241 CALL
sscal( n-k+1, t, afac( k, k ), 1 )
248 IF(
lsame( uplo,
'U' ) )
THEN
252 IF( piv( i ).LE.piv(
j ) )
THEN
254 perm( piv( i ), piv(
j ) ) = afac( i,
j )
256 perm( piv( i ), piv(
j ) ) = afac(
j, i )
267 IF( piv( i ).GE.piv(
j ) )
THEN
269 perm( piv( i ), piv(
j ) ) = afac( i,
j )
271 perm( piv( i ), piv(
j ) ) = afac(
j, i )
281 IF(
lsame( uplo,
'U' ) )
THEN
284 perm( i,
j ) = perm( i,
j ) - a( i,
j )
290 perm( i,
j ) = perm( i,
j ) - a( i,
j )
298 resid =
slansy(
'1', uplo, n, perm, ldafac, rwork )
300 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
logical function lsame(CA, CB)
LSAME
subroutine spst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
SPST01
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine ssyr(UPLO, N, ALPHA, X, INCX, A, LDA)
SSYR
subroutine sscal(N, SA, SX, INCX)
SSCAL