LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dlasq1()

subroutine dlasq1 ( integer n,
double precision, dimension( * ) d,
double precision, dimension( * ) e,
double precision, dimension( * ) work,
integer info )

DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr.

Download DLASQ1 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> DLASQ1 computes the singular values of a real N-by-N bidiagonal
!> matrix with diagonal D and off-diagonal E. The singular values
!> are computed to high relative accuracy, in the absence of
!> denormalization, underflow and overflow. The algorithm was first
!> presented in
!>
!>  by K. V.
!> Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
!> 1994,
!>
!> and the present implementation is described in , LAPACK Working Note.
!> 
Parameters
[in]N
!>          N is INTEGER
!>        The number of rows and columns in the matrix. N >= 0.
!> 
[in,out]D
!>          D is DOUBLE PRECISION array, dimension (N)
!>        On entry, D contains the diagonal elements of the
!>        bidiagonal matrix whose SVD is desired. On normal exit,
!>        D contains the singular values in decreasing order.
!> 
[in,out]E
!>          E is DOUBLE PRECISION array, dimension (N)
!>        On entry, elements E(1:N-1) contain the off-diagonal elements
!>        of the bidiagonal matrix whose SVD is desired.
!>        On exit, E is overwritten.
!> 
[out]WORK
!>          WORK is DOUBLE PRECISION array, dimension (4*N)
!> 
[out]INFO
!>          INFO is INTEGER
!>        = 0: successful exit
!>        < 0: if INFO = -i, the i-th argument had an illegal value
!>        > 0: the algorithm failed
!>             = 1, a split was marked by a positive value in E
!>             = 2, current block of Z not diagonalized after 100*N
!>                  iterations (in inner while loop)  On exit D and E
!>                  represent a matrix with the same singular values
!>                  which the calling subroutine could use to finish the
!>                  computation, or even feed back into DLASQ1
!>             = 3, termination criterion of outer while loop not met
!>                  (program created more than N unreduced blocks)
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 105 of file dlasq1.f.

106*
107* -- LAPACK computational routine --
108* -- LAPACK is a software package provided by Univ. of Tennessee, --
109* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
110*
111* .. Scalar Arguments ..
112 INTEGER INFO, N
113* ..
114* .. Array Arguments ..
115 DOUBLE PRECISION D( * ), E( * ), WORK( * )
116* ..
117*
118* =====================================================================
119*
120* .. Parameters ..
121 DOUBLE PRECISION ZERO
122 parameter( zero = 0.0d0 )
123* ..
124* .. Local Scalars ..
125 INTEGER I, IINFO
126 DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX
127* ..
128* .. External Subroutines ..
129 EXTERNAL dcopy, dlas2, dlascl, dlasq2, dlasrt,
130 $ xerbla
131* ..
132* .. External Functions ..
133 DOUBLE PRECISION DLAMCH
134 EXTERNAL dlamch
135* ..
136* .. Intrinsic Functions ..
137 INTRINSIC abs, max, sqrt
138* ..
139* .. Executable Statements ..
140*
141 info = 0
142 IF( n.LT.0 ) THEN
143 info = -1
144 CALL xerbla( 'DLASQ1', -info )
145 RETURN
146 ELSE IF( n.EQ.0 ) THEN
147 RETURN
148 ELSE IF( n.EQ.1 ) THEN
149 d( 1 ) = abs( d( 1 ) )
150 RETURN
151 ELSE IF( n.EQ.2 ) THEN
152 CALL dlas2( d( 1 ), e( 1 ), d( 2 ), sigmn, sigmx )
153 d( 1 ) = sigmx
154 d( 2 ) = sigmn
155 RETURN
156 END IF
157*
158* Estimate the largest singular value.
159*
160 sigmx = zero
161 DO 10 i = 1, n - 1
162 d( i ) = abs( d( i ) )
163 sigmx = max( sigmx, abs( e( i ) ) )
164 10 CONTINUE
165 d( n ) = abs( d( n ) )
166*
167* Early return if SIGMX is zero (matrix is already diagonal).
168*
169 IF( sigmx.EQ.zero ) THEN
170 CALL dlasrt( 'D', n, d, iinfo )
171 RETURN
172 END IF
173*
174 DO 20 i = 1, n
175 sigmx = max( sigmx, d( i ) )
176 20 CONTINUE
177*
178* Copy D and E into WORK (in the Z format) and scale (squaring the
179* input data makes scaling by a power of the radix pointless).
180*
181 eps = dlamch( 'Precision' )
182 safmin = dlamch( 'Safe minimum' )
183 scale = sqrt( eps / safmin )
184 CALL dcopy( n, d, 1, work( 1 ), 2 )
185 CALL dcopy( n-1, e, 1, work( 2 ), 2 )
186 CALL dlascl( 'G', 0, 0, sigmx, scale, 2*n-1, 1, work, 2*n-1,
187 $ iinfo )
188*
189* Compute the q's and e's.
190*
191 DO 30 i = 1, 2*n - 1
192 work( i ) = work( i )**2
193 30 CONTINUE
194 work( 2*n ) = zero
195*
196 CALL dlasq2( n, work, info )
197*
198 IF( info.EQ.0 ) THEN
199 DO 40 i = 1, n
200 d( i ) = sqrt( work( i ) )
201 40 CONTINUE
202 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
203 ELSE IF( info.EQ.2 ) THEN
204*
205* Maximum number of iterations exceeded. Move data from WORK
206* into D and E so the calling subroutine can try to finish
207*
208 DO i = 1, n
209 d( i ) = sqrt( work( 2*i-1 ) )
210 e( i ) = sqrt( work( 2*i ) )
211 END DO
212 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, d, n, iinfo )
213 CALL dlascl( 'G', 0, 0, scale, sigmx, n, 1, e, n, iinfo )
214 END IF
215*
216 RETURN
217*
218* End of DLASQ1
219*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
subroutine dlas2(f, g, h, ssmin, ssmax)
DLAS2 computes singular values of a 2-by-2 triangular matrix.
Definition dlas2.f:103
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:142
subroutine dlasq2(n, z, info)
DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated ...
Definition dlasq2.f:110
subroutine dlasrt(id, n, d, info)
DLASRT sorts numbers in increasing or decreasing order.
Definition dlasrt.f:86
Here is the call graph for this function:
Here is the caller graph for this function: