LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dlasq1.f
Go to the documentation of this file.
1*> \brief \b DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLASQ1 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq1.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq1.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq1.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER INFO, N
25* ..
26* .. Array Arguments ..
27* DOUBLE PRECISION D( * ), E( * ), WORK( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> DLASQ1 computes the singular values of a real N-by-N bidiagonal
37*> matrix with diagonal D and off-diagonal E. The singular values
38*> are computed to high relative accuracy, in the absence of
39*> denormalization, underflow and overflow. The algorithm was first
40*> presented in
41*>
42*> "Accurate singular values and differential qd algorithms" by K. V.
43*> Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
44*> 1994,
45*>
46*> and the present implementation is described in "An implementation of
47*> the dqds Algorithm (Positive Case)", LAPACK Working Note.
48*> \endverbatim
49*
50* Arguments:
51* ==========
52*
53*> \param[in] N
54*> \verbatim
55*> N is INTEGER
56*> The number of rows and columns in the matrix. N >= 0.
57*> \endverbatim
58*>
59*> \param[in,out] D
60*> \verbatim
61*> D is DOUBLE PRECISION array, dimension (N)
62*> On entry, D contains the diagonal elements of the
63*> bidiagonal matrix whose SVD is desired. On normal exit,
64*> D contains the singular values in decreasing order.
65*> \endverbatim
66*>
67*> \param[in,out] E
68*> \verbatim
69*> E is DOUBLE PRECISION array, dimension (N)
70*> On entry, elements E(1:N-1) contain the off-diagonal elements
71*> of the bidiagonal matrix whose SVD is desired.
72*> On exit, E is overwritten.
73*> \endverbatim
74*>
75*> \param[out] WORK
76*> \verbatim
77*> WORK is DOUBLE PRECISION array, dimension (4*N)
78*> \endverbatim
79*>
80*> \param[out] INFO
81*> \verbatim
82*> INFO is INTEGER
83*> = 0: successful exit
84*> < 0: if INFO = -i, the i-th argument had an illegal value
85*> > 0: the algorithm failed
86*> = 1, a split was marked by a positive value in E
87*> = 2, current block of Z not diagonalized after 100*N
88*> iterations (in inner while loop) On exit D and E
89*> represent a matrix with the same singular values
90*> which the calling subroutine could use to finish the
91*> computation, or even feed back into DLASQ1
92*> = 3, termination criterion of outer while loop not met
93*> (program created more than N unreduced blocks)
94*> \endverbatim
95*
96* Authors:
97* ========
98*
99*> \author Univ. of Tennessee
100*> \author Univ. of California Berkeley
101*> \author Univ. of Colorado Denver
102*> \author NAG Ltd.
103*
104*> \ingroup lasq1
105*
106* =====================================================================
107 SUBROUTINE dlasq1( N, D, E, WORK, INFO )
108*
109* -- LAPACK computational routine --
110* -- LAPACK is a software package provided by Univ. of Tennessee, --
111* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112*
113* .. Scalar Arguments ..
114 INTEGER INFO, N
115* ..
116* .. Array Arguments ..
117 DOUBLE PRECISION D( * ), E( * ), WORK( * )
118* ..
119*
120* =====================================================================
121*
122* .. Parameters ..
123 DOUBLE PRECISION ZERO
124 parameter( zero = 0.0d0 )
125* ..
126* .. Local Scalars ..
127 INTEGER I, IINFO
128 DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX
129* ..
130* .. External Subroutines ..
131 EXTERNAL dcopy, dlas2, dlascl, dlasq2, dlasrt, xerbla
132* ..
133* .. External Functions ..
134 DOUBLE PRECISION DLAMCH
135 EXTERNAL dlamch
136* ..
137* .. Intrinsic Functions ..
138 INTRINSIC abs, max, sqrt
139* ..
140* .. Executable Statements ..
141*
142 info = 0
143 IF( n.LT.0 ) THEN
144 info = -1
145 CALL xerbla( 'DLASQ1', -info )
146 RETURN
147 ELSE IF( n.EQ.0 ) THEN
148 RETURN
149 ELSE IF( n.EQ.1 ) THEN
150 d( 1 ) = abs( d( 1 ) )
151 RETURN
152 ELSE IF( n.EQ.2 ) THEN
153 CALL dlas2( d( 1 ), e( 1 ), d( 2 ), sigmn, sigmx )
154 d( 1 ) = sigmx
155 d( 2 ) = sigmn
156 RETURN
157 END IF
158*
159* Estimate the largest singular value.
160*
161 sigmx = zero
162 DO 10 i = 1, n - 1
163 d( i ) = abs( d( i ) )
164 sigmx = max( sigmx, abs( e( i ) ) )
165 10 CONTINUE
166 d( n ) = abs( d( n ) )
167*
168* Early return if SIGMX is zero (matrix is already diagonal).
169*
170 IF( sigmx.EQ.zero ) THEN
171 CALL dlasrt( 'D', n, d, iinfo )
172 RETURN
173 END IF
174*
175 DO 20 i = 1, n
176 sigmx = max( sigmx, d( i ) )
177 20 CONTINUE
178*
179* Copy D and E into WORK (in the Z format) and scale (squaring the
180* input data makes scaling by a power of the radix pointless).
181*
182 eps = dlamch( 'Precision' )
183 safmin = dlamch( 'Safe minimum' )
184 scale = sqrt( eps / safmin )
185 CALL dcopy( n, d, 1, work( 1 ), 2 )
186 CALL dcopy( n-1, e, 1, work( 2 ), 2 )
187 CALL dlascl( 'G', 0, 0, sigmx, scale, 2*n-1, 1, work, 2*n-1,
188 $ iinfo )
189*
190* Compute the q's and e's.
191*
192 DO 30 i = 1, 2*n - 1
193 work( i ) = work( i )**2
194 30 CONTINUE
195 work( 2*n ) = zero
196*
197 CALL dlasq2( n, work, info )
198*
199 IF( info.EQ.0 ) THEN
200 DO 40 i = 1, n
201 d( i ) = sqrt( work( i ) )
202 40 CONTINUE
203 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
204 ELSE IF( info.EQ.2 ) THEN
205*
206* Maximum number of iterations exceeded. Move data from WORK
207* into D and E so the calling subroutine can try to finish
208*
209 DO i = 1, n
210 d( i ) = sqrt( work( 2*i-1 ) )
211 e( i ) = sqrt( work( 2*i ) )
212 END DO
213 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
214 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, e, n, iinfo )
215 END IF
216*
217 RETURN
218*
219* End of DLASQ1
220*
221 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
subroutine dlas2(f, g, h, ssmin, ssmax)
DLAS2 computes singular values of a 2-by-2 triangular matrix.
Definition dlas2.f:105
subroutine dlascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition dlascl.f:143
subroutine dlasq1(n, d, e, work, info)
DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.
Definition dlasq1.f:108
subroutine dlasq2(n, z, info)
DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
Definition dlasq2.f:112
subroutine dlasrt(id, n, d, info)
DLASRT sorts numbers in increasing or decreasing order.
Definition dlasrt.f:88