LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slaed1.f
Go to the documentation of this file.
1 *> \brief \b SLAED1 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLAED1 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaed1.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaed1.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaed1.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
22 * INFO )
23 *
24 * .. Scalar Arguments ..
25 * INTEGER CUTPNT, INFO, LDQ, N
26 * REAL RHO
27 * ..
28 * .. Array Arguments ..
29 * INTEGER INDXQ( * ), IWORK( * )
30 * REAL D( * ), Q( LDQ, * ), WORK( * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> SLAED1 computes the updated eigensystem of a diagonal
40 *> matrix after modification by a rank-one symmetric matrix. This
41 *> routine is used only for the eigenproblem which requires all
42 *> eigenvalues and eigenvectors of a tridiagonal matrix. SLAED7 handles
43 *> the case in which eigenvalues only or eigenvalues and eigenvectors
44 *> of a full symmetric matrix (which was reduced to tridiagonal form)
45 *> are desired.
46 *>
47 *> T = Q(in) ( D(in) + RHO * Z*Z**T ) Q**T(in) = Q(out) * D(out) * Q**T(out)
48 *>
49 *> where Z = Q**T*u, u is a vector of length N with ones in the
50 *> CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
51 *>
52 *> The eigenvectors of the original matrix are stored in Q, and the
53 *> eigenvalues are in D. The algorithm consists of three stages:
54 *>
55 *> The first stage consists of deflating the size of the problem
56 *> when there are multiple eigenvalues or if there is a zero in
57 *> the Z vector. For each such occurence the dimension of the
58 *> secular equation problem is reduced by one. This stage is
59 *> performed by the routine SLAED2.
60 *>
61 *> The second stage consists of calculating the updated
62 *> eigenvalues. This is done by finding the roots of the secular
63 *> equation via the routine SLAED4 (as called by SLAED3).
64 *> This routine also calculates the eigenvectors of the current
65 *> problem.
66 *>
67 *> The final stage consists of computing the updated eigenvectors
68 *> directly using the updated eigenvalues. The eigenvectors for
69 *> the current problem are multiplied with the eigenvectors from
70 *> the overall problem.
71 *> \endverbatim
72 *
73 * Arguments:
74 * ==========
75 *
76 *> \param[in] N
77 *> \verbatim
78 *> N is INTEGER
79 *> The dimension of the symmetric tridiagonal matrix. N >= 0.
80 *> \endverbatim
81 *>
82 *> \param[in,out] D
83 *> \verbatim
84 *> D is REAL array, dimension (N)
85 *> On entry, the eigenvalues of the rank-1-perturbed matrix.
86 *> On exit, the eigenvalues of the repaired matrix.
87 *> \endverbatim
88 *>
89 *> \param[in,out] Q
90 *> \verbatim
91 *> Q is REAL array, dimension (LDQ,N)
92 *> On entry, the eigenvectors of the rank-1-perturbed matrix.
93 *> On exit, the eigenvectors of the repaired tridiagonal matrix.
94 *> \endverbatim
95 *>
96 *> \param[in] LDQ
97 *> \verbatim
98 *> LDQ is INTEGER
99 *> The leading dimension of the array Q. LDQ >= max(1,N).
100 *> \endverbatim
101 *>
102 *> \param[in,out] INDXQ
103 *> \verbatim
104 *> INDXQ is INTEGER array, dimension (N)
105 *> On entry, the permutation which separately sorts the two
106 *> subproblems in D into ascending order.
107 *> On exit, the permutation which will reintegrate the
108 *> subproblems back into sorted order,
109 *> i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
110 *> \endverbatim
111 *>
112 *> \param[in] RHO
113 *> \verbatim
114 *> RHO is REAL
115 *> The subdiagonal entry used to create the rank-1 modification.
116 *> \endverbatim
117 *>
118 *> \param[in] CUTPNT
119 *> \verbatim
120 *> CUTPNT is INTEGER
121 *> The location of the last eigenvalue in the leading sub-matrix.
122 *> min(1,N) <= CUTPNT <= N/2.
123 *> \endverbatim
124 *>
125 *> \param[out] WORK
126 *> \verbatim
127 *> WORK is REAL array, dimension (4*N + N**2)
128 *> \endverbatim
129 *>
130 *> \param[out] IWORK
131 *> \verbatim
132 *> IWORK is INTEGER array, dimension (4*N)
133 *> \endverbatim
134 *>
135 *> \param[out] INFO
136 *> \verbatim
137 *> INFO is INTEGER
138 *> = 0: successful exit.
139 *> < 0: if INFO = -i, the i-th argument had an illegal value.
140 *> > 0: if INFO = 1, an eigenvalue did not converge
141 *> \endverbatim
142 *
143 * Authors:
144 * ========
145 *
146 *> \author Univ. of Tennessee
147 *> \author Univ. of California Berkeley
148 *> \author Univ. of Colorado Denver
149 *> \author NAG Ltd.
150 *
151 *> \date September 2012
152 *
153 *> \ingroup auxOTHERcomputational
154 *
155 *> \par Contributors:
156 * ==================
157 *>
158 *> Jeff Rutter, Computer Science Division, University of California
159 *> at Berkeley, USA \n
160 *> Modified by Francoise Tisseur, University of Tennessee
161 *>
162 * =====================================================================
163  SUBROUTINE slaed1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
164  $ info )
165 *
166 * -- LAPACK computational routine (version 3.4.2) --
167 * -- LAPACK is a software package provided by Univ. of Tennessee, --
168 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
169 * September 2012
170 *
171 * .. Scalar Arguments ..
172  INTEGER cutpnt, info, ldq, n
173  REAL rho
174 * ..
175 * .. Array Arguments ..
176  INTEGER indxq( * ), iwork( * )
177  REAL d( * ), q( ldq, * ), work( * )
178 * ..
179 *
180 * =====================================================================
181 *
182 * .. Local Scalars ..
183  INTEGER coltyp, cpp1, i, idlmda, indx, indxc, indxp,
184  $ iq2, is, iw, iz, k, n1, n2
185 * ..
186 * .. External Subroutines ..
187  EXTERNAL scopy, slaed2, slaed3, slamrg, xerbla
188 * ..
189 * .. Intrinsic Functions ..
190  INTRINSIC max, min
191 * ..
192 * .. Executable Statements ..
193 *
194 * Test the input parameters.
195 *
196  info = 0
197 *
198  IF( n.LT.0 ) THEN
199  info = -1
200  ELSE IF( ldq.LT.max( 1, n ) ) THEN
201  info = -4
202  ELSE IF( min( 1, n / 2 ).GT.cutpnt .OR. ( n / 2 ).LT.cutpnt ) THEN
203  info = -7
204  END IF
205  IF( info.NE.0 ) THEN
206  CALL xerbla( 'SLAED1', -info )
207  return
208  END IF
209 *
210 * Quick return if possible
211 *
212  IF( n.EQ.0 )
213  $ return
214 *
215 * The following values are integer pointers which indicate
216 * the portion of the workspace
217 * used by a particular array in SLAED2 and SLAED3.
218 *
219  iz = 1
220  idlmda = iz + n
221  iw = idlmda + n
222  iq2 = iw + n
223 *
224  indx = 1
225  indxc = indx + n
226  coltyp = indxc + n
227  indxp = coltyp + n
228 *
229 *
230 * Form the z-vector which consists of the last row of Q_1 and the
231 * first row of Q_2.
232 *
233  CALL scopy( cutpnt, q( cutpnt, 1 ), ldq, work( iz ), 1 )
234  cpp1 = cutpnt + 1
235  CALL scopy( n-cutpnt, q( cpp1, cpp1 ), ldq, work( iz+cutpnt ), 1 )
236 *
237 * Deflate eigenvalues.
238 *
239  CALL slaed2( k, n, cutpnt, d, q, ldq, indxq, rho, work( iz ),
240  $ work( idlmda ), work( iw ), work( iq2 ),
241  $ iwork( indx ), iwork( indxc ), iwork( indxp ),
242  $ iwork( coltyp ), info )
243 *
244  IF( info.NE.0 )
245  $ go to 20
246 *
247 * Solve Secular Equation.
248 *
249  IF( k.NE.0 ) THEN
250  is = ( iwork( coltyp )+iwork( coltyp+1 ) )*cutpnt +
251  $ ( iwork( coltyp+1 )+iwork( coltyp+2 ) )*( n-cutpnt ) + iq2
252  CALL slaed3( k, n, cutpnt, d, q, ldq, rho, work( idlmda ),
253  $ work( iq2 ), iwork( indxc ), iwork( coltyp ),
254  $ work( iw ), work( is ), info )
255  IF( info.NE.0 )
256  $ go to 20
257 *
258 * Prepare the INDXQ sorting permutation.
259 *
260  n1 = k
261  n2 = n - k
262  CALL slamrg( n1, n2, d, 1, -1, indxq )
263  ELSE
264  DO 10 i = 1, n
265  indxq( i ) = i
266  10 continue
267  END IF
268 *
269  20 continue
270  return
271 *
272 * End of SLAED1
273 *
274  END