source: pacpussensors/trunk/Vislab/lib3dv-1.2.0/lib3dv/eigen/lapack/slarf.f

Last change on this file was 136, checked in by ldecherf, 8 years ago

Doc
File size: 6.0 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.