137 SUBROUTINE dsytrf_aa( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
148 INTEGER N, LDA, LWORK, INFO
152 DOUBLE PRECISION A( lda, * ), WORK( * )
157 DOUBLE PRECISION ZERO, ONE
158 parameter ( zero = 0.0d+0, one = 1.0d+0 )
161 LOGICAL LQUERY, UPPER
162 INTEGER J, LWKOPT, IINFO
163 INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
164 DOUBLE PRECISION ALPHA
169 EXTERNAL lsame, ilaenv
181 nb = ilaenv( 1,
'DSYTRF', 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(
'DSYTRF_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 dcopy( 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 dswap( 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 dcopy( n-j, a( j-1, j+1 ), lda,
295 $ work( (j+1-j1+1)+jb*n ), 1 )
296 CALL dscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
319 nj = min( nb, n-j2+1 )
325 CALL dgemv(
'No transpose', mj, jb+1,
326 $ -one, work( j3-j1+1+k1*n ), n,
328 $ one, a( j3, j3 ), lda )
334 CALL dgemm(
'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 dcopy( n-j, a( j+1, j+1 ), lda, work( 1 ), 1 )
360 CALL dcopy( 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 dswap( 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 dcopy( n-j, a( j+1, j-1 ), 1,
417 $ work( (j+1-j1+1)+jb*n ), 1 )
418 CALL dscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
441 nj = min( nb, n-j2+1 )
447 CALL dgemv(
'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 dgemm(
'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 dcopy( n-j, a( j+1, j+1 ), 1, work( 1 ), 1 )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
DLASYF_AA