LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
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
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,out] 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 (LDU, 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 (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 *> \ingroup OTHERauxiliary
140 *
141 *> \par Contributors:
142 * ==================
143 *>
144 *> Ming Gu and Huan Ren, Computer Science Division, University of
145 *> California at Berkeley, USA
146 *>
147 * =====================================================================
148  SUBROUTINE slasd0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
149  \$ WORK, INFO )
150 *
151 * -- LAPACK auxiliary routine --
152 * -- LAPACK is a software package provided by Univ. of Tennessee, --
153 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154 *
155 * .. Scalar Arguments ..
156  INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
157 * ..
158 * .. Array Arguments ..
159  INTEGER IWORK( * )
160  REAL D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
161  \$ work( * )
162 * ..
163 *
164 * =====================================================================
165 *
166 * .. Local Scalars ..
167  INTEGER I, I1, IC, IDXQ, IDXQC, IM1, INODE, ITEMP, IWK,
168  \$ j, lf, ll, lvl, m, ncc, nd, ndb1, ndiml, ndimr,
169  \$ nl, nlf, nlp1, nlvl, nr, nrf, nrp1, sqrei
170  REAL ALPHA, BETA
171 * ..
172 * .. External Subroutines ..
173  EXTERNAL slasd1, slasdq, slasdt, xerbla
174 * ..
175 * .. Executable Statements ..
176 *
177 * Test the input parameters.
178 *
179  info = 0
180 *
181  IF( n.LT.0 ) THEN
182  info = -1
183  ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) ) THEN
184  info = -2
185  END IF
186 *
187  m = n + sqre
188 *
189  IF( ldu.LT.n ) THEN
190  info = -6
191  ELSE IF( ldvt.LT.m ) THEN
192  info = -8
193  ELSE IF( smlsiz.LT.3 ) THEN
194  info = -9
195  END IF
196  IF( info.NE.0 ) THEN
197  CALL xerbla( 'SLASD0', -info )
198  RETURN
199  END IF
200 *
201 * If the input matrix is too small, call SLASDQ to find the SVD.
202 *
203  IF( n.LE.smlsiz ) THEN
204  CALL slasdq( 'U', sqre, n, m, n, 0, d, e, vt, ldvt, u, ldu, u,
205  \$ ldu, work, info )
206  RETURN
207  END IF
208 *
209 * Set up the computation tree.
210 *
211  inode = 1
212  ndiml = inode + n
213  ndimr = ndiml + n
214  idxq = ndimr + n
215  iwk = idxq + n
216  CALL slasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
217  \$ iwork( ndimr ), smlsiz )
218 *
219 * For the nodes on bottom level of the tree, solve
220 * their subproblems by SLASDQ.
221 *
222  ndb1 = ( nd+1 ) / 2
223  ncc = 0
224  DO 30 i = ndb1, nd
225 *
226 * IC : center row of each node
227 * NL : number of rows of left subproblem
228 * NR : number of rows of right subproblem
229 * NLF: starting row of the left subproblem
230 * NRF: starting row of the right subproblem
231 *
232  i1 = i - 1
233  ic = iwork( inode+i1 )
234  nl = iwork( ndiml+i1 )
235  nlp1 = nl + 1
236  nr = iwork( ndimr+i1 )
237  nrp1 = nr + 1
238  nlf = ic - nl
239  nrf = ic + 1
240  sqrei = 1
241  CALL slasdq( 'U', sqrei, nl, nlp1, nl, ncc, d( nlf ), e( nlf ),
242  \$ vt( nlf, nlf ), ldvt, u( nlf, nlf ), ldu,
243  \$ u( nlf, nlf ), ldu, work, info )
244  IF( info.NE.0 ) THEN
245  RETURN
246  END IF
247  itemp = idxq + nlf - 2
248  DO 10 j = 1, nl
249  iwork( itemp+j ) = j
250  10 CONTINUE
251  IF( i.EQ.nd ) THEN
252  sqrei = sqre
253  ELSE
254  sqrei = 1
255  END IF
256  nrp1 = nr + sqrei
257  CALL slasdq( 'U', sqrei, nr, nrp1, nr, ncc, d( nrf ), e( nrf ),
258  \$ vt( nrf, nrf ), ldvt, u( nrf, nrf ), ldu,
259  \$ u( nrf, nrf ), ldu, work, info )
260  IF( info.NE.0 ) THEN
261  RETURN
262  END IF
263  itemp = idxq + ic
264  DO 20 j = 1, nr
265  iwork( itemp+j-1 ) = j
266  20 CONTINUE
267  30 CONTINUE
268 *
269 * Now conquer each subproblem bottom-up.
270 *
271  DO 50 lvl = nlvl, 1, -1
272 *
273 * Find the first node LF and last node LL on the
274 * current level LVL.
275 *
276  IF( lvl.EQ.1 ) THEN
277  lf = 1
278  ll = 1
279  ELSE
280  lf = 2**( lvl-1 )
281  ll = 2*lf - 1
282  END IF
283  DO 40 i = lf, ll
284  im1 = i - 1
285  ic = iwork( inode+im1 )
286  nl = iwork( ndiml+im1 )
287  nr = iwork( ndimr+im1 )
288  nlf = ic - nl
289  IF( ( sqre.EQ.0 ) .AND. ( i.EQ.ll ) ) THEN
290  sqrei = sqre
291  ELSE
292  sqrei = 1
293  END IF
294  idxqc = idxq + nlf - 1
295  alpha = d( ic )
296  beta = e( ic )
297  CALL slasd1( nl, nr, sqrei, d( nlf ), alpha, beta,
298  \$ u( nlf, nlf ), ldu, vt( nlf, nlf ), ldvt,
299  \$ iwork( idxqc ), iwork( iwk ), work, info )
300 *
301 * Report the possible convergence failure.
302 *
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
subroutine slasd0(N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, WORK, INFO)
SLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and of...
Definition: slasd0.f:150
subroutine slasd1(NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, IDXQ, IWORK, WORK, INFO)
SLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc.
Definition: slasd1.f:204
subroutine slasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e....
Definition: slasdq.f:211
subroutine slasdt(N, LVL, ND, INODE, NDIML, NDIMR, MSUB)
SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
Definition: slasdt.f:105
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60