108 SUBROUTINE cpotrf( UPLO, N, A, LDA, INFO )
128 parameter( one = 1.0e+0, cone = ( 1.0e+0, 0.0e+0 ) )
150 upper =
lsame( uplo,
'U' )
151 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
153 ELSE IF( n.LT.0 )
THEN
155 ELSE IF( lda.LT.max( 1, n ) )
THEN
159 CALL
xerbla(
'CPOTRF', -info )
170 nb =
ilaenv( 1,
'CPOTRF', uplo, n, -1, -1, -1 )
171 IF( nb.LE.1 .OR. nb.GE.n )
THEN
175 CALL
cpotf2( uplo, n, a, lda, info )
189 jb = min( nb, n-
j+1 )
190 CALL
cherk(
'Upper',
'Conjugate transpose', jb,
j-1,
191 $ -one, a( 1,
j ), lda, one, a(
j,
j ), lda )
192 CALL
cpotf2(
'Upper', jb, a(
j,
j ), lda, info )
199 CALL
cgemm(
'Conjugate transpose',
'No transpose', jb,
200 $ n-
j-jb+1,
j-1, -cone, a( 1,
j ), lda,
201 $ a( 1,
j+jb ), lda, cone, a(
j,
j+jb ),
203 CALL
ctrsm(
'Left',
'Upper',
'Conjugate transpose',
204 $
'Non-unit', jb, n-
j-jb+1, cone, a(
j,
j ),
205 $ lda, a(
j,
j+jb ), lda )
218 jb = min( nb, n-
j+1 )
219 CALL
cherk(
'Lower',
'No transpose', jb,
j-1, -one,
220 $ a(
j, 1 ), lda, one, a(
j,
j ), lda )
221 CALL
cpotf2(
'Lower', jb, a(
j,
j ), lda, info )
228 CALL
cgemm(
'No transpose',
'Conjugate transpose',
229 $ n-
j-jb+1, jb,
j-1, -cone, a(
j+jb, 1 ),
230 $ lda, a(
j, 1 ), lda, cone, a(
j+jb,
j ),
232 CALL
ctrsm(
'Right',
'Lower',
'Conjugate transpose',
233 $
'Non-unit', n-
j-jb+1, jb, cone, a(
j,
j ),
234 $ lda, a(
j+jb,
j ), lda )
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine cpotf2(UPLO, N, A, LDA, INFO)
CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK