1 SUBROUTINE dpotrf( UPLO, N, A, LDA, INFO )
13 DOUBLE PRECISION A( LDA, * )
65 parameter( one = 1.0d+0 )
74 EXTERNAL lsame, ilaenv
87 upper = lsame( uplo,
'U' )
88 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
90 ELSE IF( n.LT.0 )
THEN
92 ELSE IF( lda.LT.max( 1, n ) )
THEN
96 CALL xerbla(
'DPOTRF', -info )
107 nb = ilaenv( 1,
'DPOTRF', uplo, n, -1, -1, -1 )
108 IF( nb.LE.1 .OR. nb.GE.n )
THEN
112 CALL dpotf2( uplo, n, a, lda, info )
126 jb = min( nb, n-j+1 )
127 CALL dsyrk(
'Upper',
'Transpose', jb, j-1, -one,
128 $ a( 1, j ), lda, one, a( j, j ), lda )
129 CALL dpotf2(
'Upper', jb, a( j, j ), lda, info )
136 CALL dgemm(
'Transpose',
'No transpose', jb, n-j-jb+1,
137 $ j-1, -one, a( 1, j ), lda, a( 1, j+jb ),
138 $ lda, one, a( j, j+jb ), lda )
139 CALL dtrsm(
'Left',
'Upper',
'Transpose',
'Non-unit',
140 $ jb, n-j-jb+1, one, a( j, j ), lda,
141 $ a( j, j+jb ), lda )
154 jb = min( nb, n-j+1 )
155 CALL dsyrk(
'Lower',
'No transpose', jb, j-1, -one,
156 $ a( j, 1 ), lda, one, a( j, j ), lda )
157 CALL dpotf2(
'Lower', jb, a( j, j ), lda, info )
164 CALL dgemm(
'No transpose',
'Transpose', n-j-jb+1, jb,
165 $ j-1, -one, a( j+jb, 1 ), lda, a( j, 1 ),
166 $ lda, one, a( j+jb, j ), lda )
167 CALL dtrsm(
'Right',
'Lower',
'Transpose',
'Non-unit',
168 $ n-j-jb+1, jb, one, a( j, j ), lda,
169 $ a( j+jb, j ), lda )
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dpotf2(UPLO, N, A, LDA, INFO)
subroutine dpotrf(UPLO, N, A, LDA, INFO)
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
subroutine dtrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
subroutine xerbla(SRNAME, INFO)