Annotation of rpl/lapack/lapack/dlasd0.f, revision 1.21
1.13 bertrand 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.
1.10 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.18 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.10 bertrand 7: *
8: *> \htmlonly
1.18 bertrand 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">
1.10 bertrand 15: *> [TXT]</a>
1.18 bertrand 16: *> \endhtmlonly
1.10 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
22: * WORK, INFO )
1.18 bertrand 23: *
1.10 bertrand 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: * ..
1.18 bertrand 32: *
1.10 bertrand 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: *>
1.18 bertrand 75: *> \param[in,out] E
1.10 bertrand 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
1.20 bertrand 84: *> U is DOUBLE PRECISION array, dimension (LDU, N)
1.10 bertrand 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
1.20 bertrand 96: *> VT is DOUBLE PRECISION array, dimension (LDVT, M)
1.10 bertrand 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
1.20 bertrand 115: *> IWORK is INTEGER array, dimension (8*N)
1.10 bertrand 116: *> \endverbatim
117: *>
118: *> \param[out] WORK
119: *> \verbatim
1.20 bertrand 120: *> WORK is DOUBLE PRECISION array, dimension (3*M**2+2*M)
1.10 bertrand 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: *
1.18 bertrand 134: *> \author Univ. of Tennessee
135: *> \author Univ. of California Berkeley
136: *> \author Univ. of Colorado Denver
137: *> \author NAG Ltd.
1.10 bertrand 138: *
1.20 bertrand 139: *> \date June 2017
1.10 bertrand 140: *
1.18 bertrand 141: *> \ingroup OTHERauxiliary
1.10 bertrand 142: *
143: *> \par Contributors:
144: * ==================
145: *>
146: *> Ming Gu and Huan Ren, Computer Science Division, University of
147: *> California at Berkeley, USA
148: *>
149: * =====================================================================
1.1 bertrand 150: SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK,
151: $ WORK, INFO )
152: *
1.20 bertrand 153: * -- LAPACK auxiliary routine (version 3.7.1) --
1.1 bertrand 154: * -- LAPACK is a software package provided by Univ. of Tennessee, --
155: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.20 bertrand 156: * June 2017
1.1 bertrand 157: *
158: * .. Scalar Arguments ..
159: INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE
160: * ..
161: * .. Array Arguments ..
162: INTEGER IWORK( * )
163: DOUBLE PRECISION 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: DOUBLE PRECISION ALPHA, BETA
174: * ..
175: * .. External Subroutines ..
176: EXTERNAL DLASD1, DLASDQ, DLASDT, 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( 'DLASD0', -INFO )
201: RETURN
202: END IF
203: *
204: * If the input matrix is too small, call DLASDQ to find the SVD.
205: *
206: IF( N.LE.SMLSIZ ) THEN
207: CALL DLASDQ( '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 DLASDT( 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 DLASDQ.
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 DLASDQ( '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 DLASDQ( '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 DLASD1( NL, NR, SQREI, D( NLF ), ALPHA, BETA,
301: $ U( NLF, NLF ), LDU, VT( NLF, NLF ), LDVT,
302: $ IWORK( IDXQC ), IWORK( IWK ), WORK, INFO )
1.16 bertrand 303: *
304: * Report the possible convergence failure.
305: *
1.1 bertrand 306: IF( INFO.NE.0 ) THEN
307: RETURN
308: END IF
309: 40 CONTINUE
310: 50 CONTINUE
311: *
312: RETURN
313: *
314: * End of DLASD0
315: *
316: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlasd0.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack