001:       SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK,
002:      $                   INFO )
003: *
004: *  -- LAPACK routine (version 3.2) --
005: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       INTEGER            CUTPNT, INFO, LDQ, N
011:       REAL               RHO
012: *     ..
013: *     .. Array Arguments ..
014:       INTEGER            INDXQ( * ), IWORK( * )
015:       REAL               D( * ), Q( LDQ, * ), WORK( * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  SLAED1 computes the updated eigensystem of a diagonal
022: *  matrix after modification by a rank-one symmetric matrix.  This
023: *  routine is used only for the eigenproblem which requires all
024: *  eigenvalues and eigenvectors of a tridiagonal matrix.  SLAED7 handles
025: *  the case in which eigenvalues only or eigenvalues and eigenvectors
026: *  of a full symmetric matrix (which was reduced to tridiagonal form)
027: *  are desired.
028: *
029: *    T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
030: *
031: *     where Z = Q'u, u is a vector of length N with ones in the
032: *     CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
033: *
034: *     The eigenvectors of the original matrix are stored in Q, and the
035: *     eigenvalues are in D.  The algorithm consists of three stages:
036: *
037: *        The first stage consists of deflating the size of the problem
038: *        when there are multiple eigenvalues or if there is a zero in
039: *        the Z vector.  For each such occurence the dimension of the
040: *        secular equation problem is reduced by one.  This stage is
041: *        performed by the routine SLAED2.
042: *
043: *        The second stage consists of calculating the updated
044: *        eigenvalues. This is done by finding the roots of the secular
045: *        equation via the routine SLAED4 (as called by SLAED3).
046: *        This routine also calculates the eigenvectors of the current
047: *        problem.
048: *
049: *        The final stage consists of computing the updated eigenvectors
050: *        directly using the updated eigenvalues.  The eigenvectors for
051: *        the current problem are multiplied with the eigenvectors from
052: *        the overall problem.
053: *
054: *  Arguments
055: *  =========
056: *
057: *  N      (input) INTEGER
058: *         The dimension of the symmetric tridiagonal matrix.  N >= 0.
059: *
060: *  D      (input/output) REAL array, dimension (N)
061: *         On entry, the eigenvalues of the rank-1-perturbed matrix.
062: *         On exit, the eigenvalues of the repaired matrix.
063: *
064: *  Q      (input/output) REAL array, dimension (LDQ,N)
065: *         On entry, the eigenvectors of the rank-1-perturbed matrix.
066: *         On exit, the eigenvectors of the repaired tridiagonal matrix.
067: *
068: *  LDQ    (input) INTEGER
069: *         The leading dimension of the array Q.  LDQ >= max(1,N).
070: *
071: *  INDXQ  (input/output) INTEGER array, dimension (N)
072: *         On entry, the permutation which separately sorts the two
073: *         subproblems in D into ascending order.
074: *         On exit, the permutation which will reintegrate the
075: *         subproblems back into sorted order,
076: *         i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
077: *
078: *  RHO    (input) REAL
079: *         The subdiagonal entry used to create the rank-1 modification.
080: *
081: *  CUTPNT (input) INTEGER
082: *         The location of the last eigenvalue in the leading sub-matrix.
083: *         min(1,N) <= CUTPNT <= N/2.
084: *
085: *  WORK   (workspace) REAL array, dimension (4*N + N**2)
086: *
087: *  IWORK  (workspace) INTEGER array, dimension (4*N)
088: *
089: *  INFO   (output) INTEGER
090: *          = 0:  successful exit.
091: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
092: *          > 0:  if INFO = 1, an eigenvalue did not converge
093: *
094: *  Further Details
095: *  ===============
096: *
097: *  Based on contributions by
098: *     Jeff Rutter, Computer Science Division, University of California
099: *     at Berkeley, USA
100: *  Modified by Francoise Tisseur, University of Tennessee.
101: *
102: *  =====================================================================
103: *
104: *     .. Local Scalars ..
105:       INTEGER            COLTYP, CPP1, I, IDLMDA, INDX, INDXC, INDXP,
106:      $                   IQ2, IS, IW, IZ, K, N1, N2
107: *     ..
108: *     .. External Subroutines ..
109:       EXTERNAL           SCOPY, SLAED2, SLAED3, SLAMRG, XERBLA
110: *     ..
111: *     .. Intrinsic Functions ..
112:       INTRINSIC          MAX, MIN
113: *     ..
114: *     .. Executable Statements ..
115: *
116: *     Test the input parameters.
117: *
118:       INFO = 0
119: *
120:       IF( N.LT.0 ) THEN
121:          INFO = -1
122:       ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
123:          INFO = -4
124:       ELSE IF( MIN( 1, N / 2 ).GT.CUTPNT .OR. ( N / 2 ).LT.CUTPNT ) THEN
125:          INFO = -7
126:       END IF
127:       IF( INFO.NE.0 ) THEN
128:          CALL XERBLA( 'SLAED1', -INFO )
129:          RETURN
130:       END IF
131: *
132: *     Quick return if possible
133: *
134:       IF( N.EQ.0 )
135:      $   RETURN
136: *
137: *     The following values are integer pointers which indicate
138: *     the portion of the workspace
139: *     used by a particular array in SLAED2 and SLAED3.
140: *
141:       IZ = 1
142:       IDLMDA = IZ + N
143:       IW = IDLMDA + N
144:       IQ2 = IW + N
145: *
146:       INDX = 1
147:       INDXC = INDX + N
148:       COLTYP = INDXC + N
149:       INDXP = COLTYP + N
150: *
151: *
152: *     Form the z-vector which consists of the last row of Q_1 and the
153: *     first row of Q_2.
154: *
155:       CALL SCOPY( CUTPNT, Q( CUTPNT, 1 ), LDQ, WORK( IZ ), 1 )
156:       CPP1 = CUTPNT + 1
157:       CALL SCOPY( N-CUTPNT, Q( CPP1, CPP1 ), LDQ, WORK( IZ+CUTPNT ), 1 )
158: *
159: *     Deflate eigenvalues.
160: *
161:       CALL SLAED2( K, N, CUTPNT, D, Q, LDQ, INDXQ, RHO, WORK( IZ ),
162:      $             WORK( IDLMDA ), WORK( IW ), WORK( IQ2 ),
163:      $             IWORK( INDX ), IWORK( INDXC ), IWORK( INDXP ),
164:      $             IWORK( COLTYP ), INFO )
165: *
166:       IF( INFO.NE.0 )
167:      $   GO TO 20
168: *
169: *     Solve Secular Equation.
170: *
171:       IF( K.NE.0 ) THEN
172:          IS = ( IWORK( COLTYP )+IWORK( COLTYP+1 ) )*CUTPNT +
173:      $        ( IWORK( COLTYP+1 )+IWORK( COLTYP+2 ) )*( N-CUTPNT ) + IQ2
174:          CALL SLAED3( K, N, CUTPNT, D, Q, LDQ, RHO, WORK( IDLMDA ),
175:      $                WORK( IQ2 ), IWORK( INDXC ), IWORK( COLTYP ),
176:      $                WORK( IW ), WORK( IS ), INFO )
177:          IF( INFO.NE.0 )
178:      $      GO TO 20
179: *
180: *     Prepare the INDXQ sorting permutation.
181: *
182:          N1 = K
183:          N2 = N - K
184:          CALL SLAMRG( N1, N2, D, 1, -1, INDXQ )
185:       ELSE
186:          DO 10 I = 1, N
187:             INDXQ( I ) = I
188:    10    CONTINUE
189:       END IF
190: *
191:    20 CONTINUE
192:       RETURN
193: *
194: *     End of SLAED1
195: *
196:       END
197: