1*> \brief \b CLARZB applies a block reflector or its conjugate-transpose 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 CLARZB + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarzb.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarzb.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarzb.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
22*                          LDV, T, LDT, C, LDC, WORK, LDWORK )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          DIRECT, SIDE, STOREV, TRANS
26*       INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
27*       ..
28*       .. Array Arguments ..
29*       COMPLEX            C( LDC, * ), T( LDT, * ), V( LDV, * ),
30*      $                   WORK( LDWORK, * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> CLARZB applies a complex block reflector H or its transpose H**H
40*> to a complex distributed M-by-N  C from the left or the right.
41*>
42*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] SIDE
49*> \verbatim
50*>          SIDE is CHARACTER*1
51*>          = 'L': apply H or H**H from the Left
52*>          = 'R': apply H or H**H from the Right
53*> \endverbatim
54*>
55*> \param[in] TRANS
56*> \verbatim
57*>          TRANS is CHARACTER*1
58*>          = 'N': apply H (No transpose)
59*>          = 'C': apply H**H (Conjugate transpose)
60*> \endverbatim
61*>
62*> \param[in] DIRECT
63*> \verbatim
64*>          DIRECT is CHARACTER*1
65*>          Indicates how H is formed from a product of elementary
66*>          reflectors
67*>          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
68*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
69*> \endverbatim
70*>
71*> \param[in] STOREV
72*> \verbatim
73*>          STOREV is CHARACTER*1
74*>          Indicates how the vectors which define the elementary
75*>          reflectors are stored:
76*>          = 'C': Columnwise                        (not supported yet)
77*>          = 'R': Rowwise
78*> \endverbatim
79*>
80*> \param[in] M
81*> \verbatim
82*>          M is INTEGER
83*>          The number of rows of the matrix C.
84*> \endverbatim
85*>
86*> \param[in] N
87*> \verbatim
88*>          N is INTEGER
89*>          The number of columns of the matrix C.
90*> \endverbatim
91*>
92*> \param[in] K
93*> \verbatim
94*>          K is INTEGER
95*>          The order of the matrix T (= the number of elementary
96*>          reflectors whose product defines the block reflector).
97*> \endverbatim
98*>
99*> \param[in] L
100*> \verbatim
101*>          L is INTEGER
102*>          The number of columns of the matrix V containing the
103*>          meaningful part of the Householder reflectors.
104*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
105*> \endverbatim
106*>
107*> \param[in] V
108*> \verbatim
109*>          V is COMPLEX array, dimension (LDV,NV).
110*>          If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
111*> \endverbatim
112*>
113*> \param[in] LDV
114*> \verbatim
115*>          LDV is INTEGER
116*>          The leading dimension of the array V.
117*>          If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
118*> \endverbatim
119*>
120*> \param[in] T
121*> \verbatim
122*>          T is COMPLEX array, dimension (LDT,K)
123*>          The triangular K-by-K matrix T in the representation of the
124*>          block reflector.
125*> \endverbatim
126*>
127*> \param[in] LDT
128*> \verbatim
129*>          LDT is INTEGER
130*>          The leading dimension of the array T. LDT >= K.
131*> \endverbatim
132*>
133*> \param[in,out] C
134*> \verbatim
135*>          C is COMPLEX array, dimension (LDC,N)
136*>          On entry, the M-by-N matrix C.
137*>          On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
138*> \endverbatim
139*>
140*> \param[in] LDC
141*> \verbatim
142*>          LDC is INTEGER
143*>          The leading dimension of the array C. LDC >= max(1,M).
144*> \endverbatim
145*>
146*> \param[out] WORK
147*> \verbatim
148*>          WORK is COMPLEX array, dimension (LDWORK,K)
149*> \endverbatim
150*>
151*> \param[in] LDWORK
152*> \verbatim
153*>          LDWORK is INTEGER
154*>          The leading dimension of the array WORK.
155*>          If SIDE = 'L', LDWORK >= max(1,N);
156*>          if SIDE = 'R', LDWORK >= max(1,M).
157*> \endverbatim
158*
159*  Authors:
160*  ========
161*
162*> \author Univ. of Tennessee
163*> \author Univ. of California Berkeley
164*> \author Univ. of Colorado Denver
165*> \author NAG Ltd.
166*
167*> \ingroup complexOTHERcomputational
168*
169*> \par Contributors:
170*  ==================
171*>
172*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
173*
174*> \par Further Details:
175*  =====================
176*>
177*> \verbatim
178*> \endverbatim
179*>
180*  =====================================================================
181      SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
182     $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
183*
184*  -- LAPACK computational routine --
185*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
186*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
187*
188*     .. Scalar Arguments ..
189      CHARACTER          DIRECT, SIDE, STOREV, TRANS
190      INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
191*     ..
192*     .. Array Arguments ..
193      COMPLEX            C( LDC, * ), T( LDT, * ), V( LDV, * ),
194     $                   WORK( LDWORK, * )
195*     ..
196*
197*  =====================================================================
198*
199*     .. Parameters ..
200      COMPLEX            ONE
201      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
202*     ..
203*     .. Local Scalars ..
204      CHARACTER          TRANST
205      INTEGER            I, INFO, J
206*     ..
207*     .. External Functions ..
208      LOGICAL            LSAME
209      EXTERNAL           LSAME
210*     ..
211*     .. External Subroutines ..
212      EXTERNAL           CCOPY, CGEMM, CLACGV, CTRMM, XERBLA
213*     ..
214*     .. Executable Statements ..
215*
216*     Quick return if possible
217*
218      IF( M.LE.0 .OR. N.LE.0 )
219     $   RETURN
220*
221*     Check for currently supported options
222*
223      INFO = 0
224      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
225         INFO = -3
226      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
227         INFO = -4
228      END IF
229      IF( INFO.NE.0 ) THEN
230         CALL XERBLA( 'CLARZB', -INFO )
231         RETURN
232      END IF
233*
234      IF( LSAME( TRANS, 'N' ) ) THEN
235         TRANST = 'C'
236      ELSE
237         TRANST = 'N'
238      END IF
239*
240      IF( LSAME( SIDE, 'L' ) ) THEN
241*
242*        Form  H * C  or  H**H * C
243*
244*        W( 1:n, 1:k ) = C( 1:k, 1:n )**H
245*
246         DO 10 J = 1, K
247            CALL CCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
248   10    CONTINUE
249*
250*        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
251*                        C( m-l+1:m, 1:n )**H * V( 1:k, 1:l )**T
252*
253         IF( L.GT.0 )
254     $      CALL CGEMM( 'Transpose', 'Conjugate transpose', N, K, L,
255     $                  ONE, C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK,
256     $                  LDWORK )
257*
258*        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T  or  W( 1:m, 1:k ) * T
259*
260         CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
261     $               LDT, WORK, LDWORK )
262*
263*        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**H
264*
265         DO 30 J = 1, N
266            DO 20 I = 1, K
267               C( I, J ) = C( I, J ) - WORK( J, I )
268   20       CONTINUE
269   30    CONTINUE
270*
271*        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
272*                            V( 1:k, 1:l )**H * W( 1:n, 1:k )**H
273*
274         IF( L.GT.0 )
275     $      CALL CGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
276     $                  WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
277*
278      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
279*
280*        Form  C * H  or  C * H**H
281*
282*        W( 1:m, 1:k ) = C( 1:m, 1:k )
283*
284         DO 40 J = 1, K
285            CALL CCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
286   40    CONTINUE
287*
288*        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
289*                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**H
290*
291         IF( L.GT.0 )
292     $      CALL CGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
293     $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
294*
295*        W( 1:m, 1:k ) = W( 1:m, 1:k ) * conjg( T )  or
296*                        W( 1:m, 1:k ) * T**H
297*
298         DO 50 J = 1, K
299            CALL CLACGV( K-J+1, T( J, J ), 1 )
300   50    CONTINUE
301         CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
302     $               LDT, WORK, LDWORK )
303         DO 60 J = 1, K
304            CALL CLACGV( K-J+1, T( J, J ), 1 )
305   60    CONTINUE
306*
307*        C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
308*
309         DO 80 J = 1, K
310            DO 70 I = 1, M
311               C( I, J ) = C( I, J ) - WORK( I, J )
312   70       CONTINUE
313   80    CONTINUE
314*
315*        C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
316*                            W( 1:m, 1:k ) * conjg( V( 1:k, 1:l ) )
317*
318         DO 90 J = 1, L
319            CALL CLACGV( K, V( 1, J ), 1 )
320   90    CONTINUE
321         IF( L.GT.0 )
322     $      CALL CGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
323     $                  WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
324         DO 100 J = 1, L
325            CALL CLACGV( K, V( 1, J ), 1 )
326  100    CONTINUE
327*
328      END IF
329*
330      RETURN
331*
332*     End of CLARZB
333*
334      END
335