LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
dlasd0.f
Go to the documentation of this file.
1 *> \brief \b DLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DLASD0 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd0.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd0.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd0.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
22 * WORK, INFO )
23 *
24 * .. Scalar Arguments ..
25 * INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
26 * ..
27 * .. Array Arguments ..
28 * INTEGER IWORK( * )
29 * DOUBLE PRECISION D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
30 * $ WORK( * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> Using a divide and conquer approach, DLASD0 computes the singular
40 *> value decomposition (SVD) of a real upper bidiagonal N-by-M
41 *> matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
42 *> The algorithm computes orthogonal matrices U and VT such that
43 *> B = U * S * VT. The singular values S are overwritten on D.
44 *>
45 *> A related subroutine, DLASDA, computes only the singular values,
46 *> and optionally, the singular vectors in compact form.
47 *> \endverbatim
48 *
49 * Arguments:
50 * ==========
51 *
52 *> \param[in] N
53 *> \verbatim
54 *> N is INTEGER
55 *> On entry, the row dimension of the upper bidiagonal matrix.
56 *> This is also the dimension of the main diagonal array D.
57 *> \endverbatim
58 *>
59 *> \param[in] SQRE
60 *> \verbatim
61 *> SQRE is INTEGER
62 *> Specifies the column dimension of the bidiagonal matrix.
63 *> = 0: The bidiagonal matrix has column dimension M = N;
64 *> = 1: The bidiagonal matrix has column dimension M = N+1;
65 *> \endverbatim
66 *>
67 *> \param[in,out] D
68 *> \verbatim
69 *> D is DOUBLE PRECISION array, dimension (N)
70 *> On entry D contains the main diagonal of the bidiagonal
71 *> matrix.
72 *> On exit D, if INFO = 0, contains its singular values.
73 *> \endverbatim
74 *>
75 *> \param[in] E
76 *> \verbatim
77 *> E is DOUBLE PRECISION array, dimension (M-1)
78 *> Contains the subdiagonal entries of the bidiagonal matrix.
79 *> On exit, E has been destroyed.
80 *> \endverbatim
81 *>
82 *> \param[out] U
83 *> \verbatim
84 *> U is DOUBLE PRECISION array, dimension at least (LDQ, N)
85 *> On exit, U contains the left singular vectors.
86 *> \endverbatim
87 *>
88 *> \param[in] LDU
89 *> \verbatim
90 *> LDU is INTEGER
91 *> On entry, leading dimension of U.
92 *> \endverbatim
93 *>
94 *> \param[out] VT
95 *> \verbatim
96 *> VT is DOUBLE PRECISION array, dimension at least (LDVT, M)
97 *> On exit, VT**T contains the right singular vectors.
98 *> \endverbatim
99 *>
100 *> \param[in] LDVT
101 *> \verbatim
102 *> LDVT is INTEGER
103 *> On entry, leading dimension of VT.
104 *> \endverbatim
105 *>
106 *> \param[in] SMLSIZ
107 *> \verbatim
108 *> SMLSIZ is INTEGER
109 *> On entry, maximum size of the subproblems at the
110 *> bottom of the computation tree.
111 *> \endverbatim
112 *>
113 *> \param[out] IWORK
114 *> \verbatim
115 *> IWORK is INTEGER work array.
116 *> Dimension must be at least (8 * N)
117 *> \endverbatim
118 *>
119 *> \param[out] WORK
120 *> \verbatim
121 *> WORK is DOUBLE PRECISION work array.
122 *> Dimension must be at least (3 * M**2 + 2 * M)
123 *> \endverbatim
124 *>
125 *> \param[out] INFO
126 *> \verbatim
127 *> INFO is INTEGER
128 *> = 0: successful exit.
129 *> < 0: if INFO = -i, the i-th argument had an illegal value.
130 *> > 0: if INFO = 1, a singular value did not converge
131 *> \endverbatim
132 *
133 * Authors:
134 * ========
135 *
136 *> \author Univ. of Tennessee
137 *> \author Univ. of California Berkeley
138 *> \author Univ. of Colorado Denver
139 *> \author NAG Ltd.
140 *
141 *> \date September 2012
142 *
143 *> \ingroup auxOTHERauxiliary
144 *
145 *> \par Contributors:
146 * ==================
147 *>
148 *> Ming Gu and Huan Ren, Computer Science Division, University of
149 *> California at Berkeley, USA
150 *>
151 * =====================================================================
152  SUBROUTINE dlasd0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
153  $ work, info )
154 *
155 * -- LAPACK auxiliary routine (version 3.4.2) --
156 * -- LAPACK is a software package provided by Univ. of Tennessee, --
157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158 * September 2012
159 *
160 * .. Scalar Arguments ..
161  INTEGER info, ldu, ldvt, n, smlsiz, sqre
162 * ..
163 * .. Array Arguments ..
164  INTEGER iwork( * )
165  DOUBLE PRECISION d( * ), e( * ), u( ldu, * ), vt( ldvt, * ),
166  $ work( * )
167 * ..
168 *
169 * =====================================================================
170 *
171 * .. Local Scalars ..
172  INTEGER i, i1, ic, idxq, idxqc, im1, inode, itemp, iwk,
173  $ j, lf, ll, lvl, m, ncc, nd, ndb1, ndiml, ndimr,
174  $ nl, nlf, nlp1, nlvl, nr, nrf, nrp1, sqrei
175  DOUBLE PRECISION alpha, beta
176 * ..
177 * .. External Subroutines ..
178  EXTERNAL dlasd1, dlasdq, dlasdt, xerbla
179 * ..
180 * .. Executable Statements ..
181 *
182 * Test the input parameters.
183 *
184  info = 0
185 *
186  IF( n.LT.0 ) THEN
187  info = -1
188  ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) ) THEN
189  info = -2
190  END IF
191 *
192  m = n + sqre
193 *
194  IF( ldu.LT.n ) THEN
195  info = -6
196  ELSE IF( ldvt.LT.m ) THEN
197  info = -8
198  ELSE IF( smlsiz.LT.3 ) THEN
199  info = -9
200  END IF
201  IF( info.NE.0 ) THEN
202  CALL xerbla( 'DLASD0', -info )
203  RETURN
204  END IF
205 *
206 * If the input matrix is too small, call DLASDQ to find the SVD.
207 *
208  IF( n.LE.smlsiz ) THEN
209  CALL dlasdq( 'U', sqre, n, m, n, 0, d, e, vt, ldvt, u, ldu, u,
210  $ ldu, work, info )
211  RETURN
212  END IF
213 *
214 * Set up the computation tree.
215 *
216  inode = 1
217  ndiml = inode + n
218  ndimr = ndiml + n
219  idxq = ndimr + n
220  iwk = idxq + n
221  CALL dlasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
222  $ iwork( ndimr ), smlsiz )
223 *
224 * For the nodes on bottom level of the tree, solve
225 * their subproblems by DLASDQ.
226 *
227  ndb1 = ( nd+1 ) / 2
228  ncc = 0
229  DO 30 i = ndb1, nd
230 *
231 * IC : center row of each node
232 * NL : number of rows of left subproblem
233 * NR : number of rows of right subproblem
234 * NLF: starting row of the left subproblem
235 * NRF: starting row of the right subproblem
236 *
237  i1 = i - 1
238  ic = iwork( inode+i1 )
239  nl = iwork( ndiml+i1 )
240  nlp1 = nl + 1
241  nr = iwork( ndimr+i1 )
242  nrp1 = nr + 1
243  nlf = ic - nl
244  nrf = ic + 1
245  sqrei = 1
246  CALL dlasdq( 'U', sqrei, nl, nlp1, nl, ncc, d( nlf ), e( nlf ),
247  $ vt( nlf, nlf ), ldvt, u( nlf, nlf ), ldu,
248  $ u( nlf, nlf ), ldu, work, info )
249  IF( info.NE.0 ) THEN
250  RETURN
251  END IF
252  itemp = idxq + nlf - 2
253  DO 10 j = 1, nl
254  iwork( itemp+j ) = j
255  10 CONTINUE
256  IF( i.EQ.nd ) THEN
257  sqrei = sqre
258  ELSE
259  sqrei = 1
260  END IF
261  nrp1 = nr + sqrei
262  CALL dlasdq( 'U', sqrei, nr, nrp1, nr, ncc, d( nrf ), e( nrf ),
263  $ vt( nrf, nrf ), ldvt, u( nrf, nrf ), ldu,
264  $ u( nrf, nrf ), ldu, work, info )
265  IF( info.NE.0 ) THEN
266  RETURN
267  END IF
268  itemp = idxq + ic
269  DO 20 j = 1, nr
270  iwork( itemp+j-1 ) = j
271  20 CONTINUE
272  30 CONTINUE
273 *
274 * Now conquer each subproblem bottom-up.
275 *
276  DO 50 lvl = nlvl, 1, -1
277 *
278 * Find the first node LF and last node LL on the
279 * current level LVL.
280 *
281  IF( lvl.EQ.1 ) THEN
282  lf = 1
283  ll = 1
284  ELSE
285  lf = 2**( lvl-1 )
286  ll = 2*lf - 1
287  END IF
288  DO 40 i = lf, ll
289  im1 = i - 1
290  ic = iwork( inode+im1 )
291  nl = iwork( ndiml+im1 )
292  nr = iwork( ndimr+im1 )
293  nlf = ic - nl
294  IF( ( sqre.EQ.0 ) .AND. ( i.EQ.ll ) ) THEN
295  sqrei = sqre
296  ELSE
297  sqrei = 1
298  END IF
299  idxqc = idxq + nlf - 1
300  alpha = d( ic )
301  beta = e( ic )
302  CALL dlasd1( nl, nr, sqrei, d( nlf ), alpha, beta,
303  $ u( nlf, nlf ), ldu, vt( nlf, nlf ), ldvt,
304  $ iwork( idxqc ), iwork( iwk ), work, info )
305  IF( info.NE.0 ) THEN
306  RETURN
307  END IF
308  40 CONTINUE
309  50 CONTINUE
310 *
311  RETURN
312 *
313 * End of DLASD0
314 *
315  END