LAPACK 3.12.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 REAL SROUNDUP_LWORK
221 EXTERNAL ilaenv, lsame, sroundup_lwork
222* ..
223* .. External Subroutines ..
224 EXTERNAL sormlq, sormqr, xerbla
225* ..
226* .. Intrinsic Functions ..
227 INTRINSIC max, min
228* ..
229* .. Executable Statements ..
230*
231* Test the input arguments
232*
233 info = 0
234 applyq = lsame( vect, 'Q' )
235 left = lsame( side, 'L' )
236 notran = lsame( trans, 'N' )
237 lquery = ( lwork.EQ.-1 )
238*
239* NQ is the order of Q or P and NW is the minimum dimension of WORK
240*
241 IF( left ) THEN
242 nq = m
243 nw = max( 1, n )
244 ELSE
245 nq = n
246 nw = max( 1, m )
247 END IF
248 IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
249 info = -1
250 ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
251 info = -2
252 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
253 info = -3
254 ELSE IF( m.LT.0 ) THEN
255 info = -4
256 ELSE IF( n.LT.0 ) THEN
257 info = -5
258 ELSE IF( k.LT.0 ) THEN
259 info = -6
260 ELSE IF( ( applyq .AND. lda.LT.max( 1, nq ) ) .OR.
261 $ ( .NOT.applyq .AND. lda.LT.max( 1, min( nq, k ) ) ) )
262 $ THEN
263 info = -8
264 ELSE IF( ldc.LT.max( 1, m ) ) THEN
265 info = -11
266 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
267 info = -13
268 END IF
269*
270 IF( info.EQ.0 ) THEN
271 IF( applyq ) THEN
272 IF( left ) THEN
273 nb = ilaenv( 1, 'SORMQR', side // trans, m-1, n, m-1,
274 $ -1 )
275 ELSE
276 nb = ilaenv( 1, 'SORMQR', side // trans, m, n-1, n-1,
277 $ -1 )
278 END IF
279 ELSE
280 IF( left ) THEN
281 nb = ilaenv( 1, 'SORMLQ', side // trans, m-1, n, m-1,
282 $ -1 )
283 ELSE
284 nb = ilaenv( 1, 'SORMLQ', side // trans, m, n-1, n-1,
285 $ -1 )
286 END IF
287 END IF
288 lwkopt = nw*nb
289 work( 1 ) = sroundup_lwork(lwkopt)
290 END IF
291*
292 IF( info.NE.0 ) THEN
293 CALL xerbla( 'SORMBR', -info )
294 RETURN
295 ELSE IF( lquery ) THEN
296 RETURN
297 END IF
298*
299* Quick return if possible
300*
301 work( 1 ) = 1
302 IF( m.EQ.0 .OR. n.EQ.0 )
303 $ RETURN
304*
305 IF( applyq ) THEN
306*
307* Apply Q
308*
309 IF( nq.GE.k ) THEN
310*
311* Q was determined by a call to SGEBRD with nq >= k
312*
313 CALL sormqr( side, trans, m, n, k, a, lda, tau, c, ldc,
314 $ work, lwork, iinfo )
315 ELSE IF( nq.GT.1 ) THEN
316*
317* Q was determined by a call to SGEBRD with nq < k
318*
319 IF( left ) THEN
320 mi = m - 1
321 ni = n
322 i1 = 2
323 i2 = 1
324 ELSE
325 mi = m
326 ni = n - 1
327 i1 = 1
328 i2 = 2
329 END IF
330 CALL sormqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
331 $ c( i1, i2 ), ldc, work, lwork, iinfo )
332 END IF
333 ELSE
334*
335* Apply P
336*
337 IF( notran ) THEN
338 transt = 'T'
339 ELSE
340 transt = 'N'
341 END IF
342 IF( nq.GT.k ) THEN
343*
344* P was determined by a call to SGEBRD with nq > k
345*
346 CALL sormlq( side, transt, m, n, k, a, lda, tau, c, ldc,
347 $ work, lwork, iinfo )
348 ELSE IF( nq.GT.1 ) THEN
349*
350* P was determined by a call to SGEBRD with nq <= k
351*
352 IF( left ) THEN
353 mi = m - 1
354 ni = n
355 i1 = 2
356 i2 = 1
357 ELSE
358 mi = m
359 ni = n - 1
360 i1 = 1
361 i2 = 2
362 END IF
363 CALL sormlq( side, transt, mi, ni, nq-1, a( 1, 2 ), lda,
364 $ tau, c( i1, i2 ), ldc, work, lwork, iinfo )
365 END IF
366 END IF
367 work( 1 ) = sroundup_lwork(lwkopt)
368 RETURN
369*
370* End of SORMBR
371*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
subroutine sormlq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMLQ
Definition sormlq.f:168
subroutine sormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMQR
Definition sormqr.f:168
Here is the call graph for this function:
Here is the caller graph for this function: