001:       SUBROUTINE DPOTF2( 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:       DOUBLE PRECISION   A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DPOTF2 computes the Cholesky factorization of a real symmetric
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: *          symmetric 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) DOUBLE PRECISION array, dimension (LDA,N)
042: *          On entry, the symmetric 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:       DOUBLE PRECISION   ONE, ZERO
067:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
068: *     ..
069: *     .. Local Scalars ..
070:       LOGICAL            UPPER
071:       INTEGER            J
072:       DOUBLE PRECISION   AJJ
073: *     ..
074: *     .. External Functions ..
075:       LOGICAL            LSAME, DISNAN
076:       DOUBLE PRECISION   DDOT
077:       EXTERNAL           LSAME, DDOT, DISNAN
078: *     ..
079: *     .. External Subroutines ..
080:       EXTERNAL           DGEMV, DSCAL, XERBLA
081: *     ..
082: *     .. Intrinsic Functions ..
083:       INTRINSIC          MAX, SQRT
084: *     ..
085: *     .. Executable Statements ..
086: *
087: *     Test the input parameters.
088: *
089:       INFO = 0
090:       UPPER = LSAME( UPLO, 'U' )
091:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
092:          INFO = -1
093:       ELSE IF( N.LT.0 ) THEN
094:          INFO = -2
095:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
096:          INFO = -4
097:       END IF
098:       IF( INFO.NE.0 ) THEN
099:          CALL XERBLA( 'DPOTF2', -INFO )
100:          RETURN
101:       END IF
102: *
103: *     Quick return if possible
104: *
105:       IF( N.EQ.0 )
106:      $   RETURN
107: *
108:       IF( UPPER ) THEN
109: *
110: *        Compute the Cholesky factorization A = U'*U.
111: *
112:          DO 10 J = 1, N
113: *
114: *           Compute U(J,J) and test for non-positive-definiteness.
115: *
116:             AJJ = A( J, J ) - DDOT( J-1, A( 1, J ), 1, A( 1, J ), 1 )
117:             IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
118:                A( J, J ) = AJJ
119:                GO TO 30
120:             END IF
121:             AJJ = SQRT( AJJ )
122:             A( J, J ) = AJJ
123: *
124: *           Compute elements J+1:N of row J.
125: *
126:             IF( J.LT.N ) THEN
127:                CALL DGEMV( 'Transpose', J-1, N-J, -ONE, A( 1, J+1 ),
128:      $                     LDA, A( 1, J ), 1, ONE, A( J, J+1 ), LDA )
129:                CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )
130:             END IF
131:    10    CONTINUE
132:       ELSE
133: *
134: *        Compute the Cholesky factorization A = L*L'.
135: *
136:          DO 20 J = 1, N
137: *
138: *           Compute L(J,J) and test for non-positive-definiteness.
139: *
140:             AJJ = A( J, J ) - DDOT( J-1, A( J, 1 ), LDA, A( J, 1 ),
141:      $            LDA )
142:             IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
143:                A( J, J ) = AJJ
144:                GO TO 30
145:             END IF
146:             AJJ = SQRT( AJJ )
147:             A( J, J ) = AJJ
148: *
149: *           Compute elements J+1:N of column J.
150: *
151:             IF( J.LT.N ) THEN
152:                CALL DGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ),
153:      $                     LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 )
154:                CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 )
155:             END IF
156:    20    CONTINUE
157:       END IF
158:       GO TO 40
159: *
160:    30 CONTINUE
161:       INFO = J
162: *
163:    40 CONTINUE
164:       RETURN
165: *
166: *     End of DPOTF2
167: *
168:       END
169: