LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> Download SLASD0 + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd0.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd0.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd0.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
20* WORK, INFO )
21*
22* .. Scalar Arguments ..
23* INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
24* ..
25* .. Array Arguments ..
26* INTEGER IWORK( * )
27* REAL D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
28* $ WORK( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> Using a divide and conquer approach, SLASD0 computes the singular
38*> value decomposition (SVD) of a real upper bidiagonal N-by-M
39*> matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
40*> The algorithm computes orthogonal matrices U and VT such that
41*> B = U * S * VT. The singular values S are overwritten on D.
42*>
43*> A related subroutine, SLASDA, computes only the singular values,
44*> and optionally, the singular vectors in compact form.
45*> \endverbatim
46*
47* Arguments:
48* ==========
49*
50*> \param[in] N
51*> \verbatim
52*> N is INTEGER
53*> On entry, the row dimension of the upper bidiagonal matrix.
54*> This is also the dimension of the main diagonal array D.
55*> \endverbatim
56*>
57*> \param[in] SQRE
58*> \verbatim
59*> SQRE is INTEGER
60*> Specifies the column dimension of the bidiagonal matrix.
61*> = 0: The bidiagonal matrix has column dimension M = N;
62*> = 1: The bidiagonal matrix has column dimension M = N+1;
63*> \endverbatim
64*>
65*> \param[in,out] D
66*> \verbatim
67*> D is REAL array, dimension (N)
68*> On entry D contains the main diagonal of the bidiagonal
69*> matrix.
70*> On exit D, if INFO = 0, contains its singular values.
71*> \endverbatim
72*>
73*> \param[in,out] E
74*> \verbatim
75*> E is REAL array, dimension (M-1)
76*> Contains the subdiagonal entries of the bidiagonal matrix.
77*> On exit, E has been destroyed.
78*> \endverbatim
79*>
80*> \param[in,out] U
81*> \verbatim
82*> U is REAL array, dimension (LDU, N)
83*> On exit, U contains the left singular vectors,
84*> if U passed in as (N, N) Identity.
85*> \endverbatim
86*>
87*> \param[in] LDU
88*> \verbatim
89*> LDU is INTEGER
90*> On entry, leading dimension of U.
91*> \endverbatim
92*>
93*> \param[in,out] VT
94*> \verbatim
95*> VT is REAL array, dimension (LDVT, M)
96*> On exit, VT**T contains the right singular vectors,
97*> if VT passed in as (M, M) Identity.
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 lasd0
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,
149 $ IWORK,
150 $ WORK, INFO )
151*
152* -- LAPACK auxiliary routine --
153* -- LAPACK is a software package provided by Univ. of Tennessee, --
154* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
155*
156* .. Scalar Arguments ..
157 INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
158* ..
159* .. Array Arguments ..
160 INTEGER IWORK( * )
161 REAL D( * ), E( * ), U( LDU, * ), VT( LDVT, * ),
162 $ work( * )
163* ..
164*
165* =====================================================================
166*
167* .. Local Scalars ..
168 INTEGER I, I1, IC, IDXQ, IDXQC, IM1, INODE, ITEMP, IWK,
169 $ J, LF, LL, LVL, M, NCC, ND, NDB1, NDIML, NDIMR,
170 $ nl, nlf, nlp1, nlvl, nr, nrf, nrp1, sqrei
171 REAL ALPHA, BETA
172* ..
173* .. External Subroutines ..
174 EXTERNAL slasd1, slasdq, slasdt, xerbla
175* ..
176* .. Executable Statements ..
177*
178* Test the input parameters.
179*
180 info = 0
181*
182 IF( n.LT.0 ) THEN
183 info = -1
184 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) ) THEN
185 info = -2
186 END IF
187*
188 m = n + sqre
189*
190 IF( ldu.LT.n ) THEN
191 info = -6
192 ELSE IF( ldvt.LT.m ) THEN
193 info = -8
194 ELSE IF( smlsiz.LT.3 ) THEN
195 info = -9
196 END IF
197 IF( info.NE.0 ) THEN
198 CALL xerbla( 'SLASD0', -info )
199 RETURN
200 END IF
201*
202* If the input matrix is too small, call SLASDQ to find the SVD.
203*
204 IF( n.LE.smlsiz ) THEN
205 CALL slasdq( 'U', sqre, n, m, n, 0, d, e, vt, ldvt, u, ldu,
206 $ u,
207 $ ldu, work, info )
208 RETURN
209 END IF
210*
211* Set up the computation tree.
212*
213 inode = 1
214 ndiml = inode + n
215 ndimr = ndiml + n
216 idxq = ndimr + n
217 iwk = idxq + n
218 CALL slasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
219 $ iwork( ndimr ), smlsiz )
220*
221* For the nodes on bottom level of the tree, solve
222* their subproblems by SLASDQ.
223*
224 ndb1 = ( nd+1 ) / 2
225 ncc = 0
226 DO 30 i = ndb1, nd
227*
228* IC : center row of each node
229* NL : number of rows of left subproblem
230* NR : number of rows of right subproblem
231* NLF: starting row of the left subproblem
232* NRF: starting row of the right subproblem
233*
234 i1 = i - 1
235 ic = iwork( inode+i1 )
236 nl = iwork( ndiml+i1 )
237 nlp1 = nl + 1
238 nr = iwork( ndimr+i1 )
239 nrp1 = nr + 1
240 nlf = ic - nl
241 nrf = ic + 1
242 sqrei = 1
243 CALL slasdq( 'U', sqrei, nl, nlp1, nl, ncc, d( nlf ),
244 $ 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 ),
261 $ e( nrf ),
262 $ vt( nrf, nrf ), ldvt, u( nrf, nrf ), ldu,
263 $ u( nrf, nrf ), ldu, work, info )
264 IF( info.NE.0 ) THEN
265 RETURN
266 END IF
267 itemp = idxq + ic
268 DO 20 j = 1, nr
269 iwork( itemp+j-1 ) = j
270 20 CONTINUE
271 30 CONTINUE
272*
273* Now conquer each subproblem bottom-up.
274*
275 DO 50 lvl = nlvl, 1, -1
276*
277* Find the first node LF and last node LL on the
278* current level LVL.
279*
280 IF( lvl.EQ.1 ) THEN
281 lf = 1
282 ll = 1
283 ELSE
284 lf = 2**( lvl-1 )
285 ll = 2*lf - 1
286 END IF
287 DO 40 i = lf, ll
288 im1 = i - 1
289 ic = iwork( inode+im1 )
290 nl = iwork( ndiml+im1 )
291 nr = iwork( ndimr+im1 )
292 nlf = ic - nl
293 IF( ( sqre.EQ.0 ) .AND. ( i.EQ.ll ) ) THEN
294 sqrei = sqre
295 ELSE
296 sqrei = 1
297 END IF
298 idxqc = idxq + nlf - 1
299 alpha = d( ic )
300 beta = e( ic )
301 CALL slasd1( nl, nr, sqrei, d( nlf ), alpha, beta,
302 $ u( nlf, nlf ), ldu, vt( nlf, nlf ), ldvt,
303 $ iwork( idxqc ), iwork( iwk ), work, info )
304*
305* Report the possible convergence failure.
306*
307 IF( info.NE.0 ) THEN
308 RETURN
309 END IF
310 40 CONTINUE
311 50 CONTINUE
312*
313 RETURN
314*
315* End of SLASD0
316*
317 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
slasd0
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:151
slasd1
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:203
slasdq
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:210
slasdt
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:103