SRC/dlarf.f

   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 September 2012
 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.4.2) --
 128 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 129 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 130 *     September 2012
 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