Return to dpotrf.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de lapack.

    1: *> \brief \b DPOTRF
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download DPOTRF + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpotrf.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpotrf.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpotrf.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
   22: * 
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          UPLO
   25: *       INTEGER            INFO, LDA, N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       DOUBLE PRECISION   A( LDA, * )
   29: *       ..
   30: *  
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> DPOTRF computes the Cholesky factorization of a real symmetric
   38: *> positive definite matrix A.
   39: *>
   40: *> The factorization has the form
   41: *>    A = U**T * U,  if UPLO = 'U', or
   42: *>    A = L  * L**T,  if UPLO = 'L',
   43: *> where U is an upper triangular matrix and L is lower triangular.
   44: *>
   45: *> This is the block version of the algorithm, calling Level 3 BLAS.
   46: *> \endverbatim
   47: *
   48: *  Arguments:
   49: *  ==========
   50: *
   51: *> \param[in] UPLO
   52: *> \verbatim
   53: *>          UPLO is CHARACTER*1
   54: *>          = 'U':  Upper triangle of A is stored;
   55: *>          = 'L':  Lower triangle of A is stored.
   56: *> \endverbatim
   57: *>
   58: *> \param[in] N
   59: *> \verbatim
   60: *>          N is INTEGER
   61: *>          The order of the matrix A.  N >= 0.
   62: *> \endverbatim
   63: *>
   64: *> \param[in,out] A
   65: *> \verbatim
   66: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
   67: *>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
   68: *>          N-by-N upper triangular part of A contains the upper
   69: *>          triangular part of the matrix A, and the strictly lower
   70: *>          triangular part of A is not referenced.  If UPLO = 'L', the
   71: *>          leading N-by-N lower triangular part of A contains the lower
   72: *>          triangular part of the matrix A, and the strictly upper
   73: *>          triangular part of A is not referenced.
   74: *>
   75: *>          On exit, if INFO = 0, the factor U or L from the Cholesky
   76: *>          factorization A = U**T*U or A = L*L**T.
   77: *> \endverbatim
   78: *>
   79: *> \param[in] LDA
   80: *> \verbatim
   81: *>          LDA is INTEGER
   82: *>          The leading dimension of the array A.  LDA >= max(1,N).
   83: *> \endverbatim
   84: *>
   85: *> \param[out] INFO
   86: *> \verbatim
   87: *>          INFO is INTEGER
   88: *>          = 0:  successful exit
   89: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
   90: *>          > 0:  if INFO = i, the leading minor of order i is not
   91: *>                positive definite, and the factorization could not be
   92: *>                completed.
   93: *> \endverbatim
   94: *
   95: *  Authors:
   96: *  ========
   97: *
   98: *> \author Univ. of Tennessee 
   99: *> \author Univ. of California Berkeley 
  100: *> \author Univ. of Colorado Denver 
  101: *> \author NAG Ltd. 
  102: *
  103: *> \date November 2011
  104: *
  105: *> \ingroup doublePOcomputational
  106: *
  107: *  =====================================================================
  108:       SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
  109: *
  110: *  -- LAPACK computational routine (version 3.4.0) --
  111: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  112: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  113: *     November 2011
  114: *
  115: *     .. Scalar Arguments ..
  116:       CHARACTER          UPLO
  117:       INTEGER            INFO, LDA, N
  118: *     ..
  119: *     .. Array Arguments ..
  120:       DOUBLE PRECISION   A( LDA, * )
  121: *     ..
  122: *
  123: *  =====================================================================
  124: *
  125: *     .. Parameters ..
  126:       DOUBLE PRECISION   ONE
  127:       PARAMETER          ( ONE = 1.0D+0 )
  128: *     ..
  129: *     .. Local Scalars ..
  130:       LOGICAL            UPPER
  131:       INTEGER            J, JB, NB
  132: *     ..
  133: *     .. External Functions ..
  134:       LOGICAL            LSAME
  135:       INTEGER            ILAENV
  136:       EXTERNAL           LSAME, ILAENV
  137: *     ..
  138: *     .. External Subroutines ..
  139:       EXTERNAL           DGEMM, DPOTF2, DSYRK, DTRSM, XERBLA
  140: *     ..
  141: *     .. Intrinsic Functions ..
  142:       INTRINSIC          MAX, MIN
  143: *     ..
  144: *     .. Executable Statements ..
  145: *
  146: *     Test the input parameters.
  147: *
  148:       INFO = 0
  149:       UPPER = LSAME( UPLO, 'U' )
  150:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  151:          INFO = -1
  152:       ELSE IF( N.LT.0 ) THEN
  153:          INFO = -2
  154:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  155:          INFO = -4
  156:       END IF
  157:       IF( INFO.NE.0 ) THEN
  158:          CALL XERBLA( 'DPOTRF', -INFO )
  159:          RETURN
  160:       END IF
  161: *
  162: *     Quick return if possible
  163: *
  164:       IF( N.EQ.0 )
  165:      $   RETURN
  166: *
  167: *     Determine the block size for this environment.
  168: *
  169:       NB = ILAENV( 1, 'DPOTRF', UPLO, N, -1, -1, -1 )
  170:       IF( NB.LE.1 .OR. NB.GE.N ) THEN
  171: *
  172: *        Use unblocked code.
  173: *
  174:          CALL DPOTF2( UPLO, N, A, LDA, INFO )
  175:       ELSE
  176: *
  177: *        Use blocked code.
  178: *
  179:          IF( UPPER ) THEN
  180: *
  181: *           Compute the Cholesky factorization A = U**T*U.
  182: *
  183:             DO 10 J = 1, N, NB
  184: *
  185: *              Update and factorize the current diagonal block and test
  186: *              for non-positive-definiteness.
  187: *
  188:                JB = MIN( NB, N-J+1 )
  189:                CALL DSYRK( 'Upper', 'Transpose', JB, J-1, -ONE,
  190:      $                     A( 1, J ), LDA, ONE, A( J, J ), LDA )
  191:                CALL DPOTF2( 'Upper', JB, A( J, J ), LDA, INFO )
  192:                IF( INFO.NE.0 )
  193:      $            GO TO 30
  194:                IF( J+JB.LE.N ) THEN
  195: *
  196: *                 Compute the current block row.
  197: *
  198:                   CALL DGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1,
  199:      $                        J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ),
  200:      $                        LDA, ONE, A( J, J+JB ), LDA )
  201:                   CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit',
  202:      $                        JB, N-J-JB+1, ONE, A( J, J ), LDA,
  203:      $                        A( J, J+JB ), LDA )
  204:                END IF
  205:    10       CONTINUE
  206: *
  207:          ELSE
  208: *
  209: *           Compute the Cholesky factorization A = L*L**T.
  210: *
  211:             DO 20 J = 1, N, NB
  212: *
  213: *              Update and factorize the current diagonal block and test
  214: *              for non-positive-definiteness.
  215: *
  216:                JB = MIN( NB, N-J+1 )
  217:                CALL DSYRK( 'Lower', 'No transpose', JB, J-1, -ONE,
  218:      $                     A( J, 1 ), LDA, ONE, A( J, J ), LDA )
  219:                CALL DPOTF2( 'Lower', JB, A( J, J ), LDA, INFO )
  220:                IF( INFO.NE.0 )
  221:      $            GO TO 30
  222:                IF( J+JB.LE.N ) THEN
  223: *
  224: *                 Compute the current block column.
  225: *
  226:                   CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB,
  227:      $                        J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ),
  228:      $                        LDA, ONE, A( J+JB, J ), LDA )
  229:                   CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit',
  230:      $                        N-J-JB+1, JB, ONE, A( J, J ), LDA,
  231:      $                        A( J+JB, J ), LDA )
  232:                END IF
  233:    20       CONTINUE
  234:          END IF
  235:       END IF
  236:       GO TO 40
  237: *
  238:    30 CONTINUE
  239:       INFO = INFO + J - 1
  240: *
  241:    40 CONTINUE
  242:       RETURN
  243: *
  244: *     End of DPOTRF
  245: *
  246:       END