LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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: