1*> \brief \b STPMLQT
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download STPMLQT + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpmlqt.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpmlqt.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpmlqt.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
22*                           A, LDA, B, LDB, WORK, INFO )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER SIDE, TRANS
26*       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
27*       ..
28*       .. Array Arguments ..
29*       REAL               V( LDV, * ), A( LDA, * ), B( LDB, * ),
30*      $                   T( LDT, * ), WORK( * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> STPMLQT applies a real orthogonal matrix Q obtained from a
40*> "triangular-pentagonal" real block reflector H to a general
41*> real matrix C, which consists of two blocks A and B.
42*> \endverbatim
43*
44*  Arguments:
45*  ==========
46*
47*> \param[in] SIDE
48*> \verbatim
49*>          SIDE is CHARACTER*1
50*>          = 'L': apply Q or Q**T from the Left;
51*>          = 'R': apply Q or Q**T from the Right.
52*> \endverbatim
53*>
54*> \param[in] TRANS
55*> \verbatim
56*>          TRANS is CHARACTER*1
57*>          = 'N':  No transpose, apply Q;
58*>          = 'T':  Transpose, apply Q**T.
59*> \endverbatim
60*>
61*> \param[in] M
62*> \verbatim
63*>          M is INTEGER
64*>          The number of rows of the matrix B. M >= 0.
65*> \endverbatim
66*>
67*> \param[in] N
68*> \verbatim
69*>          N is INTEGER
70*>          The number of columns of the matrix B. N >= 0.
71*> \endverbatim
72*>
73*> \param[in] K
74*> \verbatim
75*>          K is INTEGER
76*>          The number of elementary reflectors whose product defines
77*>          the matrix Q.
78*> \endverbatim
79*>
80*> \param[in] L
81*> \verbatim
82*>          L is INTEGER
83*>          The order of the trapezoidal part of V.
84*>          K >= L >= 0.  See Further Details.
85*> \endverbatim
86*>
87*> \param[in] MB
88*> \verbatim
89*>          MB is INTEGER
90*>          The block size used for the storage of T.  K >= MB >= 1.
91*>          This must be the same value of MB used to generate T
92*>          in STPLQT.
93*> \endverbatim
94*>
95*> \param[in] V
96*> \verbatim
97*>          V is REAL array, dimension (LDV,K)
98*>          The i-th row must contain the vector which defines the
99*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
100*>          STPLQT in B.  See Further Details.
101*> \endverbatim
102*>
103*> \param[in] LDV
104*> \verbatim
105*>          LDV is INTEGER
106*>          The leading dimension of the array V.
107*>          If SIDE = 'L', LDV >= max(1,M);
108*>          if SIDE = 'R', LDV >= max(1,N).
109*> \endverbatim
110*>
111*> \param[in] T
112*> \verbatim
113*>          T is REAL array, dimension (LDT,K)
114*>          The upper triangular factors of the block reflectors
115*>          as returned by STPLQT, stored as a MB-by-K matrix.
116*> \endverbatim
117*>
118*> \param[in] LDT
119*> \verbatim
120*>          LDT is INTEGER
121*>          The leading dimension of the array T.  LDT >= MB.
122*> \endverbatim
123*>
124*> \param[in,out] A
125*> \verbatim
126*>          A is REAL array, dimension
127*>          (LDA,N) if SIDE = 'L' or
128*>          (LDA,K) if SIDE = 'R'
129*>          On entry, the K-by-N or M-by-K matrix A.
130*>          On exit, A is overwritten by the corresponding block of
131*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
132*> \endverbatim
133*>
134*> \param[in] LDA
135*> \verbatim
136*>          LDA is INTEGER
137*>          The leading dimension of the array A.
138*>          If SIDE = 'L', LDC >= max(1,K);
139*>          If SIDE = 'R', LDC >= max(1,M).
140*> \endverbatim
141*>
142*> \param[in,out] B
143*> \verbatim
144*>          B is REAL array, dimension (LDB,N)
145*>          On entry, the M-by-N matrix B.
146*>          On exit, B is overwritten by the corresponding block of
147*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
148*> \endverbatim
149*>
150*> \param[in] LDB
151*> \verbatim
152*>          LDB is INTEGER
153*>          The leading dimension of the array B.
154*>          LDB >= max(1,M).
155*> \endverbatim
156*>
157*> \param[out] WORK
158*> \verbatim
159*>          WORK is REAL array. The dimension of WORK is
160*>           N*MB if SIDE = 'L', or  M*MB if SIDE = 'R'.
161*> \endverbatim
162*>
163*> \param[out] INFO
164*> \verbatim
165*>          INFO is INTEGER
166*>          = 0:  successful exit
167*>          < 0:  if INFO = -i, the i-th argument had an illegal value
168*> \endverbatim
169*
170*  Authors:
171*  ========
172*
173*> \author Univ. of Tennessee
174*> \author Univ. of California Berkeley
175*> \author Univ. of Colorado Denver
176*> \author NAG Ltd.
177*
178*> \ingroup doubleOTHERcomputational
179*
180*> \par Further Details:
181*  =====================
182*>
183*> \verbatim
184*>
185*>  The columns of the pentagonal matrix V contain the elementary reflectors
186*>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a
187*>  trapezoidal block V2:
188*>
189*>        V = [V1] [V2].
190*>
191*>
192*>  The size of the trapezoidal block V2 is determined by the parameter L,
193*>  where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
194*>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is lower triangular;
195*>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
196*>
197*>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is K-by-M.
198*>                      [B]
199*>
200*>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is K-by-N.
201*>
202*>  The real orthogonal matrix Q is formed from V and T.
203*>
204*>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
205*>
206*>  If TRANS='T' and SIDE='L', C is on exit replaced with Q**T * C.
207*>
208*>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
209*>
210*>  If TRANS='T' and SIDE='R', C is on exit replaced with C * Q**T.
211*> \endverbatim
212*>
213*  =====================================================================
214      SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
215     $                    A, LDA, B, LDB, WORK, INFO )
216*
217*  -- LAPACK computational routine --
218*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
219*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
220*
221*     .. Scalar Arguments ..
222      CHARACTER SIDE, TRANS
223      INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
224*     ..
225*     .. Array Arguments ..
226      REAL   V( LDV, * ), A( LDA, * ), B( LDB, * ),
227     $                   T( LDT, * ), WORK( * )
228*     ..
229*
230*  =====================================================================
231*
232*     ..
233*     .. Local Scalars ..
234      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
235      INTEGER            I, IB, NB, LB, KF, LDAQ
236*     ..
237*     .. External Functions ..
238      LOGICAL            LSAME
239      EXTERNAL           LSAME
240*     ..
241*     .. External Subroutines ..
242      EXTERNAL           SLARFB, STPRFB, XERBLA
243*     ..
244*     .. Intrinsic Functions ..
245      INTRINSIC          MAX, MIN
246*     ..
247*     .. Executable Statements ..
248*
249*     .. Test the input arguments ..
250*
251      INFO   = 0
252      LEFT   = LSAME( SIDE,  'L' )
253      RIGHT  = LSAME( SIDE,  'R' )
254      TRAN   = LSAME( TRANS, 'T' )
255      NOTRAN = LSAME( TRANS, 'N' )
256*
257      IF ( LEFT ) THEN
258         LDAQ = MAX( 1, K )
259      ELSE IF ( RIGHT ) THEN
260         LDAQ = MAX( 1, M )
261      END IF
262      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
263         INFO = -1
264      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
265         INFO = -2
266      ELSE IF( M.LT.0 ) THEN
267         INFO = -3
268      ELSE IF( N.LT.0 ) THEN
269         INFO = -4
270      ELSE IF( K.LT.0 ) THEN
271         INFO = -5
272      ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
273         INFO = -6
274      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
275         INFO = -7
276      ELSE IF( LDV.LT.K ) THEN
277         INFO = -9
278      ELSE IF( LDT.LT.MB ) THEN
279         INFO = -11
280      ELSE IF( LDA.LT.LDAQ ) THEN
281         INFO = -13
282      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
283         INFO = -15
284      END IF
285*
286      IF( INFO.NE.0 ) THEN
287         CALL XERBLA( 'STPMLQT', -INFO )
288         RETURN
289      END IF
290*
291*     .. Quick return if possible ..
292*
293      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
294*
295      IF( LEFT .AND. NOTRAN ) THEN
296*
297         DO I = 1, K, MB
298            IB = MIN( MB, K-I+1 )
299            NB = MIN( M-L+I+IB-1, M )
300            IF( I.GE.L ) THEN
301               LB = 0
302            ELSE
303               LB = 0
304            END IF
305            CALL STPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB,
306     $                   V( I, 1 ), LDV, T( 1, I ), LDT,
307     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
308         END DO
309*
310      ELSE IF( RIGHT .AND. TRAN ) THEN
311*
312         DO I = 1, K, MB
313            IB = MIN( MB, K-I+1 )
314            NB = MIN( N-L+I+IB-1, N )
315            IF( I.GE.L ) THEN
316               LB = 0
317            ELSE
318               LB = NB-N+L-I+1
319            END IF
320            CALL STPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB,
321     $                   V( I, 1 ), LDV, T( 1, I ), LDT,
322     $                   A( 1, I ), LDA, B, LDB, WORK, M )
323         END DO
324*
325      ELSE IF( LEFT .AND. TRAN ) THEN
326*
327         KF = ((K-1)/MB)*MB+1
328         DO I = KF, 1, -MB
329            IB = MIN( MB, K-I+1 )
330            NB = MIN( M-L+I+IB-1, M )
331            IF( I.GE.L ) THEN
332               LB = 0
333            ELSE
334               LB = 0
335            END IF
336            CALL STPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
337     $                   V( I, 1 ), LDV, T( 1, I ), LDT,
338     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
339         END DO
340*
341      ELSE IF( RIGHT .AND. NOTRAN ) THEN
342*
343         KF = ((K-1)/MB)*MB+1
344         DO I = KF, 1, -MB
345            IB = MIN( MB, K-I+1 )
346            NB = MIN( N-L+I+IB-1, N )
347            IF( I.GE.L ) THEN
348               LB = 0
349            ELSE
350               LB = NB-N+L-I+1
351            END IF
352            CALL STPRFB( 'R', 'T', 'F', 'R', M, NB, IB, LB,
353     $                   V( I, 1 ), LDV, T( 1, I ), LDT,
354     $                   A( 1, I ), LDA, B, LDB, WORK, M )
355         END DO
356*
357      END IF
358*
359      RETURN
360*
361*     End of STPMLQT
362*
363      END
364