LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zlalsa.f
Go to the documentation of this file.
1*> \brief \b ZLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download ZLALSA + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlalsa.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlalsa.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlalsa.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
20* LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
21* GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK,
22* IWORK, INFO )
23*
24* .. Scalar Arguments ..
25* INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
26* $ SMLSIZ
27* ..
28* .. Array Arguments ..
29* INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
30* $ K( * ), PERM( LDGCOL, * )
31* DOUBLE PRECISION C( * ), DIFL( LDU, * ), DIFR( LDU, * ),
32* $ GIVNUM( LDU, * ), POLES( LDU, * ), RWORK( * ),
33* $ S( * ), U( LDU, * ), VT( LDU, * ), Z( LDU, * )
34* COMPLEX*16 B( LDB, * ), BX( LDBX, * )
35* ..
36*
37*
38*> \par Purpose:
39* =============
40*>
41*> \verbatim
42*>
43*> ZLALSA is an intermediate step in solving the least squares problem
44*> by computing the SVD of the coefficient matrix in compact form (The
45*> singular vectors are computed as products of simple orthogonal
46*> matrices.).
47*>
48*> If ICOMPQ = 0, ZLALSA applies the inverse of the left singular vector
49*> matrix of an upper bidiagonal matrix to the right hand side; and if
50*> ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the
51*> right hand side. The singular vector matrices were generated in
52*> compact form by ZLALSA.
53*> \endverbatim
54*
55* Arguments:
56* ==========
57*
58*> \param[in] ICOMPQ
59*> \verbatim
60*> ICOMPQ is INTEGER
61*> Specifies whether the left or the right singular vector
62*> matrix is involved.
63*> = 0: Left singular vector matrix
64*> = 1: Right singular vector matrix
65*> \endverbatim
66*>
67*> \param[in] SMLSIZ
68*> \verbatim
69*> SMLSIZ is INTEGER
70*> The maximum size of the subproblems at the bottom of the
71*> computation tree.
72*> \endverbatim
73*>
74*> \param[in] N
75*> \verbatim
76*> N is INTEGER
77*> The row and column dimensions of the upper bidiagonal matrix.
78*> \endverbatim
79*>
80*> \param[in] NRHS
81*> \verbatim
82*> NRHS is INTEGER
83*> The number of columns of B and BX. NRHS must be at least 1.
84*> \endverbatim
85*>
86*> \param[in,out] B
87*> \verbatim
88*> B is COMPLEX*16 array, dimension ( LDB, NRHS )
89*> On input, B contains the right hand sides of the least
90*> squares problem in rows 1 through M.
91*> On output, B contains the solution X in rows 1 through N.
92*> \endverbatim
93*>
94*> \param[in] LDB
95*> \verbatim
96*> LDB is INTEGER
97*> The leading dimension of B in the calling subprogram.
98*> LDB must be at least max(1,MAX( M, N ) ).
99*> \endverbatim
100*>
101*> \param[out] BX
102*> \verbatim
103*> BX is COMPLEX*16 array, dimension ( LDBX, NRHS )
104*> On exit, the result of applying the left or right singular
105*> vector matrix to B.
106*> \endverbatim
107*>
108*> \param[in] LDBX
109*> \verbatim
110*> LDBX is INTEGER
111*> The leading dimension of BX.
112*> \endverbatim
113*>
114*> \param[in] U
115*> \verbatim
116*> U is DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
117*> On entry, U contains the left singular vector matrices of all
118*> subproblems at the bottom level.
119*> \endverbatim
120*>
121*> \param[in] LDU
122*> \verbatim
123*> LDU is INTEGER, LDU = > N.
124*> The leading dimension of arrays U, VT, DIFL, DIFR,
125*> POLES, GIVNUM, and Z.
126*> \endverbatim
127*>
128*> \param[in] VT
129*> \verbatim
130*> VT is DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
131*> On entry, VT**H contains the right singular vector matrices of
132*> all subproblems at the bottom level.
133*> \endverbatim
134*>
135*> \param[in] K
136*> \verbatim
137*> K is INTEGER array, dimension ( N ).
138*> \endverbatim
139*>
140*> \param[in] DIFL
141*> \verbatim
142*> DIFL is DOUBLE PRECISION array, dimension ( LDU, NLVL ).
143*> where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
144*> \endverbatim
145*>
146*> \param[in] DIFR
147*> \verbatim
148*> DIFR is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
149*> On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
150*> distances between singular values on the I-th level and
151*> singular values on the (I -1)-th level, and DIFR(*, 2 * I)
152*> record the normalizing factors of the right singular vectors
153*> matrices of subproblems on I-th level.
154*> \endverbatim
155*>
156*> \param[in] Z
157*> \verbatim
158*> Z is DOUBLE PRECISION array, dimension ( LDU, NLVL ).
159*> On entry, Z(1, I) contains the components of the deflation-
160*> adjusted updating row vector for subproblems on the I-th
161*> level.
162*> \endverbatim
163*>
164*> \param[in] POLES
165*> \verbatim
166*> POLES is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
167*> On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
168*> singular values involved in the secular equations on the I-th
169*> level.
170*> \endverbatim
171*>
172*> \param[in] GIVPTR
173*> \verbatim
174*> GIVPTR is INTEGER array, dimension ( N ).
175*> On entry, GIVPTR( I ) records the number of Givens
176*> rotations performed on the I-th problem on the computation
177*> tree.
178*> \endverbatim
179*>
180*> \param[in] GIVCOL
181*> \verbatim
182*> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
183*> On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
184*> locations of Givens rotations performed on the I-th level on
185*> the computation tree.
186*> \endverbatim
187*>
188*> \param[in] LDGCOL
189*> \verbatim
190*> LDGCOL is INTEGER, LDGCOL = > N.
191*> The leading dimension of arrays GIVCOL and PERM.
192*> \endverbatim
193*>
194*> \param[in] PERM
195*> \verbatim
196*> PERM is INTEGER array, dimension ( LDGCOL, NLVL ).
197*> On entry, PERM(*, I) records permutations done on the I-th
198*> level of the computation tree.
199*> \endverbatim
200*>
201*> \param[in] GIVNUM
202*> \verbatim
203*> GIVNUM is DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
204*> On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
205*> values of Givens rotations performed on the I-th level on the
206*> computation tree.
207*> \endverbatim
208*>
209*> \param[in] C
210*> \verbatim
211*> C is DOUBLE PRECISION array, dimension ( N ).
212*> On entry, if the I-th subproblem is not square,
213*> C( I ) contains the C-value of a Givens rotation related to
214*> the right null space of the I-th subproblem.
215*> \endverbatim
216*>
217*> \param[in] S
218*> \verbatim
219*> S is DOUBLE PRECISION array, dimension ( N ).
220*> On entry, if the I-th subproblem is not square,
221*> S( I ) contains the S-value of a Givens rotation related to
222*> the right null space of the I-th subproblem.
223*> \endverbatim
224*>
225*> \param[out] RWORK
226*> \verbatim
227*> RWORK is DOUBLE PRECISION array, dimension at least
228*> MAX( (SMLSZ+1)*NRHS*3, N*(1+NRHS) + 2*NRHS ).
229*> \endverbatim
230*>
231*> \param[out] IWORK
232*> \verbatim
233*> IWORK is INTEGER array, dimension (3*N)
234*> \endverbatim
235*>
236*> \param[out] INFO
237*> \verbatim
238*> INFO is INTEGER
239*> = 0: successful exit.
240*> < 0: if INFO = -i, the i-th argument had an illegal value.
241*> \endverbatim
242*
243* Authors:
244* ========
245*
246*> \author Univ. of Tennessee
247*> \author Univ. of California Berkeley
248*> \author Univ. of Colorado Denver
249*> \author NAG Ltd.
250*
251*> \ingroup lalsa
252*
253*> \par Contributors:
254* ==================
255*>
256*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
257*> California at Berkeley, USA \n
258*> Osni Marques, LBNL/NERSC, USA \n
259*
260* =====================================================================
261 SUBROUTINE zlalsa( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX,
262 $ U,
263 $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR,
264 $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK,
265 $ IWORK, INFO )
266*
267* -- LAPACK computational routine --
268* -- LAPACK is a software package provided by Univ. of Tennessee, --
269* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
270*
271* .. Scalar Arguments ..
272 INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
273 $ SMLSIZ
274* ..
275* .. Array Arguments ..
276 INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ),
277 $ K( * ), PERM( LDGCOL, * )
278 DOUBLE PRECISION C( * ), DIFL( LDU, * ), DIFR( LDU, * ),
279 $ GIVNUM( LDU, * ), POLES( LDU, * ), RWORK( * ),
280 $ s( * ), u( ldu, * ), vt( ldu, * ), z( ldu, * )
281 COMPLEX*16 B( LDB, * ), BX( LDBX, * )
282* ..
283*
284* =====================================================================
285*
286* .. Parameters ..
287 DOUBLE PRECISION ZERO, ONE
288 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
289* ..
290* .. Local Scalars ..
291 INTEGER I, I1, IC, IM1, INODE, J, JCOL, JIMAG, JREAL,
292 $ jrow, lf, ll, lvl, lvl2, nd, ndb1, ndiml,
293 $ ndimr, nl, nlf, nlp1, nlvl, nr, nrf, nrp1, sqre
294* ..
295* .. External Subroutines ..
296 EXTERNAL dgemm, dlasdt, xerbla, zcopy,
297 $ zlals0
298* ..
299* .. Intrinsic Functions ..
300 INTRINSIC dble, dcmplx, dimag
301* ..
302* .. Executable Statements ..
303*
304* Test the input parameters.
305*
306 info = 0
307*
308 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) ) THEN
309 info = -1
310 ELSE IF( smlsiz.LT.3 ) THEN
311 info = -2
312 ELSE IF( n.LT.smlsiz ) THEN
313 info = -3
314 ELSE IF( nrhs.LT.1 ) THEN
315 info = -4
316 ELSE IF( ldb.LT.n ) THEN
317 info = -6
318 ELSE IF( ldbx.LT.n ) THEN
319 info = -8
320 ELSE IF( ldu.LT.n ) THEN
321 info = -10
322 ELSE IF( ldgcol.LT.n ) THEN
323 info = -19
324 END IF
325 IF( info.NE.0 ) THEN
326 CALL xerbla( 'ZLALSA', -info )
327 RETURN
328 END IF
329*
330* Book-keeping and setting up the computation tree.
331*
332 inode = 1
333 ndiml = inode + n
334 ndimr = ndiml + n
335*
336 CALL dlasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
337 $ iwork( ndimr ), smlsiz )
338*
339* The following code applies back the left singular vector factors.
340* For applying back the right singular vector factors, go to 170.
341*
342 IF( icompq.EQ.1 ) THEN
343 GO TO 170
344 END IF
345*
346* The nodes on the bottom level of the tree were solved
347* by DLASDQ. The corresponding left and right singular vector
348* matrices are in explicit form. First apply back the left
349* singular vector matrices.
350*
351 ndb1 = ( nd+1 ) / 2
352 DO 130 i = ndb1, nd
353*
354* IC : center row of each node
355* NL : number of rows of left subproblem
356* NR : number of rows of right subproblem
357* NLF: starting row of the left subproblem
358* NRF: starting row of the right subproblem
359*
360 i1 = i - 1
361 ic = iwork( inode+i1 )
362 nl = iwork( ndiml+i1 )
363 nr = iwork( ndimr+i1 )
364 nlf = ic - nl
365 nrf = ic + 1
366*
367* Since B and BX are complex, the following call to DGEMM
368* is performed in two steps (real and imaginary parts).
369*
370* CALL DGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU,
371* $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
372*
373 j = nl*nrhs*2
374 DO 20 jcol = 1, nrhs
375 DO 10 jrow = nlf, nlf + nl - 1
376 j = j + 1
377 rwork( j ) = dble( b( jrow, jcol ) )
378 10 CONTINUE
379 20 CONTINUE
380 CALL dgemm( 'T', 'N', nl, nrhs, nl, one, u( nlf, 1 ), ldu,
381 $ rwork( 1+nl*nrhs*2 ), nl, zero, rwork( 1 ), nl )
382 j = nl*nrhs*2
383 DO 40 jcol = 1, nrhs
384 DO 30 jrow = nlf, nlf + nl - 1
385 j = j + 1
386 rwork( j ) = dimag( b( jrow, jcol ) )
387 30 CONTINUE
388 40 CONTINUE
389 CALL dgemm( 'T', 'N', nl, nrhs, nl, one, u( nlf, 1 ), ldu,
390 $ rwork( 1+nl*nrhs*2 ), nl, zero, rwork( 1+nl*nrhs ),
391 $ nl )
392 jreal = 0
393 jimag = nl*nrhs
394 DO 60 jcol = 1, nrhs
395 DO 50 jrow = nlf, nlf + nl - 1
396 jreal = jreal + 1
397 jimag = jimag + 1
398 bx( jrow, jcol ) = dcmplx( rwork( jreal ),
399 $ rwork( jimag ) )
400 50 CONTINUE
401 60 CONTINUE
402*
403* Since B and BX are complex, the following call to DGEMM
404* is performed in two steps (real and imaginary parts).
405*
406* CALL DGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU,
407* $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
408*
409 j = nr*nrhs*2
410 DO 80 jcol = 1, nrhs
411 DO 70 jrow = nrf, nrf + nr - 1
412 j = j + 1
413 rwork( j ) = dble( b( jrow, jcol ) )
414 70 CONTINUE
415 80 CONTINUE
416 CALL dgemm( 'T', 'N', nr, nrhs, nr, one, u( nrf, 1 ), ldu,
417 $ rwork( 1+nr*nrhs*2 ), nr, zero, rwork( 1 ), nr )
418 j = nr*nrhs*2
419 DO 100 jcol = 1, nrhs
420 DO 90 jrow = nrf, nrf + nr - 1
421 j = j + 1
422 rwork( j ) = dimag( b( jrow, jcol ) )
423 90 CONTINUE
424 100 CONTINUE
425 CALL dgemm( 'T', 'N', nr, nrhs, nr, one, u( nrf, 1 ), ldu,
426 $ rwork( 1+nr*nrhs*2 ), nr, zero, rwork( 1+nr*nrhs ),
427 $ nr )
428 jreal = 0
429 jimag = nr*nrhs
430 DO 120 jcol = 1, nrhs
431 DO 110 jrow = nrf, nrf + nr - 1
432 jreal = jreal + 1
433 jimag = jimag + 1
434 bx( jrow, jcol ) = dcmplx( rwork( jreal ),
435 $ rwork( jimag ) )
436 110 CONTINUE
437 120 CONTINUE
438*
439 130 CONTINUE
440*
441* Next copy the rows of B that correspond to unchanged rows
442* in the bidiagonal matrix to BX.
443*
444 DO 140 i = 1, nd
445 ic = iwork( inode+i-1 )
446 CALL zcopy( nrhs, b( ic, 1 ), ldb, bx( ic, 1 ), ldbx )
447 140 CONTINUE
448*
449* Finally go through the left singular vector matrices of all
450* the other subproblems bottom-up on the tree.
451*
452 j = 2**nlvl
453 sqre = 0
454*
455 DO 160 lvl = nlvl, 1, -1
456 lvl2 = 2*lvl - 1
457*
458* find the first node LF and last node LL on
459* the current level LVL
460*
461 IF( lvl.EQ.1 ) THEN
462 lf = 1
463 ll = 1
464 ELSE
465 lf = 2**( lvl-1 )
466 ll = 2*lf - 1
467 END IF
468 DO 150 i = lf, ll
469 im1 = i - 1
470 ic = iwork( inode+im1 )
471 nl = iwork( ndiml+im1 )
472 nr = iwork( ndimr+im1 )
473 nlf = ic - nl
474 nrf = ic + 1
475 j = j - 1
476 CALL zlals0( icompq, nl, nr, sqre, nrhs, bx( nlf, 1 ),
477 $ ldbx,
478 $ b( nlf, 1 ), ldb, perm( nlf, lvl ),
479 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
480 $ givnum( nlf, lvl2 ), ldu, poles( nlf, lvl2 ),
481 $ difl( nlf, lvl ), difr( nlf, lvl2 ),
482 $ z( nlf, lvl ), k( j ), c( j ), s( j ), rwork,
483 $ info )
484 150 CONTINUE
485 160 CONTINUE
486 GO TO 330
487*
488* ICOMPQ = 1: applying back the right singular vector factors.
489*
490 170 CONTINUE
491*
492* First now go through the right singular vector matrices of all
493* the tree nodes top-down.
494*
495 j = 0
496 DO 190 lvl = 1, nlvl
497 lvl2 = 2*lvl - 1
498*
499* Find the first node LF and last node LL on
500* the current level LVL.
501*
502 IF( lvl.EQ.1 ) THEN
503 lf = 1
504 ll = 1
505 ELSE
506 lf = 2**( lvl-1 )
507 ll = 2*lf - 1
508 END IF
509 DO 180 i = ll, lf, -1
510 im1 = i - 1
511 ic = iwork( inode+im1 )
512 nl = iwork( ndiml+im1 )
513 nr = iwork( ndimr+im1 )
514 nlf = ic - nl
515 nrf = ic + 1
516 IF( i.EQ.ll ) THEN
517 sqre = 0
518 ELSE
519 sqre = 1
520 END IF
521 j = j + 1
522 CALL zlals0( icompq, nl, nr, sqre, nrhs, b( nlf, 1 ),
523 $ ldb,
524 $ bx( nlf, 1 ), ldbx, perm( nlf, lvl ),
525 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
526 $ givnum( nlf, lvl2 ), ldu, poles( nlf, lvl2 ),
527 $ difl( nlf, lvl ), difr( nlf, lvl2 ),
528 $ z( nlf, lvl ), k( j ), c( j ), s( j ), rwork,
529 $ info )
530 180 CONTINUE
531 190 CONTINUE
532*
533* The nodes on the bottom level of the tree were solved
534* by DLASDQ. The corresponding right singular vector
535* matrices are in explicit form. Apply them back.
536*
537 ndb1 = ( nd+1 ) / 2
538 DO 320 i = ndb1, nd
539 i1 = i - 1
540 ic = iwork( inode+i1 )
541 nl = iwork( ndiml+i1 )
542 nr = iwork( ndimr+i1 )
543 nlp1 = nl + 1
544 IF( i.EQ.nd ) THEN
545 nrp1 = nr
546 ELSE
547 nrp1 = nr + 1
548 END IF
549 nlf = ic - nl
550 nrf = ic + 1
551*
552* Since B and BX are complex, the following call to DGEMM is
553* performed in two steps (real and imaginary parts).
554*
555* CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
556* $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
557*
558 j = nlp1*nrhs*2
559 DO 210 jcol = 1, nrhs
560 DO 200 jrow = nlf, nlf + nlp1 - 1
561 j = j + 1
562 rwork( j ) = dble( b( jrow, jcol ) )
563 200 CONTINUE
564 210 CONTINUE
565 CALL dgemm( 'T', 'N', nlp1, nrhs, nlp1, one, vt( nlf, 1 ),
566 $ ldu,
567 $ rwork( 1+nlp1*nrhs*2 ), nlp1, zero, rwork( 1 ),
568 $ nlp1 )
569 j = nlp1*nrhs*2
570 DO 230 jcol = 1, nrhs
571 DO 220 jrow = nlf, nlf + nlp1 - 1
572 j = j + 1
573 rwork( j ) = dimag( b( jrow, jcol ) )
574 220 CONTINUE
575 230 CONTINUE
576 CALL dgemm( 'T', 'N', nlp1, nrhs, nlp1, one, vt( nlf, 1 ),
577 $ ldu,
578 $ rwork( 1+nlp1*nrhs*2 ), nlp1, zero,
579 $ rwork( 1+nlp1*nrhs ), nlp1 )
580 jreal = 0
581 jimag = nlp1*nrhs
582 DO 250 jcol = 1, nrhs
583 DO 240 jrow = nlf, nlf + nlp1 - 1
584 jreal = jreal + 1
585 jimag = jimag + 1
586 bx( jrow, jcol ) = dcmplx( rwork( jreal ),
587 $ rwork( jimag ) )
588 240 CONTINUE
589 250 CONTINUE
590*
591* Since B and BX are complex, the following call to DGEMM is
592* performed in two steps (real and imaginary parts).
593*
594* CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
595* $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
596*
597 j = nrp1*nrhs*2
598 DO 270 jcol = 1, nrhs
599 DO 260 jrow = nrf, nrf + nrp1 - 1
600 j = j + 1
601 rwork( j ) = dble( b( jrow, jcol ) )
602 260 CONTINUE
603 270 CONTINUE
604 CALL dgemm( 'T', 'N', nrp1, nrhs, nrp1, one, vt( nrf, 1 ),
605 $ ldu,
606 $ rwork( 1+nrp1*nrhs*2 ), nrp1, zero, rwork( 1 ),
607 $ nrp1 )
608 j = nrp1*nrhs*2
609 DO 290 jcol = 1, nrhs
610 DO 280 jrow = nrf, nrf + nrp1 - 1
611 j = j + 1
612 rwork( j ) = dimag( b( jrow, jcol ) )
613 280 CONTINUE
614 290 CONTINUE
615 CALL dgemm( 'T', 'N', nrp1, nrhs, nrp1, one, vt( nrf, 1 ),
616 $ ldu,
617 $ rwork( 1+nrp1*nrhs*2 ), nrp1, zero,
618 $ rwork( 1+nrp1*nrhs ), nrp1 )
619 jreal = 0
620 jimag = nrp1*nrhs
621 DO 310 jcol = 1, nrhs
622 DO 300 jrow = nrf, nrf + nrp1 - 1
623 jreal = jreal + 1
624 jimag = jimag + 1
625 bx( jrow, jcol ) = dcmplx( rwork( jreal ),
626 $ rwork( jimag ) )
627 300 CONTINUE
628 310 CONTINUE
629*
630 320 CONTINUE
631*
632 330 CONTINUE
633*
634 RETURN
635*
636* End of ZLALSA
637*
638 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zcopy
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
Definition zcopy.f:81
dgemm
subroutine dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
DGEMM
Definition dgemm.f:188
zlals0
subroutine zlals0(icompq, nl, nr, sqre, nrhs, b, ldb, bx, ldbx, perm, givptr, givcol, ldgcol, givnum, ldgnum, poles, difl, difr, z, k, c, s, rwork, info)
ZLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer...
Definition zlals0.f:269
zlalsa
subroutine zlalsa(icompq, smlsiz, n, nrhs, b, ldb, bx, ldbx, u, ldu, vt, k, difl, difr, z, poles, givptr, givcol, ldgcol, perm, givnum, c, s, rwork, iwork, info)
ZLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.
Definition zlalsa.f:266
dlasdt
subroutine dlasdt(n, lvl, nd, inode, ndiml, ndimr, msub)
DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
Definition dlasdt.f:103