LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
sgelsd.f
Go to the documentation of this file.
1*> \brief <b> SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices</b>
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download SGELSD + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsd.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelsd.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsd.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
20* RANK, WORK, LWORK, IWORK, INFO )
21*
22* .. Scalar Arguments ..
23* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
24* REAL RCOND
25* ..
26* .. Array Arguments ..
27* INTEGER IWORK( * )
28* REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> SGELSD computes the minimum-norm solution to a real linear least
38*> squares problem:
39*> minimize 2-norm(| b - A*x |)
40*> using the singular value decomposition (SVD) of A. A is an M-by-N
41*> matrix which may be rank-deficient.
42*>
43*> Several right hand side vectors b and solution vectors x can be
44*> handled in a single call; they are stored as the columns of the
45*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
46*> matrix X.
47*>
48*> The problem is solved in three steps:
49*> (1) Reduce the coefficient matrix A to bidiagonal form with
50*> Householder transformations, reducing the original problem
51*> into a "bidiagonal least squares problem" (BLS)
52*> (2) Solve the BLS using a divide and conquer approach.
53*> (3) Apply back all the Householder transformations to solve
54*> the original least squares problem.
55*>
56*> The effective rank of A is determined by treating as zero those
57*> singular values which are less than RCOND times the largest singular
58*> value.
59*>
60*> \endverbatim
61*
62* Arguments:
63* ==========
64*
65*> \param[in] M
66*> \verbatim
67*> M is INTEGER
68*> The number of rows of A. M >= 0.
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*> N is INTEGER
74*> The number of columns of A. N >= 0.
75*> \endverbatim
76*>
77*> \param[in] NRHS
78*> \verbatim
79*> NRHS is INTEGER
80*> The number of right hand sides, i.e., the number of columns
81*> of the matrices B and X. NRHS >= 0.
82*> \endverbatim
83*>
84*> \param[in,out] A
85*> \verbatim
86*> A is REAL array, dimension (LDA,N)
87*> On entry, the M-by-N matrix A.
88*> On exit, A has been destroyed.
89*> \endverbatim
90*>
91*> \param[in] LDA
92*> \verbatim
93*> LDA is INTEGER
94*> The leading dimension of the array A. LDA >= max(1,M).
95*> \endverbatim
96*>
97*> \param[in,out] B
98*> \verbatim
99*> B is REAL array, dimension (LDB,NRHS)
100*> On entry, the M-by-NRHS right hand side matrix B.
101*> On exit, B is overwritten by the N-by-NRHS solution
102*> matrix X. If m >= n and RANK = n, the residual
103*> sum-of-squares for the solution in the i-th column is given
104*> by the sum of squares of elements n+1:m in that column.
105*> \endverbatim
106*>
107*> \param[in] LDB
108*> \verbatim
109*> LDB is INTEGER
110*> The leading dimension of the array B. LDB >= max(1,max(M,N)).
111*> \endverbatim
112*>
113*> \param[out] S
114*> \verbatim
115*> S is REAL array, dimension (min(M,N))
116*> The singular values of A in decreasing order.
117*> The condition number of A in the 2-norm = S(1)/S(min(m,n)).
118*> \endverbatim
119*>
120*> \param[in] RCOND
121*> \verbatim
122*> RCOND is REAL
123*> RCOND is used to determine the effective rank of A.
124*> Singular values S(i) <= RCOND*S(1) are treated as zero.
125*> If RCOND < 0, machine precision is used instead.
126*> \endverbatim
127*>
128*> \param[out] RANK
129*> \verbatim
130*> RANK is INTEGER
131*> The effective rank of A, i.e., the number of singular values
132*> which are greater than RCOND*S(1).
133*> \endverbatim
134*>
135*> \param[out] WORK
136*> \verbatim
137*> WORK is REAL array, dimension (MAX(1,LWORK))
138*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
139*> \endverbatim
140*>
141*> \param[in] LWORK
142*> \verbatim
143*> LWORK is INTEGER
144*> The dimension of the array WORK. LWORK must be at least 1.
145*> The exact minimum amount of workspace needed depends on M,
146*> N and NRHS. As long as LWORK is at least
147*> 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
148*> if M is greater than or equal to N or
149*> 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
150*> if M is less than N, the code will execute correctly.
151*> SMLSIZ is returned by ILAENV and is equal to the maximum
152*> size of the subproblems at the bottom of the computation
153*> tree (usually about 25), and
154*> NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
155*> For good performance, LWORK should generally be larger.
156*>
157*> If LWORK = -1, then a workspace query is assumed; the routine
158*> only calculates the optimal size of the array WORK and the
159*> minimum size of the array IWORK, and returns these values as
160*> the first entries of the WORK and IWORK arrays, and no error
161*> message related to LWORK is issued by XERBLA.
162*> \endverbatim
163*>
164*> \param[out] IWORK
165*> \verbatim
166*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
167*> LIWORK >= max(1, 3*MINMN*NLVL + 11*MINMN),
168*> where MINMN = MIN( M,N ).
169*> On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
170*> \endverbatim
171*>
172*> \param[out] INFO
173*> \verbatim
174*> INFO is INTEGER
175*> = 0: successful exit
176*> < 0: if INFO = -i, the i-th argument had an illegal value.
177*> > 0: the algorithm for computing the SVD failed to converge;
178*> if INFO = i, i off-diagonal elements of an intermediate
179*> bidiagonal form did not converge to zero.
180*> \endverbatim
181*
182* Authors:
183* ========
184*
185*> \author Univ. of Tennessee
186*> \author Univ. of California Berkeley
187*> \author Univ. of Colorado Denver
188*> \author NAG Ltd.
189*
190*> \ingroup gelsd
191*
192*> \par Contributors:
193* ==================
194*>
195*> Ming Gu and Ren-Cang Li, Computer Science Division, University of
196*> California at Berkeley, USA \n
197*> Osni Marques, LBNL/NERSC, USA \n
198*
199* =====================================================================
200 SUBROUTINE sgelsd( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
201 $ RANK, WORK, LWORK, IWORK, INFO )
202*
203* -- LAPACK driver routine --
204* -- LAPACK is a software package provided by Univ. of Tennessee, --
205* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
206*
207* .. Scalar Arguments ..
208 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
209 REAL RCOND
210* ..
211* .. Array Arguments ..
212 INTEGER IWORK( * )
213 REAL A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
214* ..
215*
216* =====================================================================
217*
218* .. Parameters ..
219 REAL ZERO, ONE, TWO
220 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
221* ..
222* .. Local Scalars ..
223 LOGICAL LQUERY
224 INTEGER IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
225 $ ldwork, liwork, maxmn, maxwrk, minmn, minwrk,
226 $ mm, mnthr, nlvl, nwork, smlsiz, wlalsd
227 REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
228* ..
229* .. External Subroutines ..
230 EXTERNAL sgebrd, sgelqf, sgeqrf, slacpy, slalsd,
231 $ slascl,
233* ..
234* .. External Functions ..
235 INTEGER ILAENV
236 REAL SLAMCH, SLANGE, SROUNDUP_LWORK
237 EXTERNAL slamch, slange, ilaenv,
238 $ sroundup_lwork
239* ..
240* .. Intrinsic Functions ..
241 INTRINSIC int, log, max, min, real
242* ..
243* .. Executable Statements ..
244*
245* Test the input arguments.
246*
247 info = 0
248 minmn = min( m, n )
249 maxmn = max( m, n )
250 lquery = ( lwork.EQ.-1 )
251 IF( m.LT.0 ) THEN
252 info = -1
253 ELSE IF( n.LT.0 ) THEN
254 info = -2
255 ELSE IF( nrhs.LT.0 ) THEN
256 info = -3
257 ELSE IF( lda.LT.max( 1, m ) ) THEN
258 info = -5
259 ELSE IF( ldb.LT.max( 1, maxmn ) ) THEN
260 info = -7
261 END IF
262*
263* Compute workspace.
264* (Note: Comments in the code beginning "Workspace:" describe the
265* minimal amount of workspace needed at that point in the code,
266* as well as the preferred amount for good performance.
267* NB refers to the optimal block size for the immediately
268* following subroutine, as returned by ILAENV.)
269*
270 IF( info.EQ.0 ) THEN
271 minwrk = 1
272 maxwrk = 1
273 liwork = 1
274 IF( minmn.GT.0 ) THEN
275 smlsiz = ilaenv( 9, 'SGELSD', ' ', 0, 0, 0, 0 )
276 mnthr = ilaenv( 6, 'SGELSD', ' ', m, n, nrhs, -1 )
277 nlvl = max( int( log( real( minmn ) / real( smlsiz + 1 ) ) /
278 $ log( two ) ) + 1, 0 )
279 liwork = 3*minmn*nlvl + 11*minmn
280 mm = m
281 IF( m.GE.n .AND. m.GE.mnthr ) THEN
282*
283* Path 1a - overdetermined, with many more rows than
284* columns.
285*
286 mm = n
287 maxwrk = max( maxwrk, n + n*ilaenv( 1, 'SGEQRF', ' ',
288 $ m,
289 $ n, -1, -1 ) )
290 maxwrk = max( maxwrk, n + nrhs*ilaenv( 1, 'SORMQR',
291 $ 'LT',
292 $ m, nrhs, n, -1 ) )
293 END IF
294 IF( m.GE.n ) THEN
295*
296* Path 1 - overdetermined or exactly determined.
297*
298 maxwrk = max( maxwrk, 3*n + ( mm + n )*ilaenv( 1,
299 $ 'SGEBRD', ' ', mm, n, -1, -1 ) )
300 maxwrk = max( maxwrk, 3*n + nrhs*ilaenv( 1, 'SORMBR',
301 $ 'QLT', mm, nrhs, n, -1 ) )
302 maxwrk = max( maxwrk, 3*n + ( n - 1 )*ilaenv( 1,
303 $ 'SORMBR', 'PLN', n, nrhs, n, -1 ) )
304 wlalsd = 9*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs +
305 $ ( smlsiz + 1 )**2
306 maxwrk = max( maxwrk, 3*n + wlalsd )
307 minwrk = max( 3*n + mm, 3*n + nrhs, 3*n + wlalsd )
308 END IF
309 IF( n.GT.m ) THEN
310 wlalsd = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs +
311 $ ( smlsiz + 1 )**2
312 IF( n.GE.mnthr ) THEN
313*
314* Path 2a - underdetermined, with many more columns
315* than rows.
316*
317 maxwrk = m + m*ilaenv( 1, 'SGELQF', ' ', m, n, -1,
318 $ -1 )
319 maxwrk = max( maxwrk, m*m + 4*m + 2*m*ilaenv( 1,
320 $ 'SGEBRD', ' ', m, m, -1, -1 ) )
321 maxwrk = max( maxwrk, m*m + 4*m + nrhs*ilaenv( 1,
322 $ 'SORMBR', 'QLT', m, nrhs, m, -1 ) )
323 maxwrk = max( maxwrk,
324 $ m*m + 4*m + ( m - 1 )*ilaenv( 1,
325 $ 'SORMBR', 'PLN', m, nrhs, m, -1 ) )
326 IF( nrhs.GT.1 ) THEN
327 maxwrk = max( maxwrk, m*m + m + m*nrhs )
328 ELSE
329 maxwrk = max( maxwrk, m*m + 2*m )
330 END IF
331 maxwrk = max( maxwrk, m + nrhs*ilaenv( 1, 'SORMLQ',
332 $ 'LT', n, nrhs, m, -1 ) )
333 maxwrk = max( maxwrk, m*m + 4*m + wlalsd )
334! XXX: Ensure the Path 2a case below is triggered. The workspace
335! calculation should use queries for all routines eventually.
336 maxwrk = max( maxwrk,
337 $ 4*m+m*m+max( m, 2*m-4, nrhs, n-3*m ) )
338 ELSE
339*
340* Path 2 - remaining underdetermined cases.
341*
342 maxwrk = 3*m + ( n + m )*ilaenv( 1, 'SGEBRD', ' ',
343 $ m,
344 $ n, -1, -1 )
345 maxwrk = max( maxwrk, 3*m + nrhs*ilaenv( 1,
346 $ 'SORMBR',
347 $ 'QLT', m, nrhs, n, -1 ) )
348 maxwrk = max( maxwrk, 3*m + m*ilaenv( 1, 'SORMBR',
349 $ 'PLN', n, nrhs, m, -1 ) )
350 maxwrk = max( maxwrk, 3*m + wlalsd )
351 END IF
352 minwrk = max( 3*m + nrhs, 3*m + m, 3*m + wlalsd )
353 END IF
354 END IF
355 minwrk = min( minwrk, maxwrk )
356 work( 1 ) = sroundup_lwork(maxwrk)
357 iwork( 1 ) = liwork
358*
359 IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
360 info = -12
361 END IF
362 END IF
363*
364 IF( info.NE.0 ) THEN
365 CALL xerbla( 'SGELSD', -info )
366 RETURN
367 ELSE IF( lquery ) THEN
368 RETURN
369 END IF
370*
371* Quick return if possible.
372*
373 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
374 rank = 0
375 RETURN
376 END IF
377*
378* Get machine parameters.
379*
380 eps = slamch( 'P' )
381 sfmin = slamch( 'S' )
382 smlnum = sfmin / eps
383 bignum = one / smlnum
384*
385* Scale A if max entry outside range [SMLNUM,BIGNUM].
386*
387 anrm = slange( 'M', m, n, a, lda, work )
388 iascl = 0
389 IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
390*
391* Scale matrix norm up to SMLNUM.
392*
393 CALL slascl( 'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
394 iascl = 1
395 ELSE IF( anrm.GT.bignum ) THEN
396*
397* Scale matrix norm down to BIGNUM.
398*
399 CALL slascl( 'G', 0, 0, anrm, bignum, m, n, a, lda, info )
400 iascl = 2
401 ELSE IF( anrm.EQ.zero ) THEN
402*
403* Matrix all zero. Return zero solution.
404*
405 CALL slaset( 'F', max( m, n ), nrhs, zero, zero, b, ldb )
406 CALL slaset( 'F', minmn, 1, zero, zero, s, 1 )
407 rank = 0
408 GO TO 10
409 END IF
410*
411* Scale B if max entry outside range [SMLNUM,BIGNUM].
412*
413 bnrm = slange( 'M', m, nrhs, b, ldb, work )
414 ibscl = 0
415 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
416*
417* Scale matrix norm up to SMLNUM.
418*
419 CALL slascl( 'G', 0, 0, bnrm, smlnum, m, nrhs, b, ldb,
420 $ info )
421 ibscl = 1
422 ELSE IF( bnrm.GT.bignum ) THEN
423*
424* Scale matrix norm down to BIGNUM.
425*
426 CALL slascl( 'G', 0, 0, bnrm, bignum, m, nrhs, b, ldb,
427 $ info )
428 ibscl = 2
429 END IF
430*
431* If M < N make sure certain entries of B are zero.
432*
433 IF( m.LT.n )
434 $ CALL slaset( 'F', n-m, nrhs, zero, zero, b( m+1, 1 ), ldb )
435*
436* Overdetermined case.
437*
438 IF( m.GE.n ) THEN
439*
440* Path 1 - overdetermined or exactly determined.
441*
442 mm = m
443 IF( m.GE.mnthr ) THEN
444*
445* Path 1a - overdetermined, with many more rows than columns.
446*
447 mm = n
448 itau = 1
449 nwork = itau + n
450*
451* Compute A=Q*R.
452* (Workspace: need 2*N, prefer N+N*NB)
453*
454 CALL sgeqrf( m, n, a, lda, work( itau ), work( nwork ),
455 $ lwork-nwork+1, info )
456*
457* Multiply B by transpose(Q).
458* (Workspace: need N+NRHS, prefer N+NRHS*NB)
459*
460 CALL sormqr( 'L', 'T', m, nrhs, n, a, lda, work( itau ),
461 $ b,
462 $ ldb, work( nwork ), lwork-nwork+1, info )
463*
464* Zero out below R.
465*
466 IF( n.GT.1 ) THEN
467 CALL slaset( 'L', n-1, n-1, zero, zero, a( 2, 1 ),
468 $ lda )
469 END IF
470 END IF
471*
472 ie = 1
473 itauq = ie + n
474 itaup = itauq + n
475 nwork = itaup + n
476*
477* Bidiagonalize R in A.
478* (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
479*
480 CALL sgebrd( mm, n, a, lda, s, work( ie ), work( itauq ),
481 $ work( itaup ), work( nwork ), lwork-nwork+1,
482 $ info )
483*
484* Multiply B by transpose of left bidiagonalizing vectors of R.
485* (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
486*
487 CALL sormbr( 'Q', 'L', 'T', mm, nrhs, n, a, lda,
488 $ work( itauq ),
489 $ b, ldb, work( nwork ), lwork-nwork+1, info )
490*
491* Solve the bidiagonal least squares problem.
492*
493 CALL slalsd( 'U', smlsiz, n, nrhs, s, work( ie ), b, ldb,
494 $ rcond, rank, work( nwork ), iwork, info )
495 IF( info.NE.0 ) THEN
496 GO TO 10
497 END IF
498*
499* Multiply B by right bidiagonalizing vectors of R.
500*
501 CALL sormbr( 'P', 'L', 'N', n, nrhs, n, a, lda,
502 $ work( itaup ),
503 $ b, ldb, work( nwork ), lwork-nwork+1, info )
504*
505 ELSE IF( n.GE.mnthr .AND. lwork.GE.4*m+m*m+
506 $ max( m, 2*m-4, nrhs, n-3*m, wlalsd ) ) THEN
507*
508* Path 2a - underdetermined, with many more columns than rows
509* and sufficient workspace for an efficient algorithm.
510*
511 ldwork = m
512 IF( lwork.GE.max( 4*m+m*lda+max( m, 2*m-4, nrhs, n-3*m ),
513 $ m*lda+m+m*nrhs, 4*m+m*lda+wlalsd ) )ldwork = lda
514 itau = 1
515 nwork = m + 1
516*
517* Compute A=L*Q.
518* (Workspace: need 2*M, prefer M+M*NB)
519*
520 CALL sgelqf( m, n, a, lda, work( itau ), work( nwork ),
521 $ lwork-nwork+1, info )
522 il = nwork
523*
524* Copy L to WORK(IL), zeroing out above its diagonal.
525*
526 CALL slacpy( 'L', m, m, a, lda, work( il ), ldwork )
527 CALL slaset( 'U', m-1, m-1, zero, zero, work( il+ldwork ),
528 $ ldwork )
529 ie = il + ldwork*m
530 itauq = ie + m
531 itaup = itauq + m
532 nwork = itaup + m
533*
534* Bidiagonalize L in WORK(IL).
535* (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
536*
537 CALL sgebrd( m, m, work( il ), ldwork, s, work( ie ),
538 $ work( itauq ), work( itaup ), work( nwork ),
539 $ lwork-nwork+1, info )
540*
541* Multiply B by transpose of left bidiagonalizing vectors of L.
542* (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
543*
544 CALL sormbr( 'Q', 'L', 'T', m, nrhs, m, work( il ), ldwork,
545 $ work( itauq ), b, ldb, work( nwork ),
546 $ lwork-nwork+1, info )
547*
548* Solve the bidiagonal least squares problem.
549*
550 CALL slalsd( 'U', smlsiz, m, nrhs, s, work( ie ), b, ldb,
551 $ rcond, rank, work( nwork ), iwork, info )
552 IF( info.NE.0 ) THEN
553 GO TO 10
554 END IF
555*
556* Multiply B by right bidiagonalizing vectors of L.
557*
558 CALL sormbr( 'P', 'L', 'N', m, nrhs, m, work( il ), ldwork,
559 $ work( itaup ), b, ldb, work( nwork ),
560 $ lwork-nwork+1, info )
561*
562* Zero out below first M rows of B.
563*
564 CALL slaset( 'F', n-m, nrhs, zero, zero, b( m+1, 1 ), ldb )
565 nwork = itau + m
566*
567* Multiply transpose(Q) by B.
568* (Workspace: need M+NRHS, prefer M+NRHS*NB)
569*
570 CALL sormlq( 'L', 'T', n, nrhs, m, a, lda, work( itau ), b,
571 $ ldb, work( nwork ), lwork-nwork+1, info )
572*
573 ELSE
574*
575* Path 2 - remaining underdetermined cases.
576*
577 ie = 1
578 itauq = ie + m
579 itaup = itauq + m
580 nwork = itaup + m
581*
582* Bidiagonalize A.
583* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
584*
585 CALL sgebrd( m, n, a, lda, s, work( ie ), work( itauq ),
586 $ work( itaup ), work( nwork ), lwork-nwork+1,
587 $ info )
588*
589* Multiply B by transpose of left bidiagonalizing vectors.
590* (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
591*
592 CALL sormbr( 'Q', 'L', 'T', m, nrhs, n, a, lda,
593 $ work( itauq ),
594 $ b, ldb, work( nwork ), lwork-nwork+1, info )
595*
596* Solve the bidiagonal least squares problem.
597*
598 CALL slalsd( 'L', smlsiz, m, nrhs, s, work( ie ), b, ldb,
599 $ rcond, rank, work( nwork ), iwork, info )
600 IF( info.NE.0 ) THEN
601 GO TO 10
602 END IF
603*
604* Multiply B by right bidiagonalizing vectors of A.
605*
606 CALL sormbr( 'P', 'L', 'N', n, nrhs, m, a, lda,
607 $ work( itaup ),
608 $ b, ldb, work( nwork ), lwork-nwork+1, info )
609*
610 END IF
611*
612* Undo scaling.
613*
614 IF( iascl.EQ.1 ) THEN
615 CALL slascl( 'G', 0, 0, anrm, smlnum, n, nrhs, b, ldb,
616 $ info )
617 CALL slascl( 'G', 0, 0, smlnum, anrm, minmn, 1, s, minmn,
618 $ info )
619 ELSE IF( iascl.EQ.2 ) THEN
620 CALL slascl( 'G', 0, 0, anrm, bignum, n, nrhs, b, ldb,
621 $ info )
622 CALL slascl( 'G', 0, 0, bignum, anrm, minmn, 1, s, minmn,
623 $ info )
624 END IF
625 IF( ibscl.EQ.1 ) THEN
626 CALL slascl( 'G', 0, 0, smlnum, bnrm, n, nrhs, b, ldb,
627 $ info )
628 ELSE IF( ibscl.EQ.2 ) THEN
629 CALL slascl( 'G', 0, 0, bignum, bnrm, n, nrhs, b, ldb,
630 $ info )
631 END IF
632*
633 10 CONTINUE
634 work( 1 ) = sroundup_lwork(maxwrk)
635 iwork( 1 ) = liwork
636 RETURN
637*
638* End of SGELSD
639*
640 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgebrd(m, n, a, lda, d, e, tauq, taup, work, lwork, info)
SGEBRD
Definition sgebrd.f:204
subroutine sgelqf(m, n, a, lda, tau, work, lwork, info)
SGELQF
Definition sgelqf.f:142
subroutine sgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)
SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
Definition sgelsd.f:202
subroutine sgeqrf(m, n, a, lda, tau, work, lwork, info)
SGEQRF
Definition sgeqrf.f:144
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:101
subroutine slalsd(uplo, smlsiz, n, nrhs, d, e, b, ldb, rcond, rank, work, iwork, info)
SLALSD uses the singular value decomposition of A to solve the least squares problem.
Definition slalsd.f:171
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition slascl.f:142
subroutine slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition slaset.f:108
subroutine sormbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMBR
Definition sormbr.f:194
subroutine sormlq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMLQ
Definition sormlq.f:166
subroutine sormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMQR
Definition sormqr.f:166