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

◆ clabrd()

subroutine clabrd ( integer  m,
integer  n,
integer  nb,
complex, dimension( lda, * )  a,
integer  lda,
real, dimension( * )  d,
real, dimension( * )  e,
complex, dimension( * )  tauq,
complex, dimension( * )  taup,
complex, dimension( ldx, * )  x,
integer  ldx,
complex, dimension( ldy, * )  y,
integer  ldy 
)

CLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.

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

Purpose:
 CLABRD reduces the first NB rows and columns of a complex general
 m by n matrix A to upper or lower real bidiagonal form by a unitary
 transformation Q**H * A * P, and returns the matrices X and Y which
 are needed to apply the transformation to the unreduced part of A.

 If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
 bidiagonal form.

 This is an auxiliary routine called by CGEBRD
Parameters
[in]M
          M is INTEGER
          The number of rows in the matrix A.
[in]N
          N is INTEGER
          The number of columns in the matrix A.
[in]NB
          NB is INTEGER
          The number of leading rows and columns of A to be reduced.
[in,out]A
          A is COMPLEX array, dimension (LDA,N)
          On entry, the m by n general matrix to be reduced.
          On exit, the first NB rows and columns of the matrix are
          overwritten; the rest of the array is unchanged.
          If m >= n, elements on and below the diagonal in the first NB
            columns, with the array TAUQ, represent the unitary
            matrix Q as a product of elementary reflectors; and
            elements above the diagonal in the first NB rows, with the
            array TAUP, represent the unitary matrix P as a product
            of elementary reflectors.
          If m < n, elements below the diagonal in the first NB
            columns, with the array TAUQ, represent the unitary
            matrix Q as a product of elementary reflectors, and
            elements on and above the diagonal in the first NB rows,
            with the array TAUP, represent the unitary matrix P as
            a product of elementary reflectors.
          See Further Details.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,M).
[out]D
          D is REAL array, dimension (NB)
          The diagonal elements of the first NB rows and columns of
          the reduced matrix.  D(i) = A(i,i).
[out]E
          E is REAL array, dimension (NB)
          The off-diagonal elements of the first NB rows and columns of
          the reduced matrix.
[out]TAUQ
          TAUQ is COMPLEX array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the unitary matrix Q. See Further Details.
[out]TAUP
          TAUP is COMPLEX array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the unitary matrix P. See Further Details.
[out]X
          X is COMPLEX array, dimension (LDX,NB)
          The m-by-nb matrix X required to update the unreduced part
          of A.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X. LDX >= max(1,M).
[out]Y
          Y is COMPLEX array, dimension (LDY,NB)
          The n-by-nb matrix Y required to update the unreduced part
          of A.
[in]LDY
          LDY is INTEGER
          The leading dimension of the array Y. LDY >= max(1,N).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  The matrices Q and P are represented as products of elementary
  reflectors:

     Q = H(1) H(2) . . . H(nb)  and  P = G(1) G(2) . . . G(nb)

  Each H(i) and G(i) has the form:

     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H

  where tauq and taup are complex scalars, and v and u are complex
  vectors.

  If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
  A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).

  If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
  A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).

  The elements of the vectors v and u together form the m-by-nb matrix
  V and the nb-by-n matrix U**H which are needed, with X and Y, to apply
  the transformation to the unreduced part of the matrix, using a block
  update of the form:  A := A - V*Y**H - X*U**H.

  The contents of A on exit are illustrated by the following examples
  with nb = 2:

  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):

    (  1   1   u1  u1  u1 )           (  1   u1  u1  u1  u1  u1 )
    (  v1  1   1   u2  u2 )           (  1   1   u2  u2  u2  u2 )
    (  v1  v2  a   a   a  )           (  v1  1   a   a   a   a  )
    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
    (  v1  v2  a   a   a  )

  where a denotes an element of the original matrix which is unchanged,
  vi denotes an element of the vector defining H(i), and ui an element
  of the vector defining G(i).

Definition at line 210 of file clabrd.f.

