137 SUBROUTINE zhetrf_aa( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
148 INTEGER N, LDA, LWORK, INFO
152 COMPLEX*16 A( lda, * ), WORK( * )
158 parameter ( zero = (0.0d+0, 0.0d+0), one = (1.0d+0, 0.0d+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
175 INTRINSIC dble, dconjg, max
181 nb = ilaenv( 1,
'ZHETRF', 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(
'ZHETRF_AA', -info )
206 ELSE IF( lquery )
THEN
217 a( 1, 1 ) = dble( a( 1, 1 ) )
218 IF ( a( 1, 1 ).EQ.zero )
THEN
226 IF( lwork.LT.((1+nb)*n) )
THEN
238 CALL zcopy( n, a( 1, 1 ), lda, work( 1 ), 1 )
257 jb = min( n-j1+1, nb )
263 $ a( max(1, j), j+1 ), lda,
264 $ ipiv( j+1 ), work, n, work( n*nb+1 ),
266 IF( (iinfo.GT.0) .AND. (info.EQ.0) )
THEN
272 DO j2 = j+2, min(n, j+jb+1)
273 ipiv( j2 ) = ipiv( j2 ) + j
274 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
275 CALL zswap( j1-k1-2, a( 1, j2 ), 1,
276 $ a( 1, ipiv(j2) ), 1 )
289 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
293 alpha = dconjg( a( j, j+1 ) )
295 CALL zcopy( n-j, a( j-1, j+1 ), lda,
296 $ work( (j+1-j1+1)+jb*n ), 1 )
297 CALL zscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
320 nj = min( nb, n-j2+1 )
326 CALL zgemm(
'Conjugate transpose',
'Transpose',
328 $ -one, a( j1-k2, j3 ), lda,
329 $ work( (j3-j1+1)+k1*n ), n,
330 $ one, a( j3, j3 ), lda )
336 CALL zgemm(
'Conjugate transpose',
'Transpose',
338 $ -one, a( j1-k2, j2 ), lda,
339 $ work( (j3-j1+1)+k1*n ), n,
340 $ one, a( j2, j3 ), lda )
345 a( j, j+1 ) = dconjg( alpha )
350 CALL zcopy( n-j, a( j+1, j+1 ), lda, work( 1 ), 1 )
362 CALL zcopy( n, a( 1, 1 ), 1, work( 1 ), 1 )
381 jb = min( n-j1+1, nb )
387 $ a( j+1, max(1, j) ), lda,
388 $ ipiv( j+1 ), work, n, work( n*nb+1 ), iinfo)
389 IF( (iinfo.GT.0) .AND. (info.EQ.0) )
THEN
395 DO j2 = j+2, min(n, j+jb+1)
396 ipiv( j2 ) = ipiv( j2 ) + j
397 IF( (j2.NE.ipiv(j2)) .AND. ((j1-k1).GT.2) )
THEN
398 CALL zswap( j1-k1-2, a( j2, 1 ), lda,
399 $ a( ipiv(j2), 1 ), lda )
412 IF( j1.GT.1 .OR. jb.GT.1 )
THEN
416 alpha = dconjg( a( j+1, j ) )
418 CALL zcopy( n-j, a( j+1, j-1 ), 1,
419 $ work( (j+1-j1+1)+jb*n ), 1 )
420 CALL zscal( n-j, alpha, work( (j+1-j1+1)+jb*n ), 1 )
443 nj = min( nb, n-j2+1 )
449 CALL zgemm(
'No transpose',
'Conjugate transpose',
451 $ -one, work( (j3-j1+1)+k1*n ), n,
452 $ a( j3, j1-k2 ), lda,
453 $ one, a( j3, j3 ), lda )
459 CALL zgemm(
'No transpose',
'Conjugate transpose',
461 $ -one, work( (j3-j1+1)+k1*n ), n,
462 $ a( j2, j1-k2 ), lda,
463 $ one, a( j3, j2 ), lda )
468 a( j+1, j ) = dconjg( alpha )
473 CALL zcopy( n-j, a( j+1, j+1 ), 1, work( 1 ), 1 )
subroutine zlahef_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
ZLAHEF_AA
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_AA
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL