LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sormbr()

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.

Definition at line 194 of file sormbr.f.

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