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