LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine sormbr ( character  VECT,
character  SIDE,
character  TRANS,
integer  M,
integer  N,
integer  K,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  TAU,
real, dimension( ldc, * )  C,
integer  LDC,
real, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

SORMBR

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

Purpose:
 If VECT = 'Q', SORMBR 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

 If VECT = 'P', SORMBR overwrites the general real M-by-N matrix C
 with
                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      P * C          C * P
 TRANS = 'T':      P**T * C       C * P**T

 Here Q and P**T are the orthogonal matrices determined by SGEBRD when
 reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
 P**T are defined as products of elementary reflectors H(i) and G(i)
 respectively.

 Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
 order of the orthogonal matrix Q or P**T that is applied.

 If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
 if nq >= k, Q = H(1) H(2) . . . H(k);
 if nq < k, Q = H(1) H(2) . . . H(nq-1).

 If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
 if k < nq, P = G(1) G(2) . . . G(k);
 if k >= nq, P = G(1) G(2) . . . G(nq-1).
Parameters
[in]VECT
          VECT is CHARACTER*1
          = 'Q': apply Q or Q**T;
          = 'P': apply P or P**T.
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q, Q**T, P or P**T from the Left;
          = 'R': apply Q, Q**T, P or P**T from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  No transpose, apply Q  or P;
          = 'T':  Transpose, apply Q**T or P**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
          If VECT = 'Q', the number of columns in the original
          matrix reduced by SGEBRD.
          If VECT = 'P', the number of rows in the original
          matrix reduced by SGEBRD.
          K >= 0.
[in]A
          A is REAL array, dimension
                                (LDA,min(nq,K)) if VECT = 'Q'
                                (LDA,nq)        if VECT = 'P'
          The vectors which define the elementary reflectors H(i) and
          G(i), whose products determine the matrices Q and P, as
          returned by SGEBRD.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.
          If VECT = 'Q', LDA >= max(1,nq);
          if VECT = 'P', LDA >= max(1,min(nq,K)).
[in]TAU
          TAU is REAL array, dimension (min(nq,K))
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i) or G(i) which determines Q or P, as returned
          by SGEBRD in the array argument TAUQ or TAUP.
[in,out]C
          C is REAL 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
          or P*C or P**T*C or C*P or C*P**T.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is REAL 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 optimum performance LWORK >= N*NB if SIDE = 'L', and
          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
          blocksize.

          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.
Date
November 2011

Definition at line 198 of file sormbr.f.

