104 SUBROUTINE zpotrf( UPLO, N, A, LDA, INFO )
115 COMPLEX*16 A( LDA, * )
123 parameter( one = 1.0d+0, cone = ( 1.0d+0, 0.0d+0 ) )
132 EXTERNAL lsame, ilaenv
146 upper = lsame( uplo,
'U' )
147 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
149 ELSE IF( n.LT.0 )
THEN
151 ELSE IF( lda.LT.max( 1, n ) )
THEN
155 CALL xerbla(
'ZPOTRF', -info )
166 nb = ilaenv( 1,
'ZPOTRF', uplo, n, -1, -1, -1 )
167 IF( nb.LE.1 .OR. nb.GE.n )
THEN
171 CALL zpotrf2( uplo, n, a, lda, info )
185 jb = min( nb, n-j+1 )
186 CALL zherk(
'Upper',
'Conjugate transpose', jb, j-1,
187 $ -one, a( 1, j ), lda, one, a( j, j ), lda )
188 CALL zpotrf2(
'Upper', jb, a( j, j ), lda, info )
195 CALL zgemm(
'Conjugate transpose',
'No transpose',
197 $ n-j-jb+1, j-1, -cone, a( 1, j ), lda,
198 $ a( 1, j+jb ), lda, cone, a( j, j+jb ),
200 CALL ztrsm(
'Left',
'Upper',
'Conjugate transpose',
201 $
'Non-unit', jb, n-j-jb+1, cone, a( j, j ),
202 $ lda, a( j, j+jb ), lda )
215 jb = min( nb, n-j+1 )
216 CALL zherk(
'Lower',
'No transpose', jb, j-1, -one,
217 $ a( j, 1 ), lda, one, a( j, j ), lda )
218 CALL zpotrf2(
'Lower', jb, a( j, j ), lda, info )
225 CALL zgemm(
'No transpose',
'Conjugate transpose',
226 $ n-j-jb+1, jb, j-1, -cone, a( j+jb, 1 ),
227 $ lda, a( j, 1 ), lda, cone, a( j+jb, j ),
229 CALL ztrsm(
'Right',
'Lower',
230 $
'Conjugate transpose',
231 $
'Non-unit', n-j-jb+1, jb, cone, a( j, j ),
232 $ lda, a( j+jb, j ), lda )
subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMM
subroutine zherk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
ZHERK
subroutine ztrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
ZTRSM