131 SUBROUTINE chetrf_aa( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
141 INTEGER N, LDA, LWORK, INFO
145 COMPLEX A( LDA, * ), WORK( * )
151 parameter( zero = (0.0e+0, 0.0e+0), one = (1.0e+0, 0.0e+0) )
154 LOGICAL LQUERY, UPPER
156 INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
162 EXTERNAL lsame, ilaenv
168 INTRINSIC real, conjg, max
174 nb = ilaenv( 1,
'CHETRF_AA', uplo, n, -1, -1, -1 )
179 upper = lsame( uplo,
'U' )
180 lquery = ( lwork.EQ.-1 )
181 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
183 ELSE IF( n.LT.0 )
THEN
185 ELSE IF( lda.LT.max( 1, n ) )
THEN
187 ELSE IF( lwork.LT.( 2*n ) .AND. .NOT.lquery )
THEN
197 CALL xerbla(
'CHETRF_AA', -info )
199 ELSE IF( lquery )
THEN
210 a( 1, 1 ) = real( a( 1, 1 ) )
216 IF( lwork.LT.((1+nb)*n) )
THEN
228 CALL ccopy( n, a( 1, 1 ), lda, work( 1 ), 1 )
247 jb = min( n-j1+1, nb )
253 $ a( max(1, j), j+1 ), lda,
254 $ ipiv( j+1 ), work, n, work( n*nb+1 ) )
258 DO j2 = j+2, min(n, j+jb+1)
259 ipiv( j2 ) = ipiv( j2 ) + j
260 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
261 CALL cswap( j1-k1-2, a( 1, j2 ), 1,
262 $ a( 1, ipiv(j2) ), 1 )
275 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
279 alpha = conjg( a( j, j+1 ) )
281 CALL ccopy( n-j, a( j-1, j+1 ), lda,
282 $ work( (j+1-j1+1)+jb*n ), 1 )
283 CALL cscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
306 nj = min( nb, n-j2+1 )
312 CALL cgemm(
'Conjugate transpose',
'Transpose',
314 $ -one, a( j1-k2, j3 ), lda,
315 $ work( (j3-j1+1)+k1*n ), n,
316 $ one, a( j3, j3 ), lda )
322 CALL cgemm(
'Conjugate transpose',
'Transpose',
324 $ -one, a( j1-k2, j2 ), lda,
325 $ work( (j3-j1+1)+k1*n ), n,
326 $ one, a( j2, j3 ), lda )
331 a( j, j+1 ) = conjg( alpha )
336 CALL ccopy( n-j, a( j+1, j+1 ), lda, work( 1 ), 1 )
348 CALL ccopy( n, a( 1, 1 ), 1, work( 1 ), 1 )
367 jb = min( n-j1+1, nb )
373 $ a( j+1, max(1, j) ), lda,
374 $ ipiv( j+1 ), work, n, work( n*nb+1 ) )
378 DO j2 = j+2, min(n, j+jb+1)
379 ipiv( j2 ) = ipiv( j2 ) + j
380 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
381 CALL cswap( j1-k1-2, a( j2, 1 ), lda,
382 $ a( ipiv(j2), 1 ), lda )
395 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
399 alpha = conjg( a( j+1, j ) )
401 CALL ccopy( n-j, a( j+1, j-1 ), 1,
402 $ work( (j+1-j1+1)+jb*n ), 1 )
403 CALL cscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
426 nj = min( nb, n-j2+1 )
432 CALL cgemm(
'No transpose',
'Conjugate transpose',
434 $ -one, work( (j3-j1+1)+k1*n ), n,
435 $ a( j3, j1-k2 ), lda,
436 $ one, a( j3, j3 ), lda )
442 CALL cgemm(
'No transpose',
'Conjugate transpose',
444 $ -one, work( (j3-j1+1)+k1*n ), n,
445 $ a( j2, j1-k2 ), lda,
446 $ one, a( j3, j2 ), lda )
451 a( j+1, j ) = conjg( alpha )
456 CALL ccopy( n-j, a( j+1, j+1 ), 1, work( 1 ), 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
subroutine clahef_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK)
CLAHEF_AA