SRC/zlarz.f

   1 *> \brief \b ZLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZLARZ + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarz.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarz.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarz.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          SIDE
  25 *       INTEGER            INCV, L, LDC, M, N
  26 *       COMPLEX*16         TAU
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> ZLARZ applies a complex elementary reflector H to a complex
  39 *> M-by-N matrix C, from either the left or the right. H is represented
  40 *> in the form
  41 *>
  42 *>       H = I - tau * v * v**H
  43 *>
  44 *> where tau is a complex scalar and v is a complex vector.
  45 *>
  46 *> If tau = 0, then H is taken to be the unit matrix.
  47 *>
  48 *> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead
  49 *> tau.
  50 *>
  51 *> H is a product of k elementary reflectors as returned by ZTZRZF.
  52 *> \endverbatim
  53 *
  54 *  Arguments:
  55 *  ==========
  56 *
  57 *> \param[in] SIDE
  58 *> \verbatim
  59 *>          SIDE is CHARACTER*1
  60 *>          = 'L': form  H * C
  61 *>          = 'R': form  C * H
  62 *> \endverbatim
  63 *>
  64 *> \param[in] M
  65 *> \verbatim
  66 *>          M is INTEGER
  67 *>          The number of rows of the matrix C.
  68 *> \endverbatim
  69 *>
  70 *> \param[in] N
  71 *> \verbatim
  72 *>          N is INTEGER
  73 *>          The number of columns of the matrix C.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] L
  77 *> \verbatim
  78 *>          L is INTEGER
  79 *>          The number of entries of the vector V containing
  80 *>          the meaningful part of the Householder vectors.
  81 *>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
  82 *> \endverbatim
  83 *>
  84 *> \param[in] V
  85 *> \verbatim
  86 *>          V is COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
  87 *>          The vector v in the representation of H as returned by
  88 *>          ZTZRZF. V is not used if TAU = 0.
  89 *> \endverbatim
  90 *>
  91 *> \param[in] INCV
  92 *> \verbatim
  93 *>          INCV is INTEGER
  94 *>          The increment between elements of v. INCV <> 0.
  95 *> \endverbatim
  96 *>
  97 *> \param[in] TAU
  98 *> \verbatim
  99 *>          TAU is COMPLEX*16
 100 *>          The value tau in the representation of H.
 101 *> \endverbatim
 102 *>
 103 *> \param[in,out] C
 104 *> \verbatim
 105 *>          C is COMPLEX*16 array, dimension (LDC,N)
 106 *>          On entry, the M-by-N matrix C.
 107 *>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
 108 *>          or C * H if SIDE = 'R'.
 109 *> \endverbatim
 110 *>
 111 *> \param[in] LDC
 112 *> \verbatim
 113 *>          LDC is INTEGER
 114 *>          The leading dimension of the array C. LDC >= max(1,M).
 115 *> \endverbatim
 116 *>
 117 *> \param[out] WORK
 118 *> \verbatim
 119 *>          WORK is COMPLEX*16 array, dimension
 120 *>                         (N) if SIDE = 'L'
 121 *>                      or (M) if SIDE = 'R'
 122 *> \endverbatim
 123 *
 124 *  Authors:
 125 *  ========
 126 *
 127 *> \author Univ. of Tennessee
 128 *> \author Univ. of California Berkeley
 129 *> \author Univ. of Colorado Denver
 130 *> \author NAG Ltd.
 131 *
 132 *> \date September 2012
 133 *
 134 *> \ingroup complex16OTHERcomputational
 135 *
 136 *> \par Contributors:
 137 *  ==================
 138 *>
 139 *>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
 140 *
 141 *> \par Further Details:
 142 *  =====================
 143 *>
 144 *> \verbatim
 145 *> \endverbatim
 146 *>
 147 *  =====================================================================
 148       SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
 149 *
 150 *  -- LAPACK computational routine (version 3.4.2) --
 151 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 153 *     September 2012
 154 *
 155 *     .. Scalar Arguments ..
 156       CHARACTER          SIDE
 157       INTEGER            INCV, L, LDC, M, N
 158       COMPLEX*16         TAU
 159 *     ..
 160 *     .. Array Arguments ..
 161       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
 162 *     ..
 163 *
 164 *  =====================================================================
 165 *
 166 *     .. Parameters ..
 167       COMPLEX*16         ONE, ZERO
 168       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
 169      $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
 170 *     ..
 171 *     .. External Subroutines ..
 172       EXTERNAL           ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
 173 *     ..
 174 *     .. External Functions ..
 175       LOGICAL            LSAME
 176       EXTERNAL           LSAME
 177 *     ..
 178 *     .. Executable Statements ..
 179 *
 180       IF( LSAME( SIDE, 'L' ) ) THEN
 181 *
 182 *        Form  H * C
 183 *
 184          IF( TAU.NE.ZERO ) THEN
 185 *
 186 *           w( 1:n ) = conjg( C( 1, 1:n ) )
 187 *
 188             CALL ZCOPY( N, C, LDC, WORK, 1 )
 189             CALL ZLACGV( N, WORK, 1 )
 190 *
 191 *           w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )**H * v( 1:l ) )
 192 *
 193             CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
 194      $                  LDC, V, INCV, ONE, WORK, 1 )
 195             CALL ZLACGV( N, WORK, 1 )
 196 *
 197 *           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
 198 *
 199             CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
 200 *
 201 *           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
 202 *                               tau * v( 1:l ) * w( 1:n )**H
 203 *
 204             CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
 205      $                  LDC )
 206          END IF
 207 *
 208       ELSE
 209 *
 210 *        Form  C * H
 211 *
 212          IF( TAU.NE.ZERO ) THEN
 213 *
 214 *           w( 1:m ) = C( 1:m, 1 )
 215 *
 216             CALL ZCOPY( M, C, 1, WORK, 1 )
 217 *
 218 *           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
 219 *
 220             CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
 221      $                  V, INCV, ONE, WORK, 1 )
 222 *
 223 *           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
 224 *
 225             CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
 226 *
 227 *           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
 228 *                               tau * w( 1:m ) * v( 1:l )**H
 229 *
 230             CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
 231      $                  LDC )
 232 *
 233          END IF
 234 *
 235       END IF
 236 *
 237       RETURN
 238 *
 239 *     End of ZLARZ
 240 *
 241       END