Annotation of rpl/lapack/lapack/dgemqr.f, revision 1.4
1.4 ! bertrand 1: *> \brief \b DGEMQR
1.1 bertrand 2: *
3: * Definition:
4: * ===========
5: *
6: * SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
7: * $ TSIZE, C, LDC, WORK, LWORK, INFO )
8: *
9: *
10: * .. Scalar Arguments ..
11: * CHARACTER SIDE, TRANS
12: * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
13: * ..
14: * .. Array Arguments ..
15: * DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
16: * ..
17: *
18: *> \par Purpose:
19: * =============
20: *>
21: *> \verbatim
22: *>
23: *> DGEMQR overwrites the general real M-by-N matrix C with
24: *>
25: *> SIDE = 'L' SIDE = 'R'
26: *> TRANS = 'N': Q * C C * Q
27: *> TRANS = 'T': Q**T * C C * Q**T
28: *>
29: *> where Q is a real orthogonal matrix defined as the product
30: *> of blocked elementary reflectors computed by tall skinny
31: *> QR factorization (DGEQR)
32: *>
33: *> \endverbatim
34: *
35: * Arguments:
36: * ==========
37: *
38: *> \param[in] SIDE
39: *> \verbatim
40: *> SIDE is CHARACTER*1
41: *> = 'L': apply Q or Q**T from the Left;
42: *> = 'R': apply Q or Q**T from the Right.
43: *> \endverbatim
44: *>
45: *> \param[in] TRANS
46: *> \verbatim
47: *> TRANS is CHARACTER*1
48: *> = 'N': No transpose, apply Q;
49: *> = 'T': Transpose, apply Q**T.
50: *> \endverbatim
51: *>
52: *> \param[in] M
53: *> \verbatim
54: *> M is INTEGER
55: *> The number of rows of the matrix A. M >=0.
56: *> \endverbatim
57: *>
58: *> \param[in] N
59: *> \verbatim
60: *> N is INTEGER
61: *> The number of columns of the matrix C. N >= 0.
62: *> \endverbatim
63: *>
64: *> \param[in] K
65: *> \verbatim
66: *> K is INTEGER
67: *> The number of elementary reflectors whose product defines
68: *> the matrix Q.
69: *> If SIDE = 'L', M >= K >= 0;
70: *> if SIDE = 'R', N >= K >= 0.
71: *> \endverbatim
72: *>
73: *> \param[in] A
74: *> \verbatim
75: *> A is DOUBLE PRECISION array, dimension (LDA,K)
76: *> Part of the data structure to represent Q as returned by DGEQR.
77: *> \endverbatim
78: *>
79: *> \param[in] LDA
80: *> \verbatim
81: *> LDA is INTEGER
82: *> The leading dimension of the array A.
83: *> If SIDE = 'L', LDA >= max(1,M);
84: *> if SIDE = 'R', LDA >= max(1,N).
85: *> \endverbatim
86: *>
87: *> \param[in] T
88: *> \verbatim
89: *> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE)).
90: *> Part of the data structure to represent Q as returned by DGEQR.
91: *> \endverbatim
92: *>
93: *> \param[in] TSIZE
94: *> \verbatim
95: *> TSIZE is INTEGER
96: *> The dimension of the array T. TSIZE >= 5.
97: *> \endverbatim
98: *>
99: *> \param[in,out] C
100: *> \verbatim
101: *> C is DOUBLE PRECISION array, dimension (LDC,N)
102: *> On entry, the M-by-N matrix C.
103: *> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
104: *> \endverbatim
105: *>
106: *> \param[in] LDC
107: *> \verbatim
108: *> LDC is INTEGER
109: *> The leading dimension of the array C. LDC >= max(1,M).
110: *> \endverbatim
111: *>
112: *> \param[out] WORK
113: *> \verbatim
114: *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
115: *> \endverbatim
116: *>
117: *> \param[in] LWORK
118: *> \verbatim
119: *> LWORK is INTEGER
120: *> The dimension of the array WORK.
121: *> If LWORK = -1, then a workspace query is assumed. The routine
122: *> only calculates the size of the WORK array, returns this
123: *> value as WORK(1), and no error message related to WORK
124: *> is issued by XERBLA.
125: *> \endverbatim
126: *>
127: *> \param[out] INFO
128: *> \verbatim
129: *> INFO is INTEGER
130: *> = 0: successful exit
131: *> < 0: if INFO = -i, the i-th argument had an illegal value
132: *> \endverbatim
133: *
134: * Authors:
135: * ========
136: *
137: *> \author Univ. of Tennessee
138: *> \author Univ. of California Berkeley
139: *> \author Univ. of Colorado Denver
140: *> \author NAG Ltd.
141: *
142: *> \par Further Details
143: * ====================
144: *>
145: *> \verbatim
146: *>
147: *> These details are particular for this LAPACK implementation. Users should not
1.4 ! bertrand 148: *> take them for granted. These details may change in the future, and are not likely
1.1 bertrand 149: *> true for another LAPACK implementation. These details are relevant if one wants
150: *> to try to understand the code. They are not part of the interface.
151: *>
152: *> In this version,
153: *>
154: *> T(2): row block size (MB)
155: *> T(3): column block size (NB)
156: *> T(6:TSIZE): data structure needed for Q, computed by
157: *> DLATSQR or DGEQRT
158: *>
159: *> Depending on the matrix dimensions M and N, and row and column
160: *> block sizes MB and NB returned by ILAENV, DGEQR will use either
161: *> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
162: *> the QR factorization.
163: *> This version of DGEMQR will use either DLAMTSQR or DGEMQRT to
164: *> multiply matrix Q by another matrix.
165: *> Further Details in DLATMSQR or DGEMQRT.
166: *>
167: *> \endverbatim
168: *>
169: * =====================================================================
170: SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
171: $ C, LDC, WORK, LWORK, INFO )
172: *
173: * -- LAPACK computational routine (version 3.7.0) --
174: * -- LAPACK is a software package provided by Univ. of Tennessee, --
175: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176: * December 2016
177: *
178: * .. Scalar Arguments ..
179: CHARACTER SIDE, TRANS
180: INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
181: * ..
182: * .. Array Arguments ..
183: DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
184: * ..
185: *
186: * =====================================================================
187: *
188: * ..
189: * .. Local Scalars ..
190: LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
191: INTEGER MB, NB, LW, NBLCKS, MN
192: * ..
193: * .. External Functions ..
194: LOGICAL LSAME
195: EXTERNAL LSAME
196: * ..
197: * .. External Subroutines ..
198: EXTERNAL DGEMQRT, DLAMTSQR, XERBLA
199: * ..
200: * .. Intrinsic Functions ..
201: INTRINSIC INT, MAX, MIN, MOD
202: * ..
203: * .. Executable Statements ..
204: *
205: * Test the input arguments
206: *
207: LQUERY = LWORK.EQ.-1
208: NOTRAN = LSAME( TRANS, 'N' )
209: TRAN = LSAME( TRANS, 'T' )
210: LEFT = LSAME( SIDE, 'L' )
211: RIGHT = LSAME( SIDE, 'R' )
212: *
213: MB = INT( T( 2 ) )
214: NB = INT( T( 3 ) )
215: IF( LEFT ) THEN
216: LW = N * NB
217: MN = M
218: ELSE
219: LW = MB * NB
220: MN = N
221: END IF
222: *
223: IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
224: IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
225: NBLCKS = ( MN - K ) / ( MB - K )
226: ELSE
227: NBLCKS = ( MN - K ) / ( MB - K ) + 1
228: END IF
229: ELSE
230: NBLCKS = 1
231: END IF
232: *
233: INFO = 0
234: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
235: INFO = -1
236: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
237: INFO = -2
238: ELSE IF( M.LT.0 ) THEN
239: INFO = -3
240: ELSE IF( N.LT.0 ) THEN
241: INFO = -4
242: ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
243: INFO = -5
244: ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
245: INFO = -7
246: ELSE IF( TSIZE.LT.5 ) THEN
247: INFO = -9
248: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
249: INFO = -11
250: ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
251: INFO = -13
252: END IF
253: *
254: IF( INFO.EQ.0 ) THEN
255: WORK( 1 ) = LW
256: END IF
257: *
258: IF( INFO.NE.0 ) THEN
259: CALL XERBLA( 'DGEMQR', -INFO )
260: RETURN
261: ELSE IF( LQUERY ) THEN
262: RETURN
263: END IF
264: *
265: * Quick return if possible
266: *
267: IF( MIN( M, N, K ).EQ.0 ) THEN
268: RETURN
269: END IF
270: *
271: IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
272: $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
273: CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
274: $ NB, C, LDC, WORK, INFO )
275: ELSE
276: CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
277: $ NB, C, LDC, WORK, LWORK, INFO )
278: END IF
279: *
280: WORK( 1 ) = LW
281: *
282: RETURN
283: *
284: * End of DGEMQR
285: *
286: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dgemqr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack