source: pacpussensors/trunk/Vislab/lib3dv-1.2.0/lib3dv/eigen/lapack/clarf.f@ 141

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

Doc
File size: 6.1 KB
Line 
1*> \brief \b CLARF
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLARF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
22*
23* .. Scalar Arguments ..
24* CHARACTER SIDE
25* INTEGER INCV, LDC, M, N
26* COMPLEX TAU
27* ..
28* .. Array Arguments ..
29* COMPLEX C( LDC, * ), V( * ), WORK( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> CLARF applies a complex elementary reflector H to a complex 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**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*> \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] V
75*> \verbatim
76*> V is COMPLEX array, dimension
77*> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
78*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
79*> The vector v in the representation of H. V is not used if
80*> TAU = 0.
81*> \endverbatim
82*>
83*> \param[in] INCV
84*> \verbatim
85*> INCV is INTEGER
86*> The increment between elements of v. INCV <> 0.
87*> \endverbatim
88*>
89*> \param[in] TAU
90*> \verbatim
91*> TAU is COMPLEX
92*> The value tau in the representation of H.
93*> \endverbatim
94*>
95*> \param[in,out] C
96*> \verbatim
97*> C is COMPLEX array, dimension (LDC,N)
98*> On entry, the M-by-N matrix C.
99*> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
100*> or C * H if SIDE = 'R'.
101*> \endverbatim
102*>
103*> \param[in] LDC
104*> \verbatim
105*> LDC is INTEGER
106*> The leading dimension of the array C. LDC >= max(1,M).
107*> \endverbatim
108*>
109*> \param[out] WORK
110*> \verbatim
111*> WORK is COMPLEX array, dimension
112*> (N) if SIDE = 'L'
113*> or (M) if SIDE = 'R'
114*> \endverbatim
115*
116* Authors:
117* ========
118*
119*> \author Univ. of Tennessee
120*> \author Univ. of California Berkeley
121*> \author Univ. of Colorado Denver
122*> \author NAG Ltd.
123*
124*> \date November 2011
125*
126*> \ingroup complexOTHERauxiliary
127*
128* =====================================================================
129 SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
130*
131* -- LAPACK auxiliary routine (version 3.4.0) --
132* -- LAPACK is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134* November 2011
135*
136* .. Scalar Arguments ..
137 CHARACTER SIDE
138 INTEGER INCV, LDC, M, N
139 COMPLEX TAU
140* ..
141* .. Array Arguments ..
142 COMPLEX C( LDC, * ), V( * ), WORK( * )
143* ..
144*
145* =====================================================================
146*
147* .. Parameters ..
148 COMPLEX ONE, ZERO
149 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ),
150 $ ZERO = ( 0.0E+0, 0.0E+0 ) )
151* ..
152* .. Local Scalars ..
153 LOGICAL APPLYLEFT
154 INTEGER I, LASTV, LASTC
155* ..
156* .. External Subroutines ..
157 EXTERNAL CGEMV, CGERC
158* ..
159* .. External Functions ..
160 LOGICAL LSAME
161 INTEGER ILACLR, ILACLC
162 EXTERNAL LSAME, ILACLR, ILACLC
163* ..
164* .. Executable Statements ..
165*
166 APPLYLEFT = LSAME( SIDE, 'L' )
167 LASTV = 0
168 LASTC = 0
169 IF( TAU.NE.ZERO ) THEN
170! Set up variables for scanning V. LASTV begins pointing to the end
171! of V.
172 IF( APPLYLEFT ) THEN
173 LASTV = M
174 ELSE
175 LASTV = N
176 END IF
177 IF( INCV.GT.0 ) THEN
178 I = 1 + (LASTV-1) * INCV
179 ELSE
180 I = 1
181 END IF
182! Look for the last non-zero row in V.
183 DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
184 LASTV = LASTV - 1
185 I = I - INCV
186 END DO
187 IF( APPLYLEFT ) THEN
188! Scan for the last non-zero column in C(1:lastv,:).
189 LASTC = ILACLC(LASTV, N, C, LDC)
190 ELSE
191! Scan for the last non-zero row in C(:,1:lastv).
192 LASTC = ILACLR(M, LASTV, C, LDC)
193 END IF
194 END IF
195! Note that lastc.eq.0 renders the BLAS operations null; no special
196! case is needed at this level.
197 IF( APPLYLEFT ) THEN
198*
199* Form H * C
200*
201 IF( LASTV.GT.0 ) THEN
202*
203* w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
204*
205 CALL CGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
206 $ C, LDC, V, INCV, ZERO, WORK, 1 )
207*
208* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
209*
210 CALL CGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
211 END IF
212 ELSE
213*
214* Form C * H
215*
216 IF( LASTV.GT.0 ) THEN
217*
218* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
219*
220 CALL CGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
221 $ V, INCV, ZERO, WORK, 1 )
222*
223* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
224*
225 CALL CGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
226 END IF
227 END IF
228 RETURN
229*
230* End of CLARF
231*
232 END
Note: See TracBrowser for help on using the repository browser.