LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dormqr()

subroutine dormqr ( character  SIDE,
character  TRANS,
integer  M,
integer  N,
integer  K,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  TAU,
double precision, dimension( ldc, * )  C,
integer  LDC,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DORMQR

Download DORMQR + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DORMQR overwrites the general real M-by-N matrix C with

                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      Q * C          C * Q
 TRANS = 'T':      Q**T * C       C * Q**T

 where Q is a real orthogonal matrix defined as the product of k
 elementary reflectors

       Q = H(1) H(2) . . . H(k)

 as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
 if SIDE = 'R'.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q or Q**T from the Left;
          = 'R': apply Q or Q**T from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  No transpose, apply Q;
          = 'T':  Transpose, apply Q**T.
[in]M
          M is INTEGER
          The number of rows of the matrix C. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix C. N >= 0.
[in]K
          K is INTEGER
          The number of elementary reflectors whose product defines
          the matrix Q.
          If SIDE = 'L', M >= K >= 0;
          if SIDE = 'R', N >= K >= 0.
[in]A
          A is DOUBLE PRECISION array, dimension (LDA,K)
          The i-th column must contain the vector which defines the
          elementary reflector H(i), for i = 1,2,...,k, as returned by
          DGEQRF in the first k columns of its array argument A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.
          If SIDE = 'L', LDA >= max(1,M);
          if SIDE = 'R', LDA >= max(1,N).
[in]TAU
          TAU is DOUBLE PRECISION array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by DGEQRF.
[in,out]C
          C is DOUBLE PRECISION array, dimension (LDC,N)
          On entry, the M-by-N matrix C.
          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If SIDE = 'L', LWORK >= max(1,N);
          if SIDE = 'R', LWORK >= max(1,M).
          For good performance, LWORK should generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 165 of file dormqr.f.

167 *
168 * -- LAPACK computational routine --
169 * -- LAPACK is a software package provided by Univ. of Tennessee, --
170 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171 *
172 * .. Scalar Arguments ..
173  CHARACTER SIDE, TRANS
174  INTEGER INFO, K, LDA, LDC, LWORK, M, N
175 * ..
176 * .. Array Arguments ..
177  DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
178 * ..
179 *
180 * =====================================================================
181 *
182 * .. Parameters ..
183  INTEGER NBMAX, LDT, TSIZE
184  parameter( nbmax = 64, ldt = nbmax+1,
185  $ tsize = ldt*nbmax )
186 * ..
187 * .. Local Scalars ..
188  LOGICAL LEFT, LQUERY, NOTRAN
189  INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
190  $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
191 * ..
192 * .. External Functions ..
193  LOGICAL LSAME
194  INTEGER ILAENV
195  EXTERNAL lsame, ilaenv
196 * ..
197 * .. External Subroutines ..
198  EXTERNAL dlarfb, dlarft, dorm2r, xerbla
199 * ..
200 * .. Intrinsic Functions ..
201  INTRINSIC max, min
202 * ..
203 * .. Executable Statements ..
204 *
205 * Test the input arguments
206 *
207  info = 0
208  left = lsame( side, 'L' )
209  notran = lsame( trans, 'N' )
210  lquery = ( lwork.EQ.-1 )
211 *
212 * NQ is the order of Q and NW is the minimum dimension of WORK
213 *
214  IF( left ) THEN
215  nq = m
216  nw = max( 1, n )
217  ELSE
218  nq = n
219  nw = max( 1, m )
220  END IF
221  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
222  info = -1
223  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
224  info = -2
225  ELSE IF( m.LT.0 ) THEN
226  info = -3
227  ELSE IF( n.LT.0 ) THEN
228  info = -4
229  ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
230  info = -5
231  ELSE IF( lda.LT.max( 1, nq ) ) THEN
232  info = -7
233  ELSE IF( ldc.LT.max( 1, m ) ) THEN
234  info = -10
235  ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
236  info = -12
237  END IF
238 *
239  IF( info.EQ.0 ) THEN
240 *
241 * Compute the workspace requirements
242 *
243  nb = min( nbmax, ilaenv( 1, 'DORMQR', side // trans, m, n, k,
244  $ -1 ) )
245  lwkopt = nw*nb + tsize
246  work( 1 ) = lwkopt
247  END IF
248 *
249  IF( info.NE.0 ) THEN
250  CALL xerbla( 'DORMQR', -info )
251  RETURN
252  ELSE IF( lquery ) THEN
253  RETURN
254  END IF
255 *
256 * Quick return if possible
257 *
258  IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 ) THEN
259  work( 1 ) = 1
260  RETURN
261  END IF
262 *
263  nbmin = 2
264  ldwork = nw
265  IF( nb.GT.1 .AND. nb.LT.k ) THEN
266  IF( lwork.LT.lwkopt ) THEN
267  nb = (lwork-tsize) / ldwork
268  nbmin = max( 2, ilaenv( 2, 'DORMQR', side // trans, m, n, k,
269  $ -1 ) )
270  END IF
271  END IF
272 *
273  IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
274 *
275 * Use unblocked code
276 *
277  CALL dorm2r( side, trans, m, n, k, a, lda, tau, c, ldc, work,
278  $ iinfo )
279  ELSE
280 *
281 * Use blocked code
282 *
283  iwt = 1 + nw*nb
284  IF( ( left .AND. .NOT.notran ) .OR.
285  $ ( .NOT.left .AND. notran ) ) THEN
286  i1 = 1
287  i2 = k
288  i3 = nb
289  ELSE
290  i1 = ( ( k-1 ) / nb )*nb + 1
291  i2 = 1
292  i3 = -nb
293  END IF
294 *
295  IF( left ) THEN
296  ni = n
297  jc = 1
298  ELSE
299  mi = m
300  ic = 1
301  END IF
302 *
303  DO 10 i = i1, i2, i3
304  ib = min( nb, k-i+1 )
305 *
306 * Form the triangular factor of the block reflector
307 * H = H(i) H(i+1) . . . H(i+ib-1)
308 *
309  CALL dlarft( 'Forward', 'Columnwise', nq-i+1, ib, a( i, i ),
310  $ lda, tau( i ), work( iwt ), ldt )
311  IF( left ) THEN
312 *
313 * H or H**T is applied to C(i:m,1:n)
314 *
315  mi = m - i + 1
316  ic = i
317  ELSE
318 *
319 * H or H**T is applied to C(1:m,i:n)
320 *
321  ni = n - i + 1
322  jc = i
323  END IF
324 *
325 * Apply H or H**T
326 *
327  CALL dlarfb( side, trans, 'Forward', 'Columnwise', mi, ni,
328  $ ib, a( i, i ), lda, work( iwt ), ldt,
329  $ c( ic, jc ), ldc, work, ldwork )
330  10 CONTINUE
331  END IF
332  work( 1 ) = lwkopt
333  RETURN
334 *
335 * End of DORMQR
336 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine dlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
DLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition: dlarft.f:163
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
subroutine dorm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...
Definition: dorm2r.f:159
Here is the call graph for this function:
Here is the caller graph for this function: