1*> \brief \b SLARZT forms the triangular factor T of a block reflector H = I - vtvH.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLARZT + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarzt.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarzt.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarzt.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          DIRECT, STOREV
25*       INTEGER            K, LDT, LDV, N
26*       ..
27*       .. Array Arguments ..
28*       REAL               T( LDT, * ), TAU( * ), V( LDV, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> SLARZT forms the triangular factor T of a real block reflector
38*> H of order > n, which is defined as a product of k elementary
39*> reflectors.
40*>
41*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
42*>
43*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
44*>
45*> If STOREV = 'C', the vector which defines the elementary reflector
46*> H(i) is stored in the i-th column of the array V, and
47*>
48*>    H  =  I - V * T * V**T
49*>
50*> If STOREV = 'R', the vector which defines the elementary reflector
51*> H(i) is stored in the i-th row of the array V, and
52*>
53*>    H  =  I - V**T * T * V
54*>
55*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
56*> \endverbatim
57*
58*  Arguments:
59*  ==========
60*
61*> \param[in] DIRECT
62*> \verbatim
63*>          DIRECT is CHARACTER*1
64*>          Specifies the order in which the elementary reflectors are
65*>          multiplied to form the block reflector:
66*>          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
67*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
68*> \endverbatim
69*>
70*> \param[in] STOREV
71*> \verbatim
72*>          STOREV is CHARACTER*1
73*>          Specifies how the vectors which define the elementary
74*>          reflectors are stored (see also Further Details):
75*>          = 'C': columnwise                        (not supported yet)
76*>          = 'R': rowwise
77*> \endverbatim
78*>
79*> \param[in] N
80*> \verbatim
81*>          N is INTEGER
82*>          The order of the block reflector H. N >= 0.
83*> \endverbatim
84*>
85*> \param[in] K
86*> \verbatim
87*>          K is INTEGER
88*>          The order of the triangular factor T (= the number of
89*>          elementary reflectors). K >= 1.
90*> \endverbatim
91*>
92*> \param[in,out] V
93*> \verbatim
94*>          V is REAL array, dimension
95*>                               (LDV,K) if STOREV = 'C'
96*>                               (LDV,N) if STOREV = 'R'
97*>          The matrix V. See further details.
98*> \endverbatim
99*>
100*> \param[in] LDV
101*> \verbatim
102*>          LDV is INTEGER
103*>          The leading dimension of the array V.
104*>          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
105*> \endverbatim
106*>
107*> \param[in] TAU
108*> \verbatim
109*>          TAU is REAL array, dimension (K)
110*>          TAU(i) must contain the scalar factor of the elementary
111*>          reflector H(i).
112*> \endverbatim
113*>
114*> \param[out] T
115*> \verbatim
116*>          T is REAL array, dimension (LDT,K)
117*>          The k by k triangular factor T of the block reflector.
118*>          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
119*>          lower triangular. The rest of the array is not used.
120*> \endverbatim
121*>
122*> \param[in] LDT
123*> \verbatim
124*>          LDT is INTEGER
125*>          The leading dimension of the array T. LDT >= K.
126*> \endverbatim
127*
128*  Authors:
129*  ========
130*
131*> \author Univ. of Tennessee
132*> \author Univ. of California Berkeley
133*> \author Univ. of Colorado Denver
134*> \author NAG Ltd.
135*
136*> \ingroup realOTHERcomputational
137*
138*> \par Contributors:
139*  ==================
140*>
141*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
142*
143*> \par Further Details:
144*  =====================
145*>
146*> \verbatim
147*>
148*>  The shape of the matrix V and the storage of the vectors which define
149*>  the H(i) is best illustrated by the following example with n = 5 and
150*>  k = 3. The elements equal to 1 are not stored; the corresponding
151*>  array elements are modified but restored on exit. The rest of the
152*>  array is not used.
153*>
154*>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
155*>
156*>                                              ______V_____
157*>         ( v1 v2 v3 )                        /            \
158*>         ( v1 v2 v3 )                      ( v1 v1 v1 v1 v1 . . . . 1 )
159*>     V = ( v1 v2 v3 )                      ( v2 v2 v2 v2 v2 . . . 1   )
160*>         ( v1 v2 v3 )                      ( v3 v3 v3 v3 v3 . . 1     )
161*>         ( v1 v2 v3 )
162*>            .  .  .
163*>            .  .  .
164*>            1  .  .
165*>               1  .
166*>                  1
167*>
168*>  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
169*>
170*>                                                        ______V_____
171*>            1                                          /            \
172*>            .  1                           ( 1 . . . . v1 v1 v1 v1 v1 )
173*>            .  .  1                        ( . 1 . . . v2 v2 v2 v2 v2 )
174*>            .  .  .                        ( . . 1 . . v3 v3 v3 v3 v3 )
175*>            .  .  .
176*>         ( v1 v2 v3 )
177*>         ( v1 v2 v3 )
178*>     V = ( v1 v2 v3 )
179*>         ( v1 v2 v3 )
180*>         ( v1 v2 v3 )
181*> \endverbatim
182*>
183*  =====================================================================
184      SUBROUTINE SLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
185*
186*  -- LAPACK computational routine --
187*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
188*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
189*
190*     .. Scalar Arguments ..
191      CHARACTER          DIRECT, STOREV
192      INTEGER            K, LDT, LDV, N
193*     ..
194*     .. Array Arguments ..
195      REAL               T( LDT, * ), TAU( * ), V( LDV, * )
196*     ..
197*
198*  =====================================================================
199*
200*     .. Parameters ..
201      REAL               ZERO
202      PARAMETER          ( ZERO = 0.0E+0 )
203*     ..
204*     .. Local Scalars ..
205      INTEGER            I, INFO, J
206*     ..
207*     .. External Subroutines ..
208      EXTERNAL           SGEMV, STRMV, XERBLA
209*     ..
210*     .. External Functions ..
211      LOGICAL            LSAME
212      EXTERNAL           LSAME
213*     ..
214*     .. Executable Statements ..
215*
216*     Check for currently supported options
217*
218      INFO = 0
219      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
220         INFO = -1
221      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
222         INFO = -2
223      END IF
224      IF( INFO.NE.0 ) THEN
225         CALL XERBLA( 'SLARZT', -INFO )
226         RETURN
227      END IF
228*
229      DO 20 I = K, 1, -1
230         IF( TAU( I ).EQ.ZERO ) THEN
231*
232*           H(i)  =  I
233*
234            DO 10 J = I, K
235               T( J, I ) = ZERO
236   10       CONTINUE
237         ELSE
238*
239*           general case
240*
241            IF( I.LT.K ) THEN
242*
243*              T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)**T
244*
245               CALL SGEMV( 'No transpose', K-I, N, -TAU( I ),
246     $                     V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
247     $                     T( I+1, I ), 1 )
248*
249*              T(i+1:k,i) = T(i+1:k,i+1:k) * T(i+1:k,i)
250*
251               CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
252     $                     T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
253            END IF
254            T( I, I ) = TAU( I )
255         END IF
256   20 CONTINUE
257      RETURN
258*
259*     End of SLARZT
260*
261      END
262