Julie
bc6a755be4
This is really old school, but a lot of times we have users sending us copy pasting of codes, and that is the only way to know the version of the code.
242 lines
6.3 KiB
FortranFixed
242 lines
6.3 KiB
FortranFixed
*> \brief \b CPPTRF
|
|
*
|
|
* =========== DOCUMENTATION ===========
|
|
*
|
|
* Online html documentation available at
|
|
* http://www.netlib.org/lapack/explore-html/
|
|
*
|
|
*> \htmlonly
|
|
*> Download CPPTRF + dependencies
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpptrf.f">
|
|
*> [TGZ]</a>
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpptrf.f">
|
|
*> [ZIP]</a>
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpptrf.f">
|
|
*> [TXT]</a>
|
|
*> \endhtmlonly
|
|
*
|
|
* Definition:
|
|
* ===========
|
|
*
|
|
* SUBROUTINE CPPTRF( UPLO, N, AP, INFO )
|
|
*
|
|
* .. Scalar Arguments ..
|
|
* CHARACTER UPLO
|
|
* INTEGER INFO, N
|
|
* ..
|
|
* .. Array Arguments ..
|
|
* COMPLEX AP( * )
|
|
* ..
|
|
*
|
|
*
|
|
*> \par Purpose:
|
|
* =============
|
|
*>
|
|
*> \verbatim
|
|
*>
|
|
*> CPPTRF computes the Cholesky factorization of a complex Hermitian
|
|
*> positive definite matrix A stored in packed format.
|
|
*>
|
|
*> The factorization has the form
|
|
*> A = U**H * U, if UPLO = 'U', or
|
|
*> A = L * L**H, if UPLO = 'L',
|
|
*> where U is an upper triangular matrix and L is lower triangular.
|
|
*> \endverbatim
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
*> \param[in] UPLO
|
|
*> \verbatim
|
|
*> UPLO is CHARACTER*1
|
|
*> = 'U': Upper triangle of A is stored;
|
|
*> = 'L': Lower triangle of A is stored.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] N
|
|
*> \verbatim
|
|
*> N is INTEGER
|
|
*> The order of the matrix A. N >= 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in,out] AP
|
|
*> \verbatim
|
|
*> AP is COMPLEX array, dimension (N*(N+1)/2)
|
|
*> On entry, the upper or lower triangle of the Hermitian matrix
|
|
*> A, packed columnwise in a linear array. The j-th column of A
|
|
*> is stored in the array AP as follows:
|
|
*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
|
|
*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
|
|
*> See below for further details.
|
|
*>
|
|
*> On exit, if INFO = 0, the triangular factor U or L from the
|
|
*> Cholesky factorization A = U**H*U or A = L*L**H, in the same
|
|
*> storage format as A.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] INFO
|
|
*> \verbatim
|
|
*> INFO is INTEGER
|
|
*> = 0: successful exit
|
|
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
|
*> > 0: if INFO = i, the leading minor of order i is not
|
|
*> positive definite, and the factorization could not be
|
|
*> completed.
|
|
*> \endverbatim
|
|
*
|
|
* Authors:
|
|
* ========
|
|
*
|
|
*> \author Univ. of Tennessee
|
|
*> \author Univ. of California Berkeley
|
|
*> \author Univ. of Colorado Denver
|
|
*> \author NAG Ltd.
|
|
*
|
|
*> \date December 2016
|
|
*
|
|
*> \ingroup complexOTHERcomputational
|
|
*
|
|
*> \par Further Details:
|
|
* =====================
|
|
*>
|
|
*> \verbatim
|
|
*>
|
|
*> The packed storage scheme is illustrated by the following example
|
|
*> when N = 4, UPLO = 'U':
|
|
*>
|
|
*> Two-dimensional storage of the Hermitian matrix A:
|
|
*>
|
|
*> a11 a12 a13 a14
|
|
*> a22 a23 a24
|
|
*> a33 a34 (aij = conjg(aji))
|
|
*> a44
|
|
*>
|
|
*> Packed storage of the upper triangle of A:
|
|
*>
|
|
*> AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
|
|
*> \endverbatim
|
|
*>
|
|
* =====================================================================
|
|
SUBROUTINE CPPTRF( UPLO, N, AP, INFO )
|
|
*
|
|
* -- LAPACK computational routine (version 3.7.0) --
|
|
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
|
* December 2016
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER UPLO
|
|
INTEGER INFO, N
|
|
* ..
|
|
* .. Array Arguments ..
|
|
COMPLEX AP( * )
|
|
* ..
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
REAL ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL UPPER
|
|
INTEGER J, JC, JJ
|
|
REAL AJJ
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
COMPLEX CDOTC
|
|
EXTERNAL LSAME, CDOTC
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL CHPR, CSSCAL, CTPSV, XERBLA
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC REAL, SQRT
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Test the input parameters.
|
|
*
|
|
INFO = 0
|
|
UPPER = LSAME( UPLO, 'U' )
|
|
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
|
|
INFO = -1
|
|
ELSE IF( N.LT.0 ) THEN
|
|
INFO = -2
|
|
END IF
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL XERBLA( 'CPPTRF', -INFO )
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Quick return if possible
|
|
*
|
|
IF( N.EQ.0 )
|
|
$ RETURN
|
|
*
|
|
IF( UPPER ) THEN
|
|
*
|
|
* Compute the Cholesky factorization A = U**H * U.
|
|
*
|
|
JJ = 0
|
|
DO 10 J = 1, N
|
|
JC = JJ + 1
|
|
JJ = JJ + J
|
|
*
|
|
* Compute elements 1:J-1 of column J.
|
|
*
|
|
IF( J.GT.1 )
|
|
$ CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit',
|
|
$ J-1, AP, AP( JC ), 1 )
|
|
*
|
|
* Compute U(J,J) and test for non-positive-definiteness.
|
|
*
|
|
AJJ = REAL( AP( JJ ) ) - CDOTC( J-1, AP( JC ), 1, AP( JC ),
|
|
$ 1 )
|
|
IF( AJJ.LE.ZERO ) THEN
|
|
AP( JJ ) = AJJ
|
|
GO TO 30
|
|
END IF
|
|
AP( JJ ) = SQRT( AJJ )
|
|
10 CONTINUE
|
|
ELSE
|
|
*
|
|
* Compute the Cholesky factorization A = L * L**H.
|
|
*
|
|
JJ = 1
|
|
DO 20 J = 1, N
|
|
*
|
|
* Compute L(J,J) and test for non-positive-definiteness.
|
|
*
|
|
AJJ = REAL( AP( JJ ) )
|
|
IF( AJJ.LE.ZERO ) THEN
|
|
AP( JJ ) = AJJ
|
|
GO TO 30
|
|
END IF
|
|
AJJ = SQRT( AJJ )
|
|
AP( JJ ) = AJJ
|
|
*
|
|
* Compute elements J+1:N of column J and update the trailing
|
|
* submatrix.
|
|
*
|
|
IF( J.LT.N ) THEN
|
|
CALL CSSCAL( N-J, ONE / AJJ, AP( JJ+1 ), 1 )
|
|
CALL CHPR( 'Lower', N-J, -ONE, AP( JJ+1 ), 1,
|
|
$ AP( JJ+N-J+1 ) )
|
|
JJ = JJ + N - J + 1
|
|
END IF
|
|
20 CONTINUE
|
|
END IF
|
|
GO TO 40
|
|
*
|
|
30 CONTINUE
|
|
INFO = J
|
|
*
|
|
40 CONTINUE
|
|
RETURN
|
|
*
|
|
* End of CPPTRF
|
|
*
|
|
END
|