```001:       SUBROUTINE CPOTF2( UPLO, N, A, LDA, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       CHARACTER          UPLO
010:       INTEGER            INFO, LDA, N
011: *     ..
012: *     .. Array Arguments ..
013:       COMPLEX            A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  CPOTF2 computes the Cholesky factorization of a complex Hermitian
020: *  positive definite matrix A.
021: *
022: *  The factorization has the form
023: *     A = U' * U ,  if UPLO = 'U', or
024: *     A = L  * L',  if UPLO = 'L',
025: *  where U is an upper triangular matrix and L is lower triangular.
026: *
027: *  This is the unblocked version of the algorithm, calling Level 2 BLAS.
028: *
029: *  Arguments
030: *  =========
031: *
032: *  UPLO    (input) CHARACTER*1
033: *          Specifies whether the upper or lower triangular part of the
034: *          Hermitian matrix A is stored.
035: *          = 'U':  Upper triangular
036: *          = 'L':  Lower triangular
037: *
038: *  N       (input) INTEGER
039: *          The order of the matrix A.  N >= 0.
040: *
041: *  A       (input/output) COMPLEX array, dimension (LDA,N)
042: *          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
043: *          n by n upper triangular part of A contains the upper
044: *          triangular part of the matrix A, and the strictly lower
045: *          triangular part of A is not referenced.  If UPLO = 'L', the
046: *          leading n by n lower triangular part of A contains the lower
047: *          triangular part of the matrix A, and the strictly upper
048: *          triangular part of A is not referenced.
049: *
050: *          On exit, if INFO = 0, the factor U or L from the Cholesky
051: *          factorization A = U'*U  or A = L*L'.
052: *
053: *  LDA     (input) INTEGER
054: *          The leading dimension of the array A.  LDA >= max(1,N).
055: *
056: *  INFO    (output) INTEGER
057: *          = 0: successful exit
058: *          < 0: if INFO = -k, the k-th argument had an illegal value
059: *          > 0: if INFO = k, the leading minor of order k is not
060: *               positive definite, and the factorization could not be
061: *               completed.
062: *
063: *  =====================================================================
064: *
065: *     .. Parameters ..
066:       REAL               ONE, ZERO
067:       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
068:       COMPLEX            CONE
069:       PARAMETER          ( CONE = ( 1.0E+0, 0.0E+0 ) )
070: *     ..
071: *     .. Local Scalars ..
072:       LOGICAL            UPPER
073:       INTEGER            J
074:       REAL               AJJ
075: *     ..
076: *     .. External Functions ..
077:       LOGICAL            LSAME, SISNAN
078:       COMPLEX            CDOTC
079:       EXTERNAL           LSAME, CDOTC, SISNAN
080: *     ..
081: *     .. External Subroutines ..
082:       EXTERNAL           CGEMV, CLACGV, CSSCAL, XERBLA
083: *     ..
084: *     .. Intrinsic Functions ..
085:       INTRINSIC          MAX, REAL, SQRT
086: *     ..
087: *     .. Executable Statements ..
088: *
089: *     Test the input parameters.
090: *
091:       INFO = 0
092:       UPPER = LSAME( UPLO, 'U' )
093:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
094:          INFO = -1
095:       ELSE IF( N.LT.0 ) THEN
096:          INFO = -2
097:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
098:          INFO = -4
099:       END IF
100:       IF( INFO.NE.0 ) THEN
101:          CALL XERBLA( 'CPOTF2', -INFO )
102:          RETURN
103:       END IF
104: *
105: *     Quick return if possible
106: *
107:       IF( N.EQ.0 )
108:      \$   RETURN
109: *
110:       IF( UPPER ) THEN
111: *
112: *        Compute the Cholesky factorization A = U'*U.
113: *
114:          DO 10 J = 1, N
115: *
116: *           Compute U(J,J) and test for non-positive-definiteness.
117: *
118:             AJJ = REAL( A( J, J ) ) - CDOTC( J-1, A( 1, J ), 1,
119:      \$            A( 1, J ), 1 )
120:             IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
121:                A( J, J ) = AJJ
122:                GO TO 30
123:             END IF
124:             AJJ = SQRT( AJJ )
125:             A( J, J ) = AJJ
126: *
127: *           Compute elements J+1:N of row J.
128: *
129:             IF( J.LT.N ) THEN
130:                CALL CLACGV( J-1, A( 1, J ), 1 )
131:                CALL CGEMV( 'Transpose', J-1, N-J, -CONE, A( 1, J+1 ),
132:      \$                     LDA, A( 1, J ), 1, CONE, A( J, J+1 ), LDA )
133:                CALL CLACGV( J-1, A( 1, J ), 1 )
134:                CALL CSSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
135:             END IF
136:    10    CONTINUE
137:       ELSE
138: *
139: *        Compute the Cholesky factorization A = L*L'.
140: *
141:          DO 20 J = 1, N
142: *
143: *           Compute L(J,J) and test for non-positive-definiteness.
144: *
145:             AJJ = REAL( A( J, J ) ) - CDOTC( J-1, A( J, 1 ), LDA,
146:      \$            A( J, 1 ), LDA )
147:             IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
148:                A( J, J ) = AJJ
149:                GO TO 30
150:             END IF
151:             AJJ = SQRT( AJJ )
152:             A( J, J ) = AJJ
153: *
154: *           Compute elements J+1:N of column J.
155: *
156:             IF( J.LT.N ) THEN
157:                CALL CLACGV( J-1, A( J, 1 ), LDA )
158:                CALL CGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, 1 ),
159:      \$                     LDA, A( J, 1 ), LDA, CONE, A( J+1, J ), 1 )
160:                CALL CLACGV( J-1, A( J, 1 ), LDA )
161:                CALL CSSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
162:             END IF
163:    20    CONTINUE
164:       END IF
165:       GO TO 40
166: *
167:    30 CONTINUE
168:       INFO = J
169: *
170:    40 CONTINUE
171:       RETURN
172: *
173: *     End of CPOTF2
174: *
175:       END
176: ```