1 *> \brief \b SLARF 2 * 3 * =========== DOCUMENTATION =========== 4 * 5 * Online html documentation available at 6 * http://www.netlib.org/lapack/explore-html/ 7 * 8 *> \htmlonly 9 *> Download SLARF + dependencies 10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f"> 11 *> [TGZ]</a> 12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f"> 13 *> [ZIP]</a> 14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f"> 15 *> [TXT]</a> 16 *> \endhtmlonly 17 * 18 * Definition: 19 * =========== 20 * 21 * SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) 22 * 23 * .. Scalar Arguments .. 24 * CHARACTER SIDE 25 * INTEGER INCV, 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 *> SLARF 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 REAL 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 REAL 88 *> The value tau in the representation of H. 89 *> \endverbatim 90 *> 91 *> \param[in,out] C 92 *> \verbatim 93 *> C is REAL 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 REAL 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 November 2011 121 * 122 *> \ingroup realOTHERauxiliary 123 * 124 * ===================================================================== 125 SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) 126 * 127 * -- LAPACK auxiliary routine (version 3.4.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 * November 2011 131 * 132 * .. Scalar Arguments .. 133 CHARACTER SIDE 134 INTEGER INCV, LDC, M, N 135 REAL TAU 136 * .. 137 * .. Array Arguments .. 138 REAL C( LDC, * ), V( * ), WORK( * ) 139 * .. 140 * 141 * ===================================================================== 142 * 143 * .. Parameters .. 144 REAL ONE, ZERO 145 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 146 * .. 147 * .. Local Scalars .. 148 LOGICAL APPLYLEFT 149 INTEGER I, LASTV, LASTC 150 * .. 151 * .. External Subroutines .. 152 EXTERNAL SGEMV, SGER 153 * .. 154 * .. External Functions .. 155 LOGICAL LSAME 156 INTEGER ILASLR, ILASLC 157 EXTERNAL LSAME, ILASLR, ILASLC 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 = ILASLC(LASTV, N, C, LDC) 185 ELSE 186 ! Scan for the last non-zero row in C(:,1:lastv). 187 LASTC = ILASLR(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 SGEMV( '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 SGER( 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 SGEMV( '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 SGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) 221 END IF 222 END IF 223 RETURN 224 * 225 * End of SLARF 226 * 227 END 228
