Return to zpotrf.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence.

    1: *> \brief \b ZPOTRF
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZPOTRF + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpotrf.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpotrf.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpotrf.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO )
   22: * 
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          UPLO
   25: *       INTEGER            INFO, LDA, N
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       COMPLEX*16         A( LDA, * )
   29: *       ..
   30: *  
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> ZPOTRF computes the Cholesky factorization of a complex Hermitian
   38: *> positive definite matrix A.
   39: *>
   40: *> The factorization has the form
   41: *>    A = U**H * U,  if UPLO = 'U', or
   42: *>    A = L  * L**H,  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 COMPLEX*16 array, dimension (LDA,N)
   67: *>          On entry, the Hermitian 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**H *U or A = L*L**H.
   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 2015
  104: *
  105: *> \ingroup complex16POcomputational
  106: *
  107: *  =====================================================================
  108:       SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO )
  109: *
  110: *  -- LAPACK computational routine (version 3.6.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 2015
  114: *
  115: *     .. Scalar Arguments ..
  116:       CHARACTER          UPLO
  117:       INTEGER            INFO, LDA, N
  118: *     ..
  119: *     .. Array Arguments ..
  120:       COMPLEX*16         A( LDA, * )
  121: *     ..
  122: *
  123: *  =====================================================================
  124: *
  125: *     .. Parameters ..
  126:       DOUBLE PRECISION   ONE
  127:       COMPLEX*16         CONE
  128:       PARAMETER          ( ONE = 1.0D+0, CONE = ( 1.0D+0, 0.0D+0 ) )
  129: *     ..
  130: *     .. Local Scalars ..
  131:       LOGICAL            UPPER
  132:       INTEGER            J, JB, NB
  133: *     ..
  134: *     .. External Functions ..
  135:       LOGICAL            LSAME
  136:       INTEGER            ILAENV
  137:       EXTERNAL           LSAME, ILAENV
  138: *     ..
  139: *     .. External Subroutines ..
  140:       EXTERNAL           XERBLA, ZGEMM, ZHERK, ZPOTRF2, ZTRSM
  141: *     ..
  142: *     .. Intrinsic Functions ..
  143:       INTRINSIC          MAX, MIN
  144: *     ..
  145: *     .. Executable Statements ..
  146: *
  147: *     Test the input parameters.
  148: *
  149:       INFO = 0
  150:       UPPER = LSAME( UPLO, 'U' )
  151:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  152:          INFO = -1
  153:       ELSE IF( N.LT.0 ) THEN
  154:          INFO = -2
  155:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  156:          INFO = -4
  157:       END IF
  158:       IF( INFO.NE.0 ) THEN
  159:          CALL XERBLA( 'ZPOTRF', -INFO )
  160:          RETURN
  161:       END IF
  162: *
  163: *     Quick return if possible
  164: *
  165:       IF( N.EQ.0 )
  166:      $   RETURN
  167: *
  168: *     Determine the block size for this environment.
  169: *
  170:       NB = ILAENV( 1, 'ZPOTRF', UPLO, N, -1, -1, -1 )
  171:       IF( NB.LE.1 .OR. NB.GE.N ) THEN
  172: *
  173: *        Use unblocked code.
  174: *
  175:          CALL ZPOTRF2( UPLO, N, A, LDA, INFO )
  176:       ELSE
  177: *
  178: *        Use blocked code.
  179: *
  180:          IF( UPPER ) THEN
  181: *
  182: *           Compute the Cholesky factorization A = U**H *U.
  183: *
  184:             DO 10 J = 1, N, NB
  185: *
  186: *              Update and factorize the current diagonal block and test
  187: *              for non-positive-definiteness.
  188: *
  189:                JB = MIN( NB, N-J+1 )
  190:                CALL ZHERK( 'Upper', 'Conjugate transpose', JB, J-1,
  191:      $                     -ONE, A( 1, J ), LDA, ONE, A( J, J ), LDA )
  192:                CALL ZPOTRF2( 'Upper', JB, A( J, J ), LDA, INFO )
  193:                IF( INFO.NE.0 )
  194:      $            GO TO 30
  195:                IF( J+JB.LE.N ) THEN
  196: *
  197: *                 Compute the current block row.
  198: *
  199:                   CALL ZGEMM( '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 ),
  202:      $                        LDA )
  203:                   CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose',
  204:      $                        'Non-unit', JB, N-J-JB+1, CONE, A( J, J ),
  205:      $                        LDA, A( J, J+JB ), LDA )
  206:                END IF
  207:    10       CONTINUE
  208: *
  209:          ELSE
  210: *
  211: *           Compute the Cholesky factorization A = L*L**H.
  212: *
  213:             DO 20 J = 1, N, NB
  214: *
  215: *              Update and factorize the current diagonal block and test
  216: *              for non-positive-definiteness.
  217: *
  218:                JB = MIN( NB, N-J+1 )
  219:                CALL ZHERK( 'Lower', 'No transpose', JB, J-1, -ONE,
  220:      $                     A( J, 1 ), LDA, ONE, A( J, J ), LDA )
  221:                CALL ZPOTRF2( 'Lower', JB, A( J, J ), LDA, INFO )
  222:                IF( INFO.NE.0 )
  223:      $            GO TO 30
  224:                IF( J+JB.LE.N ) THEN
  225: *
  226: *                 Compute the current block column.
  227: *
  228:                   CALL ZGEMM( '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 ),
  231:      $                        LDA )
  232:                   CALL ZTRSM( 'Right', 'Lower', 'Conjugate transpose',
  233:      $                        'Non-unit', N-J-JB+1, JB, CONE, A( J, J ),
  234:      $                        LDA, A( J+JB, J ), LDA )
  235:                END IF
  236:    20       CONTINUE
  237:          END IF
  238:       END IF
  239:       GO TO 40
  240: *
  241:    30 CONTINUE
  242:       INFO = INFO + J - 1
  243: *
  244:    40 CONTINUE
  245:       RETURN
  246: *
  247: *     End of ZPOTRF
  248: *
  249:       END