137 SUBROUTINE ssytrf_aa( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
148 INTEGER N, LDA, LWORK, INFO
152 REAL A( lda, * ), WORK( * )
158 parameter ( zero = 0.0e+0, one = 1.0e+0 )
161 LOGICAL LQUERY, UPPER
162 INTEGER J, LWKOPT, IINFO
163 INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
169 EXTERNAL lsame, ilaenv
181 nb = ilaenv( 1,
'SSYTRF', uplo, n, -1, -1, -1 )
186 upper = lsame( uplo,
'U' )
187 lquery = ( lwork.EQ.-1 )
188 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
190 ELSE IF( n.LT.0 )
THEN
192 ELSE IF( lda.LT.max( 1, n ) )
THEN
194 ELSE IF( lwork.LT.max( 1, 2*n ) .AND. .NOT.lquery )
THEN
204 CALL xerbla(
'SSYTRF_AA', -info )
206 ELSE IF( lquery )
THEN
217 IF ( a( 1, 1 ).EQ.zero )
THEN
225 IF( lwork.LT.((1+nb)*n) )
THEN
237 CALL scopy( n, a( 1, 1 ), lda, work( 1 ), 1 )
256 jb = min( n-j1+1, nb )
262 $ a( max(1, j), j+1 ), lda,
263 $ ipiv( j+1 ), work, n, work( n*nb+1 ),
265 IF( (iinfo.GT.0) .AND. (info.EQ.0) )
THEN
271 DO j2 = j+2, min(n, j+jb+1)
272 ipiv( j2 ) = ipiv( j2 ) + j
273 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
274 CALL sswap( j1-k1-2, a( 1, j2 ), 1,
275 $ a( 1, ipiv(j2) ), 1 )
288 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
294 CALL scopy( n-j, a( j-1, j+1 ), lda,
295 $ work( (j+1-j1+1)+jb*n ), 1 )
296 CALL sscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
319 nj = min( nb, n-j2+1 )
325 CALL sgemv(
'No transpose', mj, jb+1,
326 $ -one, work( j3-j1+1+k1*n ), n,
328 $ one, a( j3, j3 ), lda )
334 CALL sgemm(
'Transpose',
'Transpose',
336 $ -one, a( j1-k2, j2 ), lda,
337 $ work( j3-j1+1+k1*n ), n,
338 $ one, a( j2, j3 ), lda )
348 CALL scopy( n-j, a( j+1, j+1 ), lda, work( 1 ), 1 )
360 CALL scopy( n, a( 1, 1 ), 1, work( 1 ), 1 )
379 jb = min( n-j1+1, nb )
385 $ a( j+1, max(1, j) ), lda,
386 $ ipiv( j+1 ), work, n, work( n*nb+1 ), iinfo)
387 IF( (iinfo.GT.0) .AND. (info.EQ.0) )
THEN
393 DO j2 = j+2, min(n, j+jb+1)
394 ipiv( j2 ) = ipiv( j2 ) + j
395 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
396 CALL sswap( j1-k1-2, a( j2, 1 ), lda,
397 $ a( ipiv(j2), 1 ), lda )
410 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
416 CALL scopy( n-j, a( j+1, j-1 ), 1,
417 $ work( (j+1-j1+1)+jb*n ), 1 )
418 CALL sscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
441 nj = min( nb, n-j2+1 )
447 CALL sgemv(
'No transpose', mj, jb+1,
448 $ -one, work( j3-j1+1+k1*n ), n,
449 $ a( j3, j1-k2 ), lda,
450 $ one, a( j3, j3 ), 1 )
456 CALL sgemm(
'No transpose',
'Transpose',
458 $ -one, work( j3-j1+1+k1*n ), n,
459 $ a( j2, j1-k2 ), lda,
460 $ one, a( j3, j2 ), lda )
470 CALL scopy( n-j, a( j+1, j+1 ), 1, work( 1 ), 1 )
subroutine ssytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_AA
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
SLASYF_AA