Return to dlauu2.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b DLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm).
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLAUU2 + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlauu2.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlauu2.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlauu2.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLAUU2( 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: *> DLAUU2 computes the product U * U**T or L**T * L, where the triangular
   38: *> factor U or L is stored in the upper or lower triangular part of
   39: *> the array A.
   40: *>
   41: *> If UPLO = 'U' or 'u' then the upper triangle of the result is stored,
   42: *> overwriting the factor U in A.
   43: *> If UPLO = 'L' or 'l' then the lower triangle of the result is stored,
   44: *> overwriting the factor L in A.
   45: *>
   46: *> This is the unblocked form of the algorithm, calling Level 2 BLAS.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] UPLO
   53: *> \verbatim
   54: *>          UPLO is CHARACTER*1
   55: *>          Specifies whether the triangular factor stored in the array A
   56: *>          is upper or lower triangular:
   57: *>          = 'U':  Upper triangular
   58: *>          = 'L':  Lower triangular
   59: *> \endverbatim
   60: *>
   61: *> \param[in] N
   62: *> \verbatim
   63: *>          N is INTEGER
   64: *>          The order of the triangular factor U or L.  N >= 0.
   65: *> \endverbatim
   66: *>
   67: *> \param[in,out] A
   68: *> \verbatim
   69: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
   70: *>          On entry, the triangular factor U or L.
   71: *>          On exit, if UPLO = 'U', the upper triangle of A is
   72: *>          overwritten with the upper triangle of the product U * U**T;
   73: *>          if UPLO = 'L', the lower triangle of A is overwritten with
   74: *>          the lower triangle of the product L**T * L.
   75: *> \endverbatim
   76: *>
   77: *> \param[in] LDA
   78: *> \verbatim
   79: *>          LDA is INTEGER
   80: *>          The leading dimension of the array A.  LDA >= max(1,N).
   81: *> \endverbatim
   82: *>
   83: *> \param[out] INFO
   84: *> \verbatim
   85: *>          INFO is INTEGER
   86: *>          = 0: successful exit
   87: *>          < 0: if INFO = -k, the k-th argument had an illegal value
   88: *> \endverbatim
   89: *
   90: *  Authors:
   91: *  ========
   92: *
   93: *> \author Univ. of Tennessee
   94: *> \author Univ. of California Berkeley
   95: *> \author Univ. of Colorado Denver
   96: *> \author NAG Ltd.
   97: *
   98: *> \ingroup doubleOTHERauxiliary
   99: *
  100: *  =====================================================================
  101:       SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO )
  102: *
  103: *  -- LAPACK auxiliary routine --
  104: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  105: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  106: *
  107: *     .. Scalar Arguments ..
  108:       CHARACTER          UPLO
  109:       INTEGER            INFO, LDA, N
  110: *     ..
  111: *     .. Array Arguments ..
  112:       DOUBLE PRECISION   A( LDA, * )
  113: *     ..
  114: *
  115: *  =====================================================================
  116: *
  117: *     .. Parameters ..
  118:       DOUBLE PRECISION   ONE
  119:       PARAMETER          ( ONE = 1.0D+0 )
  120: *     ..
  121: *     .. Local Scalars ..
  122:       LOGICAL            UPPER
  123:       INTEGER            I
  124:       DOUBLE PRECISION   AII
  125: *     ..
  126: *     .. External Functions ..
  127:       LOGICAL            LSAME
  128:       DOUBLE PRECISION   DDOT
  129:       EXTERNAL           LSAME, DDOT
  130: *     ..
  131: *     .. External Subroutines ..
  132:       EXTERNAL           DGEMV, DSCAL, XERBLA
  133: *     ..
  134: *     .. Intrinsic Functions ..
  135:       INTRINSIC          MAX
  136: *     ..
  137: *     .. Executable Statements ..
  138: *
  139: *     Test the input parameters.
  140: *
  141:       INFO = 0
  142:       UPPER = LSAME( UPLO, 'U' )
  143:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  144:          INFO = -1
  145:       ELSE IF( N.LT.0 ) THEN
  146:          INFO = -2
  147:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  148:          INFO = -4
  149:       END IF
  150:       IF( INFO.NE.0 ) THEN
  151:          CALL XERBLA( 'DLAUU2', -INFO )
  152:          RETURN
  153:       END IF
  154: *
  155: *     Quick return if possible
  156: *
  157:       IF( N.EQ.0 )
  158:      $   RETURN
  159: *
  160:       IF( UPPER ) THEN
  161: *
  162: *        Compute the product U * U**T.
  163: *
  164:          DO 10 I = 1, N
  165:             AII = A( I, I )
  166:             IF( I.LT.N ) THEN
  167:                A( I, I ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA )
  168:                CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ),
  169:      $                     LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 )
  170:             ELSE
  171:                CALL DSCAL( I, AII, A( 1, I ), 1 )
  172:             END IF
  173:    10    CONTINUE
  174: *
  175:       ELSE
  176: *
  177: *        Compute the product L**T * L.
  178: *
  179:          DO 20 I = 1, N
  180:             AII = A( I, I )
  181:             IF( I.LT.N ) THEN
  182:                A( I, I ) = DDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 )
  183:                CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA,
  184:      $                     A( I+1, I ), 1, AII, A( I, 1 ), LDA )
  185:             ELSE
  186:                CALL DSCAL( I, AII, A( I, 1 ), LDA )
  187:             END IF
  188:    20    CONTINUE
  189:       END IF
  190: *
  191:       RETURN
  192: *
  193: *     End of DLAUU2
  194: *
  195:       END