Return to dlarf.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack.

    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: *> \date December 2016
  121: *
  122: *> \ingroup doubleOTHERauxiliary
  123: *
  124: *  =====================================================================
  125:       SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
  126: *
  127: *  -- LAPACK auxiliary routine (version 3.7.0) --
  128: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  129: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  130: *     December 2016
  131: *
  132: *     .. Scalar Arguments ..
  133:       CHARACTER          SIDE
  134:       INTEGER            INCV, LDC, M, N
  135:       DOUBLE PRECISION   TAU
  136: *     ..
  137: *     .. Array Arguments ..
  138:       DOUBLE PRECISION   C( LDC, * ), V( * ), WORK( * )
  139: *     ..
  140: *
  141: *  =====================================================================
  142: *
  143: *     .. Parameters ..
  144:       DOUBLE PRECISION   ONE, ZERO
  145:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  146: *     ..
  147: *     .. Local Scalars ..
  148:       LOGICAL            APPLYLEFT
  149:       INTEGER            I, LASTV, LASTC
  150: *     ..
  151: *     .. External Subroutines ..
  152:       EXTERNAL           DGEMV, DGER
  153: *     ..
  154: *     .. External Functions ..
  155:       LOGICAL            LSAME
  156:       INTEGER            ILADLR, ILADLC
  157:       EXTERNAL           LSAME, ILADLR, ILADLC
  158: *     ..
  159: *     .. Executable Statements ..
  160: *
  161:       APPLYLEFT = LSAME( SIDE, 'L' )
  162:       LASTV = 0
  163:       LASTC = 0
  164:       IF( TAU.NE.ZERO ) THEN
  165: !     Set up variables for scanning V.  LASTV begins pointing to the end
  166: !     of V.
  167:          IF( APPLYLEFT ) THEN
  168:             LASTV = M
  169:          ELSE
  170:             LASTV = N
  171:          END IF
  172:          IF( INCV.GT.0 ) THEN
  173:             I = 1 + (LASTV-1) * INCV
  174:          ELSE
  175:             I = 1
  176:          END IF
  177: !     Look for the last non-zero row in V.
  178:          DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
  179:             LASTV = LASTV - 1
  180:             I = I - INCV
  181:          END DO
  182:          IF( APPLYLEFT ) THEN
  183: !     Scan for the last non-zero column in C(1:lastv,:).
  184:             LASTC = ILADLC(LASTV, N, C, LDC)
  185:          ELSE
  186: !     Scan for the last non-zero row in C(:,1:lastv).
  187:             LASTC = ILADLR(M, LASTV, C, LDC)
  188:          END IF
  189:       END IF
  190: !     Note that lastc.eq.0 renders the BLAS operations null; no special
  191: !     case is needed at this level.
  192:       IF( APPLYLEFT ) THEN
  193: *
  194: *        Form  H * C
  195: *
  196:          IF( LASTV.GT.0 ) THEN
  197: *
  198: *           w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
  199: *
  200:             CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
  201:      $           ZERO, WORK, 1 )
  202: *
  203: *           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
  204: *
  205:             CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
  206:          END IF
  207:       ELSE
  208: *
  209: *        Form  C * H
  210: *
  211:          IF( LASTV.GT.0 ) THEN
  212: *
  213: *           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
  214: *
  215:             CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
  216:      $           V, INCV, ZERO, WORK, 1 )
  217: *
  218: *           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
  219: *
  220:             CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
  221:          END IF
  222:       END IF
  223:       RETURN
  224: *
  225: *     End of DLARF
  226: *
  227:       END