137 SUBROUTINE csytrf_aa( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
148 INTEGER N, LDA, LWORK, INFO
152 COMPLEX 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,
'CSYTRF', 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(
'CSYTRF_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 ccopy( 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 cswap( 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 ccopy( n-j, a( j-1, j+1 ), lda,
295 $ work( (j+1-j1+1)+jb*n ), 1 )
296 CALL cscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
319 nj = min( nb, n-j2+1 )
325 CALL cgemv(
'No transpose', mj, jb+1,
326 $ -one, work( j3-j1+1+k1*n ), n,
328 $ one, a( j3, j3 ), lda )
334 CALL cgemm(
'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 ccopy( n-j, a( j+1, j+1 ), lda, work( 1 ), 1 )
360 CALL ccopy( 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 cswap( 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 ccopy( n-j, a( j+1, j-1 ), 1,
417 $ work( (j+1-j1+1)+jb*n ), 1 )
418 CALL cscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
441 nj = min( nb, n-j2+1 )
447 CALL cgemv(
'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 cgemm(
'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 ccopy( n-j, a( j+1, j+1 ), 1, work( 1 ), 1 )
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
CLASYF_AA
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM