141 SUBROUTINE spstf2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
150 INTEGER INFO, LDA, N, RANK
154 REAL A( lda, * ), WORK( 2*n )
162 parameter( one = 1.0e+0, zero = 0.0e+0 )
165 REAL AJJ, SSTOP, STEMP
166 INTEGER I, ITEMP, J, PVT
171 LOGICAL LSAME, SISNAN
172 EXTERNAL slamch, lsame, sisnan
178 INTRINSIC max, sqrt, maxloc
185 upper = lsame( uplo,
'U' )
186 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
188 ELSE IF( n.LT.0 )
THEN
190 ELSE IF( lda.LT.max( 1, n ) )
THEN
194 CALL xerbla(
'SPSTF2', -info )
214 IF( a( i, i ).GT.ajj )
THEN
219 IF( ajj.EQ.zero.OR.sisnan( ajj ) )
THEN
227 IF( tol.LT.zero )
THEN
228 sstop = n * slamch(
'Epsilon' ) * ajj
252 work( i ) = work( i ) + a( j-1, i )**2
254 work( n+i ) = a( i, i ) - work( i )
259 itemp = maxloc( work( (n+j):(2*n) ), 1 )
262 IF( ajj.LE.sstop.OR.sisnan( ajj ) )
THEN
272 a( pvt, pvt ) = a( j, j )
273 CALL sswap( j-1, a( 1, j ), 1, a( 1, pvt ), 1 )
275 $
CALL sswap( n-pvt, a( j, pvt+1 ), lda,
276 $ a( pvt, pvt+1 ), lda )
277 CALL sswap( pvt-j-1, a( j, j+1 ), lda, a( j+1, pvt ), 1 )
282 work( j ) = work( pvt )
285 piv( pvt ) = piv( j )
295 CALL sgemv(
'Trans', j-1, n-j, -one, a( 1, j+1 ), lda,
296 $ a( 1, j ), 1, one, a( j, j+1 ), lda )
297 CALL sscal( n-j, one / ajj, a( j, j+1 ), lda )
315 work( i ) = work( i ) + a( i, j-1 )**2
317 work( n+i ) = a( i, i ) - work( i )
322 itemp = maxloc( work( (n+j):(2*n) ), 1 )
325 IF( ajj.LE.sstop.OR.sisnan( ajj ) )
THEN
335 a( pvt, pvt ) = a( j, j )
336 CALL sswap( j-1, a( j, 1 ), lda, a( pvt, 1 ), lda )
338 $
CALL sswap( n-pvt, a( pvt+1, j ), 1, a( pvt+1, pvt ),
340 CALL sswap( pvt-j-1, a( j+1, j ), 1, a( pvt, j+1 ), lda )
345 work( j ) = work( pvt )
348 piv( pvt ) = piv( j )
358 CALL sgemv(
'No Trans', n-j, j-1, -one, a( j+1, 1 ), lda,
359 $ a( j, 1 ), lda, one, a( j+1, j ), 1 )
360 CALL sscal( n-j, one / ajj, a( j+1, j ), 1 )
subroutine spstf2(UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO)
SPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric or complex Herm...
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sscal(N, SA, SX, INCX)
SSCAL