LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
dgemlqt.f
Go to the documentation of this file.
1 *> \brief \b DGEMLQT
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemlqt.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemlqt.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemlqt.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
22 * C, LDC, WORK, INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER SIDE, TRANS
26 * INTEGER INFO, K, LDV, LDC, M, N, MB, LDT
27 * ..
28 * .. Array Arguments ..
29 * DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> DGEMLQT overwrites the general real M-by-N matrix C with
39 *>
40 *> SIDE = 'L' SIDE = 'R'
41 *> TRANS = 'N': Q C C Q
42 *> TRANS = 'T': Q**T C C Q**T
43 *>
44 *> where Q is a real orthogonal matrix defined as the product of K
45 *> elementary reflectors:
46 *>
47 *> Q = H(1) H(2) . . . H(K) = I - V T V**T
48 *>
49 *> generated using the compact WY representation as returned by DGELQT.
50 *>
51 *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
52 *> \endverbatim
53 *
54 * Arguments:
55 * ==========
56 *
57 *> \param[in] SIDE
58 *> \verbatim
59 *> SIDE is CHARACTER*1
60 *> = 'L': apply Q or Q**T from the Left;
61 *> = 'R': apply Q or Q**T from the Right.
62 *> \endverbatim
63 *>
64 *> \param[in] TRANS
65 *> \verbatim
66 *> TRANS is CHARACTER*1
67 *> = 'N': No transpose, apply Q;
68 *> = 'C': Transpose, apply Q**T.
69 *> \endverbatim
70 *>
71 *> \param[in] M
72 *> \verbatim
73 *> M is INTEGER
74 *> The number of rows of the matrix C. M >= 0.
75 *> \endverbatim
76 *>
77 *> \param[in] N
78 *> \verbatim
79 *> N is INTEGER
80 *> The number of columns of the matrix C. N >= 0.
81 *> \endverbatim
82 *>
83 *> \param[in] K
84 *> \verbatim
85 *> K is INTEGER
86 *> The number of elementary reflectors whose product defines
87 *> the matrix Q.
88 *> If SIDE = 'L', M >= K >= 0;
89 *> if SIDE = 'R', N >= K >= 0.
90 *> \endverbatim
91 *>
92 *> \param[in] MB
93 *> \verbatim
94 *> MB is INTEGER
95 *> The block size used for the storage of T. K >= MB >= 1.
96 *> This must be the same value of MB used to generate T
97 *> in DGELQT.
98 *> \endverbatim
99 *>
100 *> \param[in] V
101 *> \verbatim
102 *> V is DOUBLE PRECISION array, dimension
103 *> (LDV,M) if SIDE = 'L',
104 *> (LDV,N) if SIDE = 'R'
105 *> The i-th row must contain the vector which defines the
106 *> elementary reflector H(i), for i = 1,2,...,k, as returned by
107 *> DGELQT in the first K rows of its array argument A.
108 *> \endverbatim
109 *>
110 *> \param[in] LDV
111 *> \verbatim
112 *> LDV is INTEGER
113 *> The leading dimension of the array V. LDV >= max(1,K).
114 *> \endverbatim
115 *>
116 *> \param[in] T
117 *> \verbatim
118 *> T is DOUBLE PRECISION array, dimension (LDT,K)
119 *> The upper triangular factors of the block reflectors
120 *> as returned by DGELQT, stored as a MB-by-K matrix.
121 *> \endverbatim
122 *>
123 *> \param[in] LDT
124 *> \verbatim
125 *> LDT is INTEGER
126 *> The leading dimension of the array T. LDT >= MB.
127 *> \endverbatim
128 *>
129 *> \param[in,out] C
130 *> \verbatim
131 *> C is DOUBLE PRECISION array, dimension (LDC,N)
132 *> On entry, the M-by-N matrix C.
133 *> On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q.
134 *> \endverbatim
135 *>
136 *> \param[in] LDC
137 *> \verbatim
138 *> LDC is INTEGER
139 *> The leading dimension of the array C. LDC >= max(1,M).
140 *> \endverbatim
141 *>
142 *> \param[out] WORK
143 *> \verbatim
144 *> WORK is DOUBLE PRECISION array. The dimension of
145 *> WORK is N*MB if SIDE = 'L', or M*MB if SIDE = 'R'.
146 *> \endverbatim
147 *>
148 *> \param[out] INFO
149 *> \verbatim
150 *> INFO is INTEGER
151 *> = 0: successful exit
152 *> < 0: if INFO = -i, the i-th argument had an illegal value
153 *> \endverbatim
154 *
155 * Authors:
156 * ========
157 *
158 *> \author Univ. of Tennessee
159 *> \author Univ. of California Berkeley
160 *> \author Univ. of Colorado Denver
161 *> \author NAG Ltd.
162 *
163 *> \ingroup doubleGEcomputational
164 *
165 * =====================================================================
166  SUBROUTINE dgemlqt( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
167  \$ C, LDC, WORK, INFO )
168 *
169 * -- LAPACK computational routine --
170 * -- LAPACK is a software package provided by Univ. of Tennessee, --
171 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172 *
173 * .. Scalar Arguments ..
174  CHARACTER SIDE, TRANS
175  INTEGER INFO, K, LDV, LDC, M, N, MB, LDT
176 * ..
177 * .. Array Arguments ..
178  DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
179 * ..
180 *
181 * =====================================================================
182 *
183 * ..
184 * .. Local Scalars ..
185  LOGICAL LEFT, RIGHT, TRAN, NOTRAN
186  INTEGER I, IB, LDWORK, KF, Q
187 * ..
188 * .. External Functions ..
189  LOGICAL LSAME
190  EXTERNAL lsame
191 * ..
192 * .. External Subroutines ..
193  EXTERNAL xerbla, dlarfb
194 * ..
195 * .. Intrinsic Functions ..
196  INTRINSIC max, min
197 * ..
198 * .. Executable Statements ..
199 *
200 * .. Test the input arguments ..
201 *
202  info = 0
203  left = lsame( side, 'L' )
204  right = lsame( side, 'R' )
205  tran = lsame( trans, 'T' )
206  notran = lsame( trans, 'N' )
207 *
208  IF( left ) THEN
209  ldwork = max( 1, n )
210  q = m
211  ELSE IF ( right ) THEN
212  ldwork = max( 1, m )
213  q = n
214  END IF
215  IF( .NOT.left .AND. .NOT.right ) THEN
216  info = -1
217  ELSE IF( .NOT.tran .AND. .NOT.notran ) THEN
218  info = -2
219  ELSE IF( m.LT.0 ) THEN
220  info = -3
221  ELSE IF( n.LT.0 ) THEN
222  info = -4
223  ELSE IF( k.LT.0 .OR. k.GT.q ) THEN
224  info = -5
225  ELSE IF( mb.LT.1 .OR. (mb.GT.k .AND. k.GT.0)) THEN
226  info = -6
227  ELSE IF( ldv.LT.max( 1, k ) ) THEN
228  info = -8
229  ELSE IF( ldt.LT.mb ) THEN
230  info = -10
231  ELSE IF( ldc.LT.max( 1, m ) ) THEN
232  info = -12
233  END IF
234 *
235  IF( info.NE.0 ) THEN
236  CALL xerbla( 'DGEMLQT', -info )
237  RETURN
238  END IF
239 *
240 * .. Quick return if possible ..
241 *
242  IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 ) RETURN
243 *
244  IF( left .AND. notran ) THEN
245 *
246  DO i = 1, k, mb
247  ib = min( mb, k-i+1 )
248  CALL dlarfb( 'L', 'T', 'F', 'R', m-i+1, n, ib,
249  \$ v( i, i ), ldv, t( 1, i ), ldt,
250  \$ c( i, 1 ), ldc, work, ldwork )
251  END DO
252 *
253  ELSE IF( right .AND. tran ) THEN
254 *
255  DO i = 1, k, mb
256  ib = min( mb, k-i+1 )
257  CALL dlarfb( 'R', 'N', 'F', 'R', m, n-i+1, ib,
258  \$ v( i, i ), ldv, t( 1, i ), ldt,
259  \$ c( 1, i ), ldc, work, ldwork )
260  END DO
261 *
262  ELSE IF( left .AND. tran ) THEN
263 *
264  kf = ((k-1)/mb)*mb+1
265  DO i = kf, 1, -mb
266  ib = min( mb, k-i+1 )
267  CALL dlarfb( 'L', 'N', 'F', 'R', m-i+1, n, ib,
268  \$ v( i, i ), ldv, t( 1, i ), ldt,
269  \$ c( i, 1 ), ldc, work, ldwork )
270  END DO
271 *
272  ELSE IF( right .AND. notran ) THEN
273 *
274  kf = ((k-1)/mb)*mb+1
275  DO i = kf, 1, -mb
276  ib = min( mb, k-i+1 )
277  CALL dlarfb( 'R', 'T', 'F', 'R', m, n-i+1, ib,
278  \$ v( i, i ), ldv, t( 1, i ), ldt,
279  \$ c( 1, i ), ldc, work, ldwork )
280  END DO
281 *
282  END IF
283 *
284  RETURN
285 *
286 * End of DGEMLQT
287 *
288  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
DGEMLQT
Definition: dgemlqt.f:168
subroutine dlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
DLARFB applies a block reflector or its transpose to a general rectangular matrix.
Definition: dlarfb.f:197