212*
213* -- LAPACK auxiliary routine --
214* -- LAPACK is a software package provided by Univ. of Tennessee, --
215* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
216*
217* .. Scalar Arguments ..
218 INTEGER LDA, LDX, LDY, M, N, NB
219* ..
220* .. Array Arguments ..
221 REAL D( * ), E( * )
222 COMPLEX A( LDA, * ), TAUP( * ), TAUQ( * ), X( LDX, * ),
223 $ Y( LDY, * )
224* ..
225*
226* =====================================================================
227*
228* .. Parameters ..
229 COMPLEX ZERO, ONE
230 parameter( zero = ( 0.0e+0, 0.0e+0 ),
231 $ one = ( 1.0e+0, 0.0e+0 ) )
232* ..
233* .. Local Scalars ..
234 INTEGER I
235 COMPLEX ALPHA
236* ..
237* .. External Subroutines ..
238 EXTERNAL cgemv, clacgv, clarfg, cscal
239* ..
240* .. Intrinsic Functions ..
241 INTRINSIC min
242* ..
243* .. Executable Statements ..
244*
245* Quick return if possible
246*
247 IF( m.LE.0 .OR. n.LE.0 )
248 $ RETURN
249*
250 IF( m.GE.n ) THEN
251*
252* Reduce to upper bidiagonal form
253*
254 DO 10 i = 1, nb
255*
256* Update A(i:m,i)
257*
258 CALL clacgv( i-1, y( i, 1 ), ldy )
259 CALL cgemv( 'No transpose', m-i+1, i-1, -one, a( i, 1 ),
260 $ lda, y( i, 1 ), ldy, one, a( i, i ), 1 )
261 CALL clacgv( i-1, y( i, 1 ), ldy )
262 CALL cgemv( 'No transpose', m-i+1, i-1, -one, x( i, 1 ),
263 $ ldx, a( 1, i ), 1, one, a( i, i ), 1 )
264*
265* Generate reflection Q(i) to annihilate A(i+1:m,i)
266*
267 alpha = a( i, i )
268 CALL clarfg( m-i+1, alpha, a( min( i+1, m ), i ), 1,
269 $ tauq( i ) )
270 d( i ) = real( alpha )
271 IF( i.LT.n ) THEN
272 a( i, i ) = one
273*
274* Compute Y(i+1:n,i)
275*
276 CALL cgemv( 'Conjugate transpose', m-i+1, n-i, one,
277 $ a( i, i+1 ), lda, a( i, i ), 1, zero,
278 $ y( i+1, i ), 1 )
279 CALL cgemv( 'Conjugate transpose', m-i+1, i-1, one,
280 $ a( i, 1 ), lda, a( i, i ), 1, zero,
281 $ y( 1, i ), 1 )
282 CALL cgemv( 'No transpose', n-i, i-1, -one, y( i+1, 1 ),
283 $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
284 CALL cgemv( 'Conjugate transpose', m-i+1, i-1, one,
285 $ x( i, 1 ), ldx, a( i, i ), 1, zero,
286 $ y( 1, i ), 1 )
287 CALL cgemv( 'Conjugate transpose', i-1, n-i, -one,
288 $ a( 1, i+1 ), lda, y( 1, i ), 1, one,
289 $ y( i+1, i ), 1 )
290 CALL cscal( n-i, tauq( i ), y( i+1, i ), 1 )
291*
292* Update A(i,i+1:n)
293*
294 CALL clacgv( n-i, a( i, i+1 ), lda )
295 CALL clacgv( i, a( i, 1 ), lda )
296 CALL cgemv( 'No transpose', n-i, i, -one, y( i+1, 1 ),
297 $ ldy, a( i, 1 ), lda, one, a( i, i+1 ), lda )
298 CALL clacgv( i, a( i, 1 ), lda )
299 CALL clacgv( i-1, x( i, 1 ), ldx )
300 CALL cgemv( 'Conjugate transpose', i-1, n-i, -one,
301 $ a( 1, i+1 ), lda, x( i, 1 ), ldx, one,
302 $ a( i, i+1 ), lda )
303 CALL clacgv( i-1, x( i, 1 ), ldx )
304*
305* Generate reflection P(i) to annihilate A(i,i+2:n)
306*
307 alpha = a( i, i+1 )
308 CALL clarfg( n-i, alpha, a( i, min( i+2, n ) ),
309 $ lda, taup( i ) )
310 e( i ) = real( alpha )
311 a( i, i+1 ) = one
312*
313* Compute X(i+1:m,i)
314*
315 CALL cgemv( 'No transpose', m-i, n-i, one, a( i+1, i+1 ),
316 $ lda, a( i, i+1 ), lda, zero, x( i+1, i ), 1 )
317 CALL cgemv( 'Conjugate transpose', n-i, i, one,
318 $ y( i+1, 1 ), ldy, a( i, i+1 ), lda, zero,
319 $ x( 1, i ), 1 )
320 CALL cgemv( 'No transpose', m-i, i, -one, a( i+1, 1 ),
321 $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
322 CALL cgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
323 $ lda, a( i, i+1 ), lda, zero, x( 1, i ), 1 )
324 CALL cgemv( 'No transpose', m-i, i-1, -one, x( i+1, 1 ),
325 $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
326 CALL cscal( m-i, taup( i ), x( i+1, i ), 1 )
327 CALL clacgv( n-i, a( i, i+1 ), lda )
328 END IF
329 10 CONTINUE
330 ELSE
331*
332* Reduce to lower bidiagonal form
333*
334 DO 20 i = 1, nb
335*
336* Update A(i,i:n)
337*
338 CALL clacgv( n-i+1, a( i, i ), lda )
339 CALL clacgv( i-1, a( i, 1 ), lda )
340 CALL cgemv( 'No transpose', n-i+1, i-1, -one, y( i, 1 ),
341 $ ldy, a( i, 1 ), lda, one, a( i, i ), lda )
342 CALL clacgv( i-1, a( i, 1 ), lda )
343 CALL clacgv( i-1, x( i, 1 ), ldx )
344 CALL cgemv( 'Conjugate transpose', i-1, n-i+1, -one,
345 $ a( 1, i ), lda, x( i, 1 ), ldx, one, a( i, i ),
346 $ lda )
347 CALL clacgv( i-1, x( i, 1 ), ldx )
348*
349* Generate reflection P(i) to annihilate A(i,i+1:n)
350*
351 alpha = a( i, i )
352 CALL clarfg( n-i+1, alpha, a( i, min( i+1, n ) ), lda,
353 $ taup( i ) )
354 d( i ) = real( alpha )
355 IF( i.LT.m ) THEN
356 a( i, i ) = one
357*
358* Compute X(i+1:m,i)
359*
360 CALL cgemv( 'No transpose', m-i, n-i+1, one, a( i+1, i ),
361 $ lda, a( i, i ), lda, zero, x( i+1, i ), 1 )
362 CALL cgemv( 'Conjugate transpose', n-i+1, i-1, one,
363 $ y( i, 1 ), ldy, a( i, i ), lda, zero,
364 $ x( 1, i ), 1 )
365 CALL cgemv( 'No transpose', m-i, i-1, -one, a( i+1, 1 ),
366 $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
367 CALL cgemv( 'No transpose', i-1, n-i+1, one, a( 1, i ),
368 $ lda, a( i, i ), lda, zero, x( 1, i ), 1 )
369 CALL cgemv( 'No transpose', m-i, i-1, -one, x( i+1, 1 ),
370 $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
371 CALL cscal( m-i, taup( i ), x( i+1, i ), 1 )
372 CALL clacgv( n-i+1, a( i, i ), lda )
373*
374* Update A(i+1:m,i)
375*
376 CALL clacgv( i-1, y( i, 1 ), ldy )
377 CALL cgemv( 'No transpose', m-i, i-1, -one, a( i+1, 1 ),
378 $ lda, y( i, 1 ), ldy, one, a( i+1, i ), 1 )
379 CALL clacgv( i-1, y( i, 1 ), ldy )
380 CALL cgemv( 'No transpose', m-i, i, -one, x( i+1, 1 ),
381 $ ldx, a( 1, i ), 1, one, a( i+1, i ), 1 )
382*
383* Generate reflection Q(i) to annihilate A(i+2:m,i)
384*
385 alpha = a( i+1, i )
386 CALL clarfg( m-i, alpha, a( min( i+2, m ), i ), 1,
387 $ tauq( i ) )
388 e( i ) = real( alpha )
389 a( i+1, i ) = one
390*
391* Compute Y(i+1:n,i)
392*
393 CALL cgemv( 'Conjugate transpose', m-i, n-i, one,
394 $ a( i+1, i+1 ), lda, a( i+1, i ), 1, zero,
395 $ y( i+1, i ), 1 )
396 CALL cgemv( 'Conjugate transpose', m-i, i-1, one,
397 $ a( i+1, 1 ), lda, a( i+1, i ), 1, zero,
398 $ y( 1, i ), 1 )
399 CALL cgemv( 'No transpose', n-i, i-1, -one, y( i+1, 1 ),
400 $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
401 CALL cgemv( 'Conjugate transpose', m-i, i, one,
402 $ x( i+1, 1 ), ldx, a( i+1, i ), 1, zero,
403 $ y( 1, i ), 1 )
404 CALL cgemv( 'Conjugate transpose', i, n-i, -one,
405 $ a( 1, i+1 ), lda, y( 1, i ), 1, one,
406 $ y( i+1, i ), 1 )
407 CALL cscal( n-i, tauq( i ), y( i+1, i ), 1 )
408 ELSE
409 CALL clacgv( n-i+1, a( i, i ), lda )
410 END IF
411 20 CONTINUE
412 END IF
413 RETURN
414*
415* End of CLABRD
416*
cgemv
subroutine cgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
CGEMV
Definition cgemv.f:160
clacgv
subroutine clacgv(n, x, incx)
CLACGV conjugates a complex vector.
Definition clacgv.f:74
clarfg
subroutine clarfg(n, alpha, x, incx, tau)
CLARFG generates an elementary reflector (Householder matrix).
Definition clarfg.f:106
cscal
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78
Here is the call graph for this function:
Here is the caller graph for this function: