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