Annotation of rpl/lapack/lapack/dgemqrt.f, revision 1.10
1.1 bertrand 1: *> \brief \b DGEMQRT
2: *
3: * =========== DOCUMENTATION ===========
4: *
1.7 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.1 bertrand 7: *
8: *> \htmlonly
1.7 bertrand 9: *> Download DGEMQRT + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemqrt.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemqrt.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemqrt.f">
1.1 bertrand 15: *> [TXT]</a>
1.7 bertrand 16: *> \endhtmlonly
1.1 bertrand 17: *
18: * Definition:
19: * ===========
20: *
1.7 bertrand 21: * SUBROUTINE DGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
1.1 bertrand 22: * C, LDC, WORK, INFO )
1.7 bertrand 23: *
1.1 bertrand 24: * .. Scalar Arguments ..
25: * CHARACTER SIDE, TRANS
26: * INTEGER INFO, K, LDV, LDC, M, N, NB, LDT
27: * ..
28: * .. Array Arguments ..
29: * DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
30: * ..
1.7 bertrand 31: *
1.1 bertrand 32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *>
38: *> DGEMQRT 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: *>
1.7 bertrand 49: *> generated using the compact WY representation as returned by DGEQRT.
1.1 bertrand 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] NB
93: *> \verbatim
94: *> NB is INTEGER
95: *> The block size used for the storage of T. K >= NB >= 1.
96: *> This must be the same value of NB used to generate T
1.10 ! bertrand 97: *> in DGEQRT.
1.1 bertrand 98: *> \endverbatim
99: *>
100: *> \param[in] V
101: *> \verbatim
102: *> V is DOUBLE PRECISION array, dimension (LDV,K)
103: *> The i-th column must contain the vector which defines the
104: *> elementary reflector H(i), for i = 1,2,...,k, as returned by
1.10 ! bertrand 105: *> DGEQRT in the first K columns of its array argument A.
1.1 bertrand 106: *> \endverbatim
107: *>
108: *> \param[in] LDV
109: *> \verbatim
110: *> LDV is INTEGER
111: *> The leading dimension of the array V.
112: *> If SIDE = 'L', LDA >= max(1,M);
113: *> if SIDE = 'R', LDA >= max(1,N).
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
1.10 ! bertrand 120: *> as returned by DGEQRT, stored as a NB-by-N matrix.
1.1 bertrand 121: *> \endverbatim
122: *>
123: *> \param[in] LDT
124: *> \verbatim
125: *> LDT is INTEGER
126: *> The leading dimension of the array T. LDT >= NB.
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*NB if SIDE = 'L', or M*NB 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: *
1.7 bertrand 158: *> \author Univ. of Tennessee
159: *> \author Univ. of California Berkeley
160: *> \author Univ. of Colorado Denver
161: *> \author NAG Ltd.
1.1 bertrand 162: *
163: *> \ingroup doubleGEcomputational
164: *
165: * =====================================================================
1.7 bertrand 166: SUBROUTINE DGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT,
1.1 bertrand 167: $ C, LDC, WORK, INFO )
168: *
1.10 ! bertrand 169: * -- LAPACK computational routine --
1.1 bertrand 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, NB, 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' )
1.7 bertrand 207: *
1.1 bertrand 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
1.4 bertrand 225: ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0)) THEN
1.1 bertrand 226: INFO = -6
227: ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN
228: INFO = -8
229: ELSE IF( LDT.LT.NB ) 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( 'DGEMQRT', -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. TRAN ) THEN
245: *
246: DO I = 1, K, NB
247: IB = MIN( NB, K-I+1 )
1.7 bertrand 248: CALL DLARFB( 'L', 'T', 'F', 'C', M-I+1, N, IB,
249: $ V( I, I ), LDV, T( 1, I ), LDT,
1.1 bertrand 250: $ C( I, 1 ), LDC, WORK, LDWORK )
251: END DO
1.7 bertrand 252: *
1.1 bertrand 253: ELSE IF( RIGHT .AND. NOTRAN ) THEN
254: *
255: DO I = 1, K, NB
256: IB = MIN( NB, K-I+1 )
1.7 bertrand 257: CALL DLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB,
258: $ V( I, I ), LDV, T( 1, I ), LDT,
1.1 bertrand 259: $ C( 1, I ), LDC, WORK, LDWORK )
260: END DO
261: *
262: ELSE IF( LEFT .AND. NOTRAN ) THEN
263: *
264: KF = ((K-1)/NB)*NB+1
265: DO I = KF, 1, -NB
1.7 bertrand 266: IB = MIN( NB, K-I+1 )
267: CALL DLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB,
268: $ V( I, I ), LDV, T( 1, I ), LDT,
1.1 bertrand 269: $ C( I, 1 ), LDC, WORK, LDWORK )
270: END DO
271: *
272: ELSE IF( RIGHT .AND. TRAN ) THEN
273: *
274: KF = ((K-1)/NB)*NB+1
275: DO I = KF, 1, -NB
1.7 bertrand 276: IB = MIN( NB, K-I+1 )
277: CALL DLARFB( 'R', 'T', 'F', 'C', M, N-I+1, IB,
278: $ V( I, I ), LDV, T( 1, I ), LDT,
1.1 bertrand 279: $ C( 1, I ), LDC, WORK, LDWORK )
280: END DO
281: *
282: END IF
283: *
284: RETURN
285: *
286: * End of DGEMQRT
287: *
288: END
CVSweb interface <joel.bertrand@systella.fr>