LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
slasd0.f
Go to the documentation of this file.
1 *> \brief \b SLASD0 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 SLASD0 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd0.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd0.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd0.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLASD0( 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 * REAL 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, SLASD0 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, SLASDA, 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 REAL 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 REAL 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 REAL 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 REAL 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 array, dimension (8*N)
116 *> \endverbatim
117 *>
118 *> \param[out] WORK
119 *> \verbatim
120 *> WORK is REAL array, dimension (3*M**2+2*M)
121 *> \endverbatim
122 *>
123 *> \param[out] INFO
124 *> \verbatim
125 *> INFO is INTEGER
126 *> = 0: successful exit.
127 *> < 0: if INFO = -i, the i-th argument had an illegal value.
128 *> > 0: if INFO = 1, a singular value did not converge
129 *> \endverbatim
130 *
131 * Authors:
132 * ========
133 *
134 *> \author Univ. of Tennessee
135 *> \author Univ. of California Berkeley
136 *> \author Univ. of Colorado Denver
137 *> \author NAG Ltd.
138 *
139 *> \date September 2012
140 *
141 *> \ingroup auxOTHERauxiliary
142 *
143 *> \par Contributors:
144 * ==================
145 *>
146 *> Ming Gu and Huan Ren, Computer Science Division, University of
147 *> California at Berkeley, USA
148 *>
149 * =====================================================================
150  SUBROUTINE slasd0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
151  $ work, info )
152 *
153 * -- LAPACK auxiliary routine (version 3.4.2) --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 * September 2012
157 *
158 * .. Scalar Arguments ..
159  INTEGER info, ldu, ldvt, n, smlsiz, sqre
160 * ..
161 * .. Array Arguments ..
162  INTEGER iwork( * )
163  REAL d( * ), e( * ), u( ldu, * ), vt( ldvt, * ),
164  $ work( * )
165 * ..
166 *
167 * =====================================================================
168 *
169 * .. Local Scalars ..
170  INTEGER i, i1, ic, idxq, idxqc, im1, inode, itemp, iwk,
171  $ j, lf, ll, lvl, m, ncc, nd, ndb1, ndiml, ndimr,
172  $ nl, nlf, nlp1, nlvl, nr, nrf, nrp1, sqrei
173  REAL alpha, beta
174 * ..
175 * .. External Subroutines ..
176  EXTERNAL slasd1, slasdq, slasdt, xerbla
177 * ..
178 * .. Executable Statements ..
179 *
180 * Test the input parameters.
181 *
182  info = 0
183 *
184  IF( n.LT.0 ) THEN
185  info = -1
186  ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) ) THEN
187  info = -2
188  END IF
189 *
190  m = n + sqre
191 *
192  IF( ldu.LT.n ) THEN
193  info = -6
194  ELSE IF( ldvt.LT.m ) THEN
195  info = -8
196  ELSE IF( smlsiz.LT.3 ) THEN
197  info = -9
198  END IF
199  IF( info.NE.0 ) THEN
200  CALL xerbla( 'SLASD0', -info )
201  RETURN
202  END IF
203 *
204 * If the input matrix is too small, call SLASDQ to find the SVD.
205 *
206  IF( n.LE.smlsiz ) THEN
207  CALL slasdq( 'U', sqre, n, m, n, 0, d, e, vt, ldvt, u, ldu, u,
208  $ ldu, work, info )
209  RETURN
210  END IF
211 *
212 * Set up the computation tree.
213 *
214  inode = 1
215  ndiml = inode + n
216  ndimr = ndiml + n
217  idxq = ndimr + n
218  iwk = idxq + n
219  CALL slasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
220  $ iwork( ndimr ), smlsiz )
221 *
222 * For the nodes on bottom level of the tree, solve
223 * their subproblems by SLASDQ.
224 *
225  ndb1 = ( nd+1 ) / 2
226  ncc = 0
227  DO 30 i = ndb1, nd
228 *
229 * IC : center row of each node
230 * NL : number of rows of left subproblem
231 * NR : number of rows of right subproblem
232 * NLF: starting row of the left subproblem
233 * NRF: starting row of the right subproblem
234 *
235  i1 = i - 1
236  ic = iwork( inode+i1 )
237  nl = iwork( ndiml+i1 )
238  nlp1 = nl + 1
239  nr = iwork( ndimr+i1 )
240  nrp1 = nr + 1
241  nlf = ic - nl
242  nrf = ic + 1
243  sqrei = 1
244  CALL slasdq( 'U', sqrei, nl, nlp1, nl, ncc, d( nlf ), e( nlf ),
245  $ vt( nlf, nlf ), ldvt, u( nlf, nlf ), ldu,
246  $ u( nlf, nlf ), ldu, work, info )
247  IF( info.NE.0 ) THEN
248  RETURN
249  END IF
250  itemp = idxq + nlf - 2
251  DO 10 j = 1, nl
252  iwork( itemp+j ) = j
253  10 CONTINUE
254  IF( i.EQ.nd ) THEN
255  sqrei = sqre
256  ELSE
257  sqrei = 1
258  END IF
259  nrp1 = nr + sqrei
260  CALL slasdq( 'U', sqrei, nr, nrp1, nr, ncc, d( nrf ), e( nrf ),
261  $ vt( nrf, nrf ), ldvt, u( nrf, nrf ), ldu,
262  $ u( nrf, nrf ), ldu, work, info )
263  IF( info.NE.0 ) THEN
264  RETURN
265  END IF
266  itemp = idxq + ic
267  DO 20 j = 1, nr
268  iwork( itemp+j-1 ) = j
269  20 CONTINUE
270  30 CONTINUE
271 *
272 * Now conquer each subproblem bottom-up.
273 *
274  DO 50 lvl = nlvl, 1, -1
275 *
276 * Find the first node LF and last node LL on the
277 * current level LVL.
278 *
279  IF( lvl.EQ.1 ) THEN
280  lf = 1
281  ll = 1
282  ELSE
283  lf = 2**( lvl-1 )
284  ll = 2*lf - 1
285  END IF
286  DO 40 i = lf, ll
287  im1 = i - 1
288  ic = iwork( inode+im1 )
289  nl = iwork( ndiml+im1 )
290  nr = iwork( ndimr+im1 )
291  nlf = ic - nl
292  IF( ( sqre.EQ.0 ) .AND. ( i.EQ.ll ) ) THEN
293  sqrei = sqre
294  ELSE
295  sqrei = 1
296  END IF
297  idxqc = idxq + nlf - 1
298  alpha = d( ic )
299  beta = e( ic )
300  CALL slasd1( nl, nr, sqrei, d( nlf ), alpha, beta,
301  $ u( nlf, nlf ), ldu, vt( nlf, nlf ), ldvt,
302  $ iwork( idxqc ), iwork( iwk ), work, info )
303  IF( info.NE.0 ) THEN
304  RETURN
305  END IF
306  40 CONTINUE
307  50 CONTINUE
308 *
309  RETURN
310 *
311 * End of SLASD0
312 *
313  END