Return to dlarf.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b DLARF applies an elementary reflector to a general rectangular matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLARF + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       CHARACTER          SIDE
   25: *       INTEGER            INCV, LDC, M, N
   26: *       DOUBLE PRECISION   TAU
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
   30: *       ..
   31: *
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *> DLARF applies a real elementary reflector H to a real m by n matrix
   39: *> C, from either the left or the right. H is represented in the form
   40: *>
   41: *>       H = I - tau * v * v**T
   42: *>
   43: *> where tau is a real scalar and v is a real vector.
   44: *>
   45: *> If tau = 0, then H is taken to be the unit matrix.
   46: *> \endverbatim
   47: *
   48: *  Arguments:
   49: *  ==========
   50: *
   51: *> \param[in] SIDE
   52: *> \verbatim
   53: *>          SIDE is CHARACTER*1
   54: *>          = 'L': form  H * C
   55: *>          = 'R': form  C * H
   56: *> \endverbatim
   57: *>
   58: *> \param[in] M
   59: *> \verbatim
   60: *>          M is INTEGER
   61: *>          The number of rows of the matrix C.
   62: *> \endverbatim
   63: *>
   64: *> \param[in] N
   65: *> \verbatim
   66: *>          N is INTEGER
   67: *>          The number of columns of the matrix C.
   68: *> \endverbatim
   69: *>
   70: *> \param[in] V
   71: *> \verbatim
   72: *>          V is DOUBLE PRECISION array, dimension
   73: *>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
   74: *>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
   75: *>          The vector v in the representation of H. V is not used if
   76: *>          TAU = 0.
   77: *> \endverbatim
   78: *>
   79: *> \param[in] INCV
   80: *> \verbatim
   81: *>          INCV is INTEGER
   82: *>          The increment between elements of v. INCV <> 0.
   83: *> \endverbatim
   84: *>
   85: *> \param[in] TAU
   86: *> \verbatim
   87: *>          TAU is DOUBLE PRECISION
   88: *>          The value tau in the representation of H.
   89: *> \endverbatim
   90: *>
   91: *> \param[in,out] C
   92: *> \verbatim
   93: *>          C is DOUBLE PRECISION array, dimension (LDC,N)
   94: *>          On entry, the m by n matrix C.
   95: *>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
   96: *>          or C * H if SIDE = 'R'.
   97: *> \endverbatim
   98: *>
   99: *> \param[in] LDC
  100: *> \verbatim
  101: *>          LDC is INTEGER
  102: *>          The leading dimension of the array C. LDC >= max(1,M).
  103: *> \endverbatim
  104: *>
  105: *> \param[out] WORK
  106: *> \verbatim
  107: *>          WORK is DOUBLE PRECISION array, dimension
  108: *>                         (N) if SIDE = 'L'
  109: *>                      or (M) if SIDE = 'R'
  110: *> \endverbatim
  111: *
  112: *  Authors:
  113: *  ========
  114: *
  115: *> \author Univ. of Tennessee
  116: *> \author Univ. of California Berkeley
  117: *> \author Univ. of Colorado Denver
  118: *> \author NAG Ltd.
  119: *
  120: *> \ingroup doubleOTHERauxiliary
  121: *
  122: *  =====================================================================
  123:       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
  124: *
  125: *  -- LAPACK auxiliary routine --
  126: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  127: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  128: *
  129: *     .. Scalar Arguments ..
  130:       CHARACTER          SIDE
  131:       INTEGER            INCV, LDC, M, N
  132:       DOUBLE PRECISION   TAU
  133: *     ..
  134: *     .. Array Arguments ..
  135:       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
  136: *     ..
  137: *
  138: *  =====================================================================
  139: *
  140: *     .. Parameters ..
  141:       DOUBLE PRECISION   ONE, ZERO
  142:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  143: *     ..
  144: *     .. Local Scalars ..
  145:       LOGICAL            APPLYLEFT
  146:       INTEGER            I, LASTV, LASTC
  147: *     ..
  148: *     .. External Subroutines ..
  149:       EXTERNAL           DGEMV, DGER
  150: *     ..
  151: *     .. External Functions ..
  152:       LOGICAL            LSAME
  153:       INTEGER            ILADLR, ILADLC
  154:       EXTERNAL           LSAME, ILADLR, ILADLC
  155: *     ..
  156: *     .. Executable Statements ..
  157: *
  158:       APPLYLEFT = LSAME( SIDE, 'L' )
  159:       LASTV = 0
  160:       LASTC = 0
  161:       IF( TAU.NE.ZERO ) THEN
  162: !     Set up variables for scanning V.  LASTV begins pointing to the end
  163: !     of V.
  164:          IF( APPLYLEFT ) THEN
  165:             LASTV = M
  166:          ELSE
  167:             LASTV = N
  168:          END IF
  169:          IF( INCV.GT.0 ) THEN
  170:             I = 1 + (LASTV-1) * INCV
  171:          ELSE
  172:             I = 1
  173:          END IF
  174: !     Look for the last non-zero row in V.
  175:          DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
  176:             LASTV = LASTV - 1
  177:             I = I - INCV
  178:          END DO
  179:          IF( APPLYLEFT ) THEN
  180: !     Scan for the last non-zero column in C(1:lastv,:).
  181:             LASTC = ILADLC(LASTV, N, C, LDC)
  182:          ELSE
  183: !     Scan for the last non-zero row in C(:,1:lastv).
  184:             LASTC = ILADLR(M, LASTV, C, LDC)
  185:          END IF
  186:       END IF
  187: !     Note that lastc.eq.0 renders the BLAS operations null; no special
  188: !     case is needed at this level.
  189:       IF( APPLYLEFT ) THEN
  190: *
  191: *        Form  H * C
  192: *
  193:          IF( LASTV.GT.0 ) THEN
  194: *
  195: *           w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
  196: *
  197:             CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
  198:      $           ZERO, WORK, 1 )
  199: *
  200: *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
  201: *
  202:             CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
  203:          END IF
  204:       ELSE
  205: *
  206: *        Form  C * H
  207: *
  208:          IF( LASTV.GT.0 ) THEN
  209: *
  210: *           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
  211: *
  212:             CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
  213:      $           V, INCV, ZERO, WORK, 1 )
  214: *
  215: *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
  216: *
  217:             CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
  218:          END IF
  219:       END IF
  220:       RETURN
  221: *
  222: *     End of DLARF
  223: *
  224:       END