198 *
199 * -- LAPACK computational routine (version 3.4.0) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * November 2011
203 *
204 * .. Scalar Arguments ..
205  CHARACTER side, trans, vect
206  INTEGER info, k, lda, ldc, lwork, m, n
207 * ..
208 * .. Array Arguments ..
209  REAL a( lda, * ), c( ldc, * ), tau( * ),
210  $ work( * )
211 * ..
212 *
213 * =====================================================================
214 *
215 * .. Local Scalars ..
216  LOGICAL applyq, left, lquery, notran
217  CHARACTER transt
218  INTEGER i1, i2, iinfo, lwkopt, mi, nb, ni, nq, nw
219 * ..
220 * .. External Functions ..
221  LOGICAL lsame
222  INTEGER ilaenv
223  EXTERNAL ilaenv, lsame
224 * ..
225 * .. External Subroutines ..
226  EXTERNAL sormlq, sormqr, xerbla
227 * ..
228 * .. Intrinsic Functions ..
229  INTRINSIC max, min
230 * ..
231 * .. Executable Statements ..
232 *
233 * Test the input arguments
234 *
235  info = 0
236  applyq = lsame( vect, 'Q' )
237  left = lsame( side, 'L' )
238  notran = lsame( trans, 'N' )
239  lquery = ( lwork.EQ.-1 )
240 *
241 * NQ is the order of Q or P and NW is the minimum dimension of WORK
242 *
243  IF( left ) THEN
244  nq = m
245  nw = n
246  ELSE
247  nq = n
248  nw = m
249  END IF
250  IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
251  info = -1
252  ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
253  info = -2
254  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
255  info = -3
256  ELSE IF( m.LT.0 ) THEN
257  info = -4
258  ELSE IF( n.LT.0 ) THEN
259  info = -5
260  ELSE IF( k.LT.0 ) THEN
261  info = -6
262  ELSE IF( ( applyq .AND. lda.LT.max( 1, nq ) ) .OR.
263  $ ( .NOT.applyq .AND. lda.LT.max( 1, min( nq, k ) ) ) )
264  $ THEN
265  info = -8
266  ELSE IF( ldc.LT.max( 1, m ) ) THEN
267  info = -11
268  ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery ) THEN
269  info = -13
270  END IF
271 *
272  IF( info.EQ.0 ) THEN
273  IF( applyq ) THEN
274  IF( left ) THEN
275  nb = ilaenv( 1, 'SORMQR', side // trans, m-1, n, m-1,
276  $ -1 )
277  ELSE
278  nb = ilaenv( 1, 'SORMQR', side // trans, m, n-1, n-1,
279  $ -1 )
280  END IF
281  ELSE
282  IF( left ) THEN
283  nb = ilaenv( 1, 'SORMLQ', side // trans, m-1, n, m-1,
284  $ -1 )
285  ELSE
286  nb = ilaenv( 1, 'SORMLQ', side // trans, m, n-1, n-1,
287  $ -1 )
288  END IF
289  END IF
290  lwkopt = max( 1, nw )*nb
291  work( 1 ) = lwkopt
292  END IF
293 *
294  IF( info.NE.0 ) THEN
295  CALL xerbla( 'SORMBR', -info )
296  RETURN
297  ELSE IF( lquery ) THEN
298  RETURN
299  END IF
300 *
301 * Quick return if possible
302 *
303  work( 1 ) = 1
304  IF( m.EQ.0 .OR. n.EQ.0 )
305  $ RETURN
306 *
307  IF( applyq ) THEN
308 *
309 * Apply Q
310 *
311  IF( nq.GE.k ) THEN
312 *
313 * Q was determined by a call to SGEBRD with nq >= k
314 *
315  CALL sormqr( side, trans, m, n, k, a, lda, tau, c, ldc,
316  $ work, lwork, iinfo )
317  ELSE IF( nq.GT.1 ) THEN
318 *
319 * Q was determined by a call to SGEBRD with nq < k
320 *
321  IF( left ) THEN
322  mi = m - 1
323  ni = n
324  i1 = 2
325  i2 = 1
326  ELSE
327  mi = m
328  ni = n - 1
329  i1 = 1
330  i2 = 2
331  END IF
332  CALL sormqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
333  $ c( i1, i2 ), ldc, work, lwork, iinfo )
334  END IF
335  ELSE
336 *
337 * Apply P
338 *
339  IF( notran ) THEN
340  transt = 'T'
341  ELSE
342  transt = 'N'
343  END IF
344  IF( nq.GT.k ) THEN
345 *
346 * P was determined by a call to SGEBRD with nq > k
347 *
348  CALL sormlq( side, transt, m, n, k, a, lda, tau, c, ldc,
349  $ work, lwork, iinfo )
350  ELSE IF( nq.GT.1 ) THEN
351 *
352 * P was determined by a call to SGEBRD with nq <= k
353 *
354  IF( left ) THEN
355  mi = m - 1
356  ni = n
357  i1 = 2
358  i2 = 1
359  ELSE
360  mi = m
361  ni = n - 1
362  i1 = 1
363  i2 = 2
364  END IF
365  CALL sormlq( side, transt, mi, ni, nq-1, a( 1, 2 ), lda,
366  $ tau, c( i1, i2 ), ldc, work, lwork, iinfo )
367  END IF
368  END IF
369  work( 1 ) = lwkopt
370  RETURN
371 *
372 * End of SORMBR
373 *
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sormlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMLQ
Definition: sormlq.f:170
